-- |
-- Module: Staversion.Internal.BuildPlan.Parser
-- Description: Common parsers for BuildPlan modules
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
module Staversion.Internal.BuildPlan.Parser
  ( parserVersion,
    manyTillWithEnd
  ) where

import Control.Applicative (optional)
import Control.Monad (void)
import Data.Char (isDigit)
import Data.Text (unpack)

import Staversion.Internal.Megaparsec (Parser)
import qualified Staversion.Internal.Megaparsec as P
import Staversion.Internal.Version (Version, parseVersionText)

parserVersion :: Parser Version
parserVersion :: Parser Version
parserVersion = do
  Text
vstr <- (Char -> Bool) -> Parser Text
P.textSatisfying (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
  ParsecT (ErrorFancy Void) Text Identity (Maybe Char)
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) Text Identity (Maybe Char)
 -> ParsecT (ErrorFancy Void) Text Identity ())
-> ParsecT (ErrorFancy Void) Text Identity (Maybe Char)
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT (ErrorFancy Void) Text Identity Char
 -> ParsecT (ErrorFancy Void) Text Identity (Maybe Char))
-> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'*'
  case Text -> Maybe Version
parseVersionText Text
vstr of
    Maybe Version
Nothing -> String -> Parser Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Cannot parse to a version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
vstr)
    Just Version
v -> Version -> Parser Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v

manyTillWithEnd :: Parser a -> Parser end -> Parser ([a], end)
manyTillWithEnd :: Parser a -> Parser end -> Parser ([a], end)
manyTillWithEnd Parser a
pa Parser end
pe = do
  [a]
as <- Parser a
-> Parser end -> ParsecT (ErrorFancy Void) Text Identity [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser a
pa (Parser end -> ParsecT (ErrorFancy Void) Text Identity [a])
-> Parser end -> ParsecT (ErrorFancy Void) Text Identity [a]
forall a b. (a -> b) -> a -> b
$ Parser end -> Parser end
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (Parser end -> Parser end) -> Parser end -> Parser end
forall a b. (a -> b) -> a -> b
$ Parser end -> Parser end
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser end
pe
  end
e <- Parser end
pe
  ([a], end) -> Parser ([a], end)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as, end
e)