{-# LANGUAGE FlexibleContexts #-}

module Language.Ltml.Parser.Label
    ( labelP
    , labelingP
    , bracedLabelingP
    )
where

import qualified Data.Char as Char (isAsciiLower, isDigit)
import qualified Data.Text as Text (cons)
import Language.Ltml.AST.Label (Label (Label))
import Language.Ltml.Parser (MonadParser)
import Text.Megaparsec (satisfy, takeWhileP, (<?>))
import Text.Megaparsec.Char (char)

labelP :: (MonadParser m) => m Label
labelP :: forall (m :: * -> *). MonadParser m => m Label
labelP = Text -> Label
Label (Text -> Label) -> m Text -> m Label
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Text -> Text
Text.cons (Char -> Text -> Text) -> m Char -> m (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
m (Token Text)
headP m (Text -> Text) -> m Text -> m Text
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text
m (Tokens Text)
tailP) m Label -> String -> m Label
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"label"
  where
    isFirst :: Char -> Bool
isFirst = Char -> Bool
Char.isAsciiLower
    isLater :: Char -> Bool
isLater Char
c = Char -> Bool
Char.isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_-"
    headP :: m (Token Text)
headP = (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isFirst
    tailP :: m (Tokens Text)
tailP = Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"label character") Char -> Bool
Token Text -> Bool
isLater

labelingP :: (MonadParser m) => m Label
labelingP :: forall (m :: * -> *). MonadParser m => m Label
labelingP = Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{' m Char -> m Label -> m Label
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Label
forall (m :: * -> *). MonadParser m => m Label
bracedLabelingP m Label -> m Char -> m Label
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'

bracedLabelingP :: (MonadParser m) => m Label
bracedLabelingP :: forall (m :: * -> *). MonadParser m => m Label
bracedLabelingP = m Label
forall (m :: * -> *). MonadParser m => m Label
labelP m Label -> m Char -> m Label
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'