{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      : Slab.Parse
-- Description : Parse the concrete Slab syntax to an AST
--
-- @Slab.Parse@ provides parsers to read text and construct an abstract syntax
-- tree, as represented by "Slab.Syntax".
--
-- Parsers are written using the @megaparsec@ library.
module Slab.Parse
  ( parseFile
  , parseFileE
  , parse
  , parseExpr
  , parserTextInclude
  -- Inline parsing stuff

    -- * The @InterpolationContext@ type
  , InterpolationContext

    -- * Basic interface
  , parse'
  , parseInlines
  ) where

import Control.Monad (void)
import Control.Monad.Combinators.Expr
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (ExceptT, except, runExceptT, withExceptT)
import Data.Char (isSpace)
import Data.Functor (($>))
import Data.List (intercalate)
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Void (Void)
import Slab.Error qualified as Error
import Slab.Syntax
import Text.Megaparsec hiding (Label, label, parse, parseErrorPretty, unexpected)
import Text.Megaparsec qualified as M
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L

--------------------------------------------------------------------------------
parseFile :: FilePath -> IO (Either Error.Error [Block])
parseFile :: String -> IO (Either Error [Block])
parseFile = ExceptT Error IO [Block] -> IO (Either Error [Block])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO [Block] -> IO (Either Error [Block]))
-> (String -> ExceptT Error IO [Block])
-> String
-> IO (Either Error [Block])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT Error IO [Block]
parseFileE

parseFileE :: FilePath -> ExceptT Error.Error IO [Block]
parseFileE :: String -> ExceptT Error IO [Block]
parseFileE String
path = do
  Text
content <- IO Text -> ExceptT Error IO Text
forall a. IO a -> ExceptT Error IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT Error IO Text)
-> IO Text -> ExceptT Error IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
path
  (ParseErrorBundle Text Void -> Error)
-> ExceptT (ParseErrorBundle Text Void) IO [Block]
-> ExceptT Error IO [Block]
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ParseErrorBundle Text Void -> Error
Error.ParseError (ExceptT (ParseErrorBundle Text Void) IO [Block]
 -> ExceptT Error IO [Block])
-> (Either (ParseErrorBundle Text Void) [Block]
    -> ExceptT (ParseErrorBundle Text Void) IO [Block])
-> Either (ParseErrorBundle Text Void) [Block]
-> ExceptT Error IO [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseErrorBundle Text Void) [Block]
-> ExceptT (ParseErrorBundle Text Void) IO [Block]
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (ParseErrorBundle Text Void) [Block]
 -> ExceptT Error IO [Block])
-> Either (ParseErrorBundle Text Void) [Block]
-> ExceptT Error IO [Block]
forall a b. (a -> b) -> a -> b
$ String -> Text -> Either (ParseErrorBundle Text Void) [Block]
parse String
path Text
content

--------------------------------------------------------------------------------

parse :: FilePath -> Text -> Either (ParseErrorBundle Text Void) [Block]
parse :: String -> Text -> Either (ParseErrorBundle Text Void) [Block]
parse String
fn = Parsec Void Text [Block]
-> String -> Text -> Either (ParseErrorBundle Text Void) [Block]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (ParsecT Void Text Identity Block -> Parsec Void Text [Block]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Block
parserBlock Parsec Void Text [Block]
-> ParsecT Void Text Identity () -> Parsec Void Text [Block]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
fn

-- | We expose the expression parser for development:
--
-- @
--     Parse.parseExpr "1 + 2 * a"
-- @
parseExpr :: Text -> Either (ParseErrorBundle Text Void) Expr
parseExpr :: Text -> Either (ParseErrorBundle Text Void) Expr
parseExpr = Parsec Void Text Expr
-> String -> Text -> Either (ParseErrorBundle Text Void) Expr
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Expr
parserExpr Parsec Void Text Expr
-> ParsecT Void Text Identity () -> Parsec Void Text Expr
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
""

--------------------------------------------------------------------------------
type Parser = Parsec Void Text

parserBlock :: Parser Block
parserBlock :: ParsecT Void Text Identity Block
parserBlock = do
  Block
node <-
    ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
-> ParsecT Void Text Identity Block
forall s e (m :: * -> *) a b.
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () -> m (IndentOpt m a b) -> m a
L.indentBlock ParsecT Void Text Identity ()
scn (ParsecT
   Void
   Text
   Identity
   (IndentOpt (ParsecT Void Text Identity) Block Block)
 -> ParsecT Void Text Identity Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$
      [ParsecT
   Void
   Text
   Identity
   (IndentOpt (ParsecT Void Text Identity) Block Block)]
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserDoctype
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserInclude
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserElement
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserPipe
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserExpr'
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserFragmentDef
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserComment
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserFilter
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserRawElement
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserDefault
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserImport
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserRun
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserLet
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserEach
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserIf
        , ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserFragmentCall
        ]
  case Block
node of
    BlockIf Expr
cond [Block]
as [Block]
_ -> do
      Maybe [Block]
mbs <- Parsec Void Text [Block]
-> ParsecT Void Text Identity (Maybe [Block])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec Void Text [Block]
 -> ParsecT Void Text Identity (Maybe [Block]))
-> Parsec Void Text [Block]
-> ParsecT Void Text Identity (Maybe [Block])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) [Block] Block)
-> Parsec Void Text [Block]
forall s e (m :: * -> *) a b.
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () -> m (IndentOpt m a b) -> m a
L.indentBlock ParsecT Void Text Identity ()
scn ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) [Block] Block)
parserElse
      Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> Block -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ Expr -> [Block] -> [Block] -> Block
BlockIf Expr
cond [Block]
as ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ [Block] -> ([Block] -> [Block]) -> Maybe [Block] -> [Block]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Block] -> [Block]
forall a. a -> a
id Maybe [Block]
mbs
    Block
_ -> Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node

parserIf :: Parser (L.IndentOpt Parser Block Block)
parserIf :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserIf = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"if"
  String
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\t')
  Expr
cond <- Parsec Void Text Expr
parserExpr
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Block]
as -> Expr -> [Block] -> [Block] -> Block
BlockIf Expr
cond [Block]
as [])) ParsecT Void Text Identity Block
parserBlock

parserElse :: Parser (L.IndentOpt Parser [Block] Block)
parserElse :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) [Block] Block)
parserElse = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"else"
  IndentOpt (ParsecT Void Text Identity) [Block] Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) [Block] Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) [Block] Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) [Block] Block))
-> IndentOpt (ParsecT Void Text Identity) [Block] Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) [Block] Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> Parsec Void Text [Block])
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) [Block] Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing [Block] -> Parsec Void Text [Block]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsecT Void Text Identity Block
parserBlock

parserElement :: Parser (L.IndentOpt Parser Block Block)
parserElement :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserElement = do
  Pos
ref <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  [Block] -> Block
header <- Parser ([Block] -> Block)
parserDiv
  Pos
-> ([Block] -> Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserElemBody Pos
ref [Block] -> Block
header

-- | Parse the indented content of an HTML element or a fragment call.
parserElemBody :: Pos -> ([Block] -> Block) -> Parser (L.IndentOpt Parser Block Block)
parserElemBody :: Pos
-> ([Block] -> Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserElemBody Pos
ref [Block] -> Block
header =
  case Block -> TrailingSym
trailingSym (Block -> TrailingSym) -> Block -> TrailingSym
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [] of
    TrailingSym
HasDot -> do
      [Inline]
template <- Parser [Inline]
parseInlines
      case [Inline]
template of
        [] -> do
          ParsecT Void Text Identity ()
scn
          [Text]
items <- Pos -> Parser Text -> Parser [Text]
textBlock Pos
ref Parser Text
parserText -- TODO Use parseInlines
          let items' :: [Text]
items' = [Text] -> [Text]
realign [Text]
items
          IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [TextSyntax -> [Inline] -> Block
BlockText TextSyntax
Dot [Text -> Inline
Lit (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
items']]
        [Inline]
_ -> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [TextSyntax -> [Inline] -> Block
BlockText TextSyntax
Dot [Inline]
template]
    TrailingSym
HasEqual -> do
      Maybe Expr
mcontent <- Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parsec Void Text Expr
parserExpr
      case Maybe Expr
mcontent of
        Just Expr
content -> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [Expr -> Block
BlockCode Expr
content]
        Maybe Expr
Nothing -> do
          ParsecT Void Text Identity ()
scn
          Expr
content <- Parsec Void Text Expr
parserExpr
          IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [Expr -> Block
BlockCode Expr
content]
    TrailingSym
NoSym -> do
      [Inline]
template <- Parser [Inline]
parseInlines
      case [Inline]
template of
        [] -> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
header) ParsecT Void Text Identity Block
parserBlock
        [Inline]
_ -> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [TextSyntax -> [Inline] -> Block
BlockText TextSyntax
Normal [Inline]
template]

-- | Parse lines of text, indented more than `ref`.
-- E.g.:
--     a
--       b
--     c
-- will return ["a", "  b", "c"].
textBlock :: Pos -> Parser Text -> Parser [Text]
textBlock :: Pos -> Parser Text -> Parser [Text]
textBlock Pos
ref Parser Text
p = Parser [Text]
go
 where
  go :: Parser [Text]
go = do
    Int
n <- Parser Int
space'
    Pos
pos <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
    Bool
done <- Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool)
-> ParsecT Void Text Identity (Maybe ())
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
    if Bool
done
      then [Text] -> Parser [Text]
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      else
        if Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
ref
          then [Text] -> Parser [Text]
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else do
            Text
l <- Parser Text
p
            [Text]
ls <- Parser [Text]
go
            let prefix :: Text
prefix = Int -> Text -> Text
T.replicate (Pos -> Int
unPos Pos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pos -> Int
unPos Pos
ref) Text
" "
                n' :: [Text]
n' = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
""
                l' :: Text
l' = Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
            [Text] -> Parser [Text]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Parser [Text]) -> [Text] -> Parser [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
n' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text
l' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls)

-- | Considering all the given lines as a block, strip the leading whitespace of
-- each line so that the left-most character of the block is in the first
-- column.
realign :: [Text] -> [Text]
realign :: [Text] -> [Text]
realign [Text]
xs = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
n) [Text]
xs
 where
  n :: Int
n = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
xs

-- | Parse multiple lines starting each with a pipe prefix. Most of our parsers
-- parse a single line (and optional indented child lines) and most nodes map
-- to a single line, but here we want to be able to view such blocks as a
-- single node, and we make sur to add newlines between each when rendered.
parserPipe :: Parser (L.IndentOpt Parser Block Block)
parserPipe :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserPipe = do
  Pos
ref <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  [Inline]
template <- Parser [Inline]
p
  [[Inline]]
templates <- Pos -> ParsecT Void Text Identity [[Inline]]
go Pos
ref
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ TextSyntax -> [Inline] -> Block
BlockText TextSyntax
Pipe ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Text -> Inline
Lit Text
"\n"] ([Inline]
template [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: [[Inline]]
templates)
 where
  go :: Pos -> ParsecT Void Text Identity [[Inline]]
go Pos
ref = do
    ParsecT Void Text Identity ()
scn
    Pos
pos <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
    Bool
done <- Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool)
-> ParsecT Void Text Identity (Maybe ())
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
    if Bool
done
      then [[Inline]] -> ParsecT Void Text Identity [[Inline]]
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      else do
        Bool
cont <- Maybe (Tokens Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Tokens Text) -> Bool)
-> ParsecT Void Text Identity (Maybe (Tokens Text))
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (Maybe (Tokens Text))
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text Identity (Maybe (Tokens Text))
 -> ParsecT Void Text Identity (Maybe (Tokens Text)))
-> ParsecT Void Text Identity (Maybe (Tokens Text))
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Maybe (Tokens Text)))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"|")
        if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
/= Pos
ref Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
cont
          then [[Inline]] -> ParsecT Void Text Identity [[Inline]]
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else (:) ([Inline] -> [[Inline]] -> [[Inline]])
-> Parser [Inline]
-> ParsecT Void Text Identity ([[Inline]] -> [[Inline]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Inline]
p ParsecT Void Text Identity ([[Inline]] -> [[Inline]])
-> ParsecT Void Text Identity [[Inline]]
-> ParsecT Void Text Identity [[Inline]]
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pos -> ParsecT Void Text Identity [[Inline]]
go Pos
ref
  p :: Parser [Inline]
p = do
    Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"|"
    [Inline]
template <- Parser [Inline]
parseInlines
    [Inline] -> Parser [Inline]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Inline]
template

-- | A parser to convert the content of an @include@d to 'Syntax'. The
-- behavior w.r.t. to newlines should be the same as having each line
-- directly preceded by a @|@ in the including file.
parserTextInclude :: Text -> Block
parserTextInclude :: Text -> Block
parserTextInclude Text
content =
  TextSyntax -> [Inline] -> Block
BlockText TextSyntax
Include [Text -> Inline
Lit (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
content]

parserExpr' :: Parser (L.IndentOpt Parser Block Block)
parserExpr' :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserExpr' = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"="
  Expr
content <- Parsec Void Text Expr
parserExpr
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Expr -> Block
BlockCode Expr
content

parserExpr :: Parser Expr
parserExpr :: Parsec Void Text Expr
parserExpr = Parsec Void Text Expr
-> [[Operator (ParsecT Void Text Identity) Expr]]
-> Parsec Void Text Expr
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parsec Void Text Expr
pApp [[Operator (ParsecT Void Text Identity) Expr]]
operatorTable
 where
  pApp :: Parsec Void Text Expr
pApp = do
    Expr
a <- Parsec Void Text Expr
pTerm
    Maybe Expr
mb <- Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr))
-> Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ Parsec Void Text Expr
pTerm
    case Maybe Expr
mb of
      Maybe Expr
Nothing -> Expr -> Parsec Void Text Expr
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
a
      Just Expr
b -> Expr -> Parsec Void Text Expr
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Parsec Void Text Expr) -> Expr -> Parsec Void Text Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
Application Expr
a Expr
b
  pTerm :: Parsec Void Text Expr
pTerm =
    Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Int -> Expr
Int (Int -> Expr) -> Parser Int -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
parserNumber)
      Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Text -> Expr
SingleQuoteString (Text -> Expr) -> Parser Text -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parserSingleQuoteString)
      Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Text -> Expr
SingleQuoteString (Text -> Expr) -> Parser Text -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parserDoubleQuoteString) -- TODO Double
      Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parsec Void Text Expr
parserVariable'
      Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme ([(Expr, Expr)] -> Expr
Object ([(Expr, Expr)] -> Expr)
-> ParsecT Void Text Identity [(Expr, Expr)]
-> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [(Expr, Expr)]
parserObject)
      Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
parens Parsec Void Text Expr
parserExpr
  parens :: ParsecT Void Text Identity a -> ParsecT Void Text Identity a
parens = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(') (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')')

parserVariable :: Parser Text
parserVariable :: Parser Text
parserVariable = Parser Text
parserName

-- An operator table to define precedence and associativity
operatorTable :: [[Operator Parser Expr]]
operatorTable :: [[Operator (ParsecT Void Text Identity) Expr]]
operatorTable =
  [ [Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
"*" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
Times), Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
"/" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
Divide)]
  , [Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
"+" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
Add), Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
"-" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
Sub)]
  , [Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
">" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
GreaterThan), Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
"<" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
LesserThan)]
  , [Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Text -> Parser Text
symbol Text
"==" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
Equal)]
  , -- I'd like to use : instead, but it is already used for objects...
    [Parser (Expr -> Expr -> Expr)
-> Operator (ParsecT Void Text Identity) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Text -> Parser Text
symbol Text
"|" Parser Text
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expr -> Expr -> Expr
Cons)]
  ]

parserVariable' :: Parser Expr
parserVariable' :: Parsec Void Text Expr
parserVariable' = do
  Text
name <- Parser Text
parserName
  Maybe Text
mkey <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Void Text Identity (Maybe Text))
-> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"["
    Text
key <- Parser Text
parserSingleQuoteString
    Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"]"
    Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
key
  case Maybe Text
mkey of
    Maybe Text
Nothing -> Expr -> Parsec Void Text Expr
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Parsec Void Text Expr) -> Expr -> Parsec Void Text Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr
Variable Text
name
    Just Text
key -> Expr -> Parsec Void Text Expr
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Parsec Void Text Expr) -> Expr -> Parsec Void Text Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr
Lookup Text
name (Text -> Expr
SingleQuoteString Text
key)

--------------------------------------------------------------------------------
parserDoctype :: Parser (L.IndentOpt Parser Block Block)
parserDoctype :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserDoctype = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"doctype")
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"html")
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone Block
BlockDoctype

--------------------------------------------------------------------------------
-- E.g. div, div.a, .a
parserDiv :: Parser ([Block] -> Block)
parserDiv :: Parser ([Block] -> Block)
parserDiv =
  Parser ([Block] -> Block)
parserElemWithAttrs Parser ([Block] -> Block)
-> Parser ([Block] -> Block) -> Parser ([Block] -> Block)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ([Block] -> Block)
parserAttrs

-- E.g. div, div.a, div()
parserElemWithAttrs :: Parser ([Block] -> Block)
parserElemWithAttrs :: Parser ([Block] -> Block)
parserElemWithAttrs = do
  (Elem
name, [Attr]
attrs, TrailingSym
mdot) <- Parser (Elem, [Attr], TrailingSym)
parserNameWithAttrs
  ([Block] -> Block) -> Parser ([Block] -> Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Block] -> Block) -> Parser ([Block] -> Block))
-> ([Block] -> Block) -> Parser ([Block] -> Block)
forall a b. (a -> b) -> a -> b
$ Elem -> TrailingSym -> [Attr] -> [Block] -> Block
BlockElem Elem
name TrailingSym
mdot [Attr]
attrs

parserNameWithAttrs :: Parser (Elem, [Attr], TrailingSym)
parserNameWithAttrs :: Parser (Elem, [Attr], TrailingSym)
parserNameWithAttrs =
  Parser (Elem, [Attr], TrailingSym)
-> Parser (Elem, [Attr], TrailingSym)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme
    ( do
        Elem
el <- Parser Elem
parserElem
        [Attr]
attrs <- [[Attr]] -> [Attr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attr]] -> [Attr])
-> ParsecT Void Text Identity [[Attr]]
-> ParsecT Void Text Identity [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [[Attr]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity [Attr]
parserAttrs'
        TrailingSym
trailing <- Parser TrailingSym
parserTrailingSym
        (Elem, [Attr], TrailingSym) -> Parser (Elem, [Attr], TrailingSym)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Elem
el, [Attr]
attrs, TrailingSym
trailing)
    )
    Parser (Elem, [Attr], TrailingSym)
-> String -> Parser (Elem, [Attr], TrailingSym)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"element"

parserElem :: Parser Elem
parserElem :: Parser Elem
parserElem =
  (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"el") ParsecT Void Text Identity (Tokens Text)
-> Parser Elem -> Parser Elem
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Elem
Elem (Text -> Elem) -> Parser Text -> Parser Elem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser Text
parserName))
    Parser Elem -> String -> Parser Elem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"element name"

-- E.g. .a, ()
parserAttrs :: Parser ([Block] -> Block)
parserAttrs :: Parser ([Block] -> Block)
parserAttrs = do
  ([Attr]
attrs, TrailingSym
mdot) <-
    Parser ([Attr], TrailingSym) -> Parser ([Attr], TrailingSym)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme
      ( do
          [Attr]
attrs <- [[Attr]] -> [Attr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attr]] -> [Attr])
-> ParsecT Void Text Identity [[Attr]]
-> ParsecT Void Text Identity [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [[Attr]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity [Attr]
parserAttrs'
          Maybe (Tokens Text)
mdot <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
".")
          ([Attr], TrailingSym) -> Parser ([Attr], TrailingSym)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Attr]
attrs, TrailingSym
-> (Tokens Text -> TrailingSym)
-> Maybe (Tokens Text)
-> TrailingSym
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TrailingSym
NoSym (TrailingSym -> Tokens Text -> TrailingSym
forall a b. a -> b -> a
const TrailingSym
HasDot) Maybe (Tokens Text)
mdot)
      )
      Parser ([Attr], TrailingSym)
-> String -> Parser ([Attr], TrailingSym)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"attributes"
  ([Block] -> Block) -> Parser ([Block] -> Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Block] -> Block) -> Parser ([Block] -> Block))
-> ([Block] -> Block) -> Parser ([Block] -> Block)
forall a b. (a -> b) -> a -> b
$ Elem -> TrailingSym -> [Attr] -> [Block] -> Block
BlockElem Elem
Div TrailingSym
mdot [Attr]
attrs

parserAttrs' :: Parser [Attr]
parserAttrs' :: ParsecT Void Text Identity [Attr]
parserAttrs' =
  -- `try` because we want to backtrack if there is a dot
  -- not followed by a class name, for mdot to succeed.
  ((Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: []) (Attr -> [Attr])
-> ParsecT Void Text Identity Attr
-> ParsecT Void Text Identity [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Attr
parserId) ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [Attr]
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [Attr]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: []) (Attr -> [Attr])
-> ParsecT Void Text Identity Attr
-> ParsecT Void Text Identity [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Attr
parserClass) ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [Attr]
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity [Attr]
parserAttrList

parserTrailingSym :: Parser TrailingSym
parserTrailingSym :: Parser TrailingSym
parserTrailingSym = do
  Maybe TrailingSym
ms <-
    Parser TrailingSym
-> ParsecT Void Text Identity (Maybe TrailingSym)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser TrailingSym
 -> ParsecT Void Text Identity (Maybe TrailingSym))
-> Parser TrailingSym
-> ParsecT Void Text Identity (Maybe TrailingSym)
forall a b. (a -> b) -> a -> b
$
      [Parser TrailingSym] -> Parser TrailingSym
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"." ParsecT Void Text Identity (Tokens Text)
-> Parser TrailingSym -> Parser TrailingSym
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TrailingSym -> Parser TrailingSym
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrailingSym
HasDot
        , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"=" ParsecT Void Text Identity (Tokens Text)
-> Parser TrailingSym -> Parser TrailingSym
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TrailingSym -> Parser TrailingSym
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrailingSym
HasEqual
        ]
  TrailingSym -> Parser TrailingSym
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TrailingSym -> Parser TrailingSym)
-> TrailingSym -> Parser TrailingSym
forall a b. (a -> b) -> a -> b
$ TrailingSym
-> (TrailingSym -> TrailingSym) -> Maybe TrailingSym -> TrailingSym
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TrailingSym
NoSym TrailingSym -> TrailingSym
forall a. a -> a
id Maybe TrailingSym
ms

-- E.g. #a
parserId :: Parser Attr
parserId :: ParsecT Void Text Identity Attr
parserId =
  Text -> Attr
Id
    (Text -> Attr) -> (String -> Text) -> String -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> Attr)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"-_" :: String)))
    ParsecT Void Text Identity Attr
-> String -> ParsecT Void Text Identity Attr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"id"

-- E.g. .a
parserClass :: Parser Attr
parserClass :: ParsecT Void Text Identity Attr
parserClass =
  Text -> Attr
Class
    (Text -> Attr) -> (String -> Text) -> String -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> Attr)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"-_" :: String)))
    ParsecT Void Text Identity Attr
-> String -> ParsecT Void Text Identity Attr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"class name"

-- E.g. (), (class='a')
parserAttrList :: Parser [Attr]
parserAttrList :: ParsecT Void Text Identity [Attr]
parserAttrList = (ParsecT Void Text Identity [Attr]
-> String -> ParsecT Void Text Identity [Attr]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"attribute") (ParsecT Void Text Identity [Attr]
 -> ParsecT Void Text Identity [Attr])
-> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [Attr]
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"("
  [(Text, Maybe Expr)]
pairs <- ParsecT Void Text Identity (Text, Maybe Expr)
-> ParsecT Void Text Identity [(Text, Maybe Expr)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity (Text, Maybe Expr)
parserPair
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
")"
  [Attr] -> ParsecT Void Text Identity [Attr]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Attr] -> ParsecT Void Text Identity [Attr])
-> [Attr] -> ParsecT Void Text Identity [Attr]
forall a b. (a -> b) -> a -> b
$ ((Text, Maybe Expr) -> Attr) -> [(Text, Maybe Expr)] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Maybe Expr -> Attr) -> (Text, Maybe Expr) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Maybe Expr -> Attr
Attr) [(Text, Maybe Expr)]
pairs

parserPair :: Parser (Text, Maybe Expr)
parserPair :: ParsecT Void Text Identity (Text, Maybe Expr)
parserPair = do
  Text
a <- String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
",()= \n" :: String))) Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"key"
  Maybe Expr
mb <- Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr))
-> Parsec Void Text Expr -> ParsecT Void Text Identity (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"="
    Expr
b <- Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parsec Void Text Expr
parserValue
    Expr -> Parsec Void Text Expr
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
b
  Maybe (Tokens Text)
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
",")
  (Text, Maybe Expr) -> ParsecT Void Text Identity (Text, Maybe Expr)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
a, Maybe Expr
mb)

parserValue :: Parser Expr
parserValue :: Parsec Void Text Expr
parserValue =
  Text -> Expr
SingleQuoteString (Text -> Expr) -> Parser Text -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parserSingleQuoteString
    Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Expr
SingleQuoteString (Text -> Expr) -> Parser Text -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parserDoubleQuoteString
    Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Expr
Int (Int -> Expr) -> Parser Int -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
parserNumber

parserSingleQuoteString :: Parser Text
parserSingleQuoteString :: Parser Text
parserSingleQuoteString = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"'"
  Text
s <- String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
"'\n" :: String))) Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"string"
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"'"
  Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

parserDoubleQuoteString :: Parser Text
parserDoubleQuoteString :: Parser Text
parserDoubleQuoteString = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\""
  Text
s <- String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
"\"\n" :: String))) Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"string"
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\""
  Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

-- TODO Proper data type.
parserNumber :: Parser Int
parserNumber :: Parser Int
parserNumber = Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

parserText :: Parser Text
parserText :: Parser Text
parserText = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\n'])) Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"text content"

parserIdentifier :: Parser Text
parserIdentifier :: Parser Text
parserIdentifier = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
" .=#(){}\n" :: String))) Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"identifier"

--------------------------------------------------------------------------------
parserInclude :: Parser (L.IndentOpt Parser Block Block)
parserInclude :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserInclude = do
  Maybe Text
mname <- ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Maybe Text)
 -> ParsecT Void Text Identity (Maybe Text))
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"include"
    Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Void Text Identity (Maybe Text))
-> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
      Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":"
      Parser Text
parserIdentifier
  String
path <- ParsecT Void Text Identity String
parserPath
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Maybe Text -> String -> Maybe [Block] -> Block
BlockInclude Maybe Text
mname String
path Maybe [Block]
forall a. Maybe a
Nothing

parserPath :: Parser FilePath
parserPath :: ParsecT Void Text Identity String
parserPath = ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
"'\"\n" :: String))) ParsecT Void Text Identity String
-> String -> ParsecT Void Text Identity String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"path"

--------------------------------------------------------------------------------
parserFragmentDef :: Parser (L.IndentOpt Parser Block Block)
parserFragmentDef :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserFragmentDef = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"fragment" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"frag")
  Text
name <- Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser Text
parserIdentifier
  [Text]
params <- [Text] -> ([Text] -> [Text]) -> Maybe [Text] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Text] -> [Text]
forall a. a -> a
id (Maybe [Text] -> [Text])
-> ParsecT Void Text Identity (Maybe [Text]) -> Parser [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Text] -> ParsecT Void Text Identity (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser [Text]
parserParameters
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Block] -> Block
BlockFragmentDef Text
name [Text]
params) ParsecT Void Text Identity Block
parserBlock

-- E.g. {}, {a, b}
parserParameters :: Parser [Text]
parserParameters :: Parser [Text]
parserParameters = Text -> Text -> Parser Text -> Parser [Text]
forall a. Text -> Text -> Parser a -> Parser [a]
parserList' Text
"{" Text
"}" (Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser Text
parserIdentifier) Parser [Text] -> String -> Parser [Text]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"arguments"

--------------------------------------------------------------------------------
parserFragmentCall :: Parser (L.IndentOpt Parser Block Block)
parserFragmentCall :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserFragmentCall = do
  Pos
ref <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  [Block] -> Block
header <- Parser ([Block] -> Block)
parserCall
  Pos
-> ([Block] -> Block)
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserElemBody Pos
ref [Block] -> Block
header

parserCall :: Parser ([Block] -> Block)
parserCall :: Parser ([Block] -> Block)
parserCall = do
  -- TODO Use parserNameWithAttrs.
  (Text
name, [Attr]
attrs, TrailingSym
trailing, [Expr]
args) <- Parser (Text, [Attr], TrailingSym, [Expr])
-> Parser (Text, [Attr], TrailingSym, [Expr])
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser (Text, [Attr], TrailingSym, [Expr])
 -> Parser (Text, [Attr], TrailingSym, [Expr]))
-> Parser (Text, [Attr], TrailingSym, [Expr])
-> Parser (Text, [Attr], TrailingSym, [Expr])
forall a b. (a -> b) -> a -> b
$ do
    Text
name <- Parser Text
parserIdentifier
    [Attr]
attrs <- [[Attr]] -> [Attr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attr]] -> [Attr])
-> ParsecT Void Text Identity [[Attr]]
-> ParsecT Void Text Identity [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Attr]
-> ParsecT Void Text Identity [[Attr]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity [Attr]
parserAttrs'
    TrailingSym
trailing <- Parser TrailingSym
parserTrailingSym
    [Expr]
args <- [Expr] -> ([Expr] -> [Expr]) -> Maybe [Expr] -> [Expr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Expr] -> [Expr]
forall a. a -> a
id (Maybe [Expr] -> [Expr])
-> ParsecT Void Text Identity (Maybe [Expr])
-> ParsecT Void Text Identity [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Expr]
-> ParsecT Void Text Identity (Maybe [Expr])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity [Expr]
parserArguments
    (Text, [Attr], TrailingSym, [Expr])
-> Parser (Text, [Attr], TrailingSym, [Expr])
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, [Attr]
attrs, TrailingSym
trailing, [Expr]
args)
  ([Block] -> Block) -> Parser ([Block] -> Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Block] -> Block) -> Parser ([Block] -> Block))
-> ([Block] -> Block) -> Parser ([Block] -> Block)
forall a b. (a -> b) -> a -> b
$ Text -> TrailingSym -> [Attr] -> [Expr] -> [Block] -> Block
BlockFragmentCall Text
name TrailingSym
trailing [Attr]
attrs [Expr]
args

-- E.g. {}, {1, 'a'}
parserArguments :: Parser [Expr]
parserArguments :: ParsecT Void Text Identity [Expr]
parserArguments = Text
-> Text
-> Parsec Void Text Expr
-> ParsecT Void Text Identity [Expr]
forall a. Text -> Text -> Parser a -> Parser [a]
parserList' Text
"{" Text
"}" Parsec Void Text Expr
parserExpr ParsecT Void Text Identity [Expr]
-> String -> ParsecT Void Text Identity [Expr]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"arguments"

--------------------------------------------------------------------------------
parserEach :: Parser (L.IndentOpt Parser Block Block)
parserEach :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserEach = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"for"
  String
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\t')
  Text
name <- Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser Text
parserName
  Maybe Text
mindex <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Void Text Identity (Maybe Text))
-> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
","
    Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser Text
parserName
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"in")
  Expr
collection <-
    ([Expr] -> Expr
List ([Expr] -> Expr)
-> ParsecT Void Text Identity [Expr] -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Expr]
parserList) Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([(Expr, Expr)] -> Expr
Object ([(Expr, Expr)] -> Expr)
-> ParsecT Void Text Identity [(Expr, Expr)]
-> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [(Expr, Expr)]
parserObject) Parsec Void Text Expr
-> Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Expr
Variable (Text -> Expr) -> Parser Text -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parserVariable)
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Expr -> [Block] -> Block
BlockFor Text
name Maybe Text
mindex Expr
collection) ParsecT Void Text Identity Block
parserBlock

parserList :: Parser [Expr]
parserList :: ParsecT Void Text Identity [Expr]
parserList = Text
-> Text
-> Parsec Void Text Expr
-> ParsecT Void Text Identity [Expr]
forall a. Text -> Text -> Parser a -> Parser [a]
parserList' Text
"[" Text
"]" Parsec Void Text Expr
parserExpr

parserList' :: Text -> Text -> Parser a -> Parser [a]
parserList' :: forall a. Text -> Text -> Parser a -> Parser [a]
parserList' Text
before Text
after Parser a
p = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
before
  Maybe a
mx <- Parser a -> ParsecT Void Text Identity (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser a -> ParsecT Void Text Identity (Maybe a))
-> Parser a -> ParsecT Void Text Identity (Maybe a)
forall a b. (a -> b) -> a -> b
$ Parser a -> Parser a
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser a
p
  [a]
xs <- case Maybe a
mx of
    Maybe a
Nothing -> [a] -> Parser [a]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just a
x -> do
      [a]
xs <- Parser a -> Parser [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall a b. (a -> b) -> a -> b
$ do
        Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
",")
        Parser a -> Parser a
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser a
p
      [a] -> Parser [a]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Parser [a]) -> [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
after
  [a] -> Parser [a]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs

parserObject :: Parser [(Expr, Expr)]
parserObject :: ParsecT Void Text Identity [(Expr, Expr)]
parserObject = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{")
  Maybe (Expr, Expr)
mkv <- ParsecT Void Text Identity (Expr, Expr)
-> ParsecT Void Text Identity (Maybe (Expr, Expr))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity (Expr, Expr)
 -> ParsecT Void Text Identity (Maybe (Expr, Expr)))
-> ParsecT Void Text Identity (Expr, Expr)
-> ParsecT Void Text Identity (Maybe (Expr, Expr))
forall a b. (a -> b) -> a -> b
$ do
    Expr
key <- Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parsec Void Text Expr
parserExpr
    Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":")
    Expr
val <- Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parsec Void Text Expr
parserExpr
    (Expr, Expr) -> ParsecT Void Text Identity (Expr, Expr)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
key, Expr
val)
  [(Expr, Expr)]
kvs <- case Maybe (Expr, Expr)
mkv of
    Maybe (Expr, Expr)
Nothing -> [(Expr, Expr)] -> ParsecT Void Text Identity [(Expr, Expr)]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just (Expr, Expr)
kv -> do
      [(Expr, Expr)]
kvs <- ParsecT Void Text Identity (Expr, Expr)
-> ParsecT Void Text Identity [(Expr, Expr)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity (Expr, Expr)
 -> ParsecT Void Text Identity [(Expr, Expr)])
-> ParsecT Void Text Identity (Expr, Expr)
-> ParsecT Void Text Identity [(Expr, Expr)]
forall a b. (a -> b) -> a -> b
$ do
        Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
","
        Expr
key <- Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parsec Void Text Expr
parserExpr
        Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":")
        Expr
val <- Parsec Void Text Expr -> Parsec Void Text Expr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parsec Void Text Expr
parserExpr
        (Expr, Expr) -> ParsecT Void Text Identity (Expr, Expr)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
key, Expr
val)
      [(Expr, Expr)] -> ParsecT Void Text Identity [(Expr, Expr)]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Expr, Expr)] -> ParsecT Void Text Identity [(Expr, Expr)])
-> [(Expr, Expr)] -> ParsecT Void Text Identity [(Expr, Expr)]
forall a b. (a -> b) -> a -> b
$ (Expr, Expr)
kv (Expr, Expr) -> [(Expr, Expr)] -> [(Expr, Expr)]
forall a. a -> [a] -> [a]
: [(Expr, Expr)]
kvs
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"}")
  [(Expr, Expr)] -> ParsecT Void Text Identity [(Expr, Expr)]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Expr, Expr)]
kvs

--------------------------------------------------------------------------------
parserComment :: Parser (L.IndentOpt Parser Block Block)
parserComment :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserComment = do
  Pos
ref <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  CommentType
b <-
    Parser CommentType -> Parser CommentType
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser CommentType -> Parser CommentType)
-> Parser CommentType -> Parser CommentType
forall a b. (a -> b) -> a -> b
$
      [Parser CommentType] -> Parser CommentType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"---" ParsecT Void Text Identity (Tokens Text)
-> Parser CommentType -> Parser CommentType
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CommentType -> Parser CommentType
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommentType
PassthroughComment
        , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--" ParsecT Void Text Identity (Tokens Text)
-> Parser CommentType -> Parser CommentType
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CommentType -> Parser CommentType
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommentType
NormalComment
        ]
  Maybe Text
mcontent <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
parserText
  case Maybe Text
mcontent of
    Just Text
content -> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ CommentType -> Text -> Block
BlockComment CommentType
b Text
content
    Maybe Text
Nothing -> do
      ParsecT Void Text Identity ()
scn
      [Text]
items <- Pos -> Parser Text -> Parser [Text]
textBlock Pos
ref Parser Text
parserText
      let items' :: [Text]
items' = [Text] -> [Text]
realign [Text]
items
      IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ CommentType -> Text -> Block
BlockComment CommentType
b (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
items'

--------------------------------------------------------------------------------
parserFilter :: Parser (L.IndentOpt Parser Block Block)
parserFilter :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserFilter = do
  Pos
ref <- ParsecT Void Text Identity Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  Text
name <-
    Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme
      ( Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":"
          ParsecT Void Text Identity (Tokens Text)
-> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
parserName
      )
      Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"filter name"
  Maybe Text
mcontent <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
parserText
  case Maybe Text
mcontent of
    Just Text
content -> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Block
BlockFilter Text
name Text
content
    Maybe Text
Nothing -> do
      ParsecT Void Text Identity ()
scn
      [Text]
items <- Pos -> Parser Text -> Parser [Text]
textBlock Pos
ref Parser Text
parserText
      let items' :: [Text]
items' = [Text] -> [Text]
realign [Text]
items
      IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Block
BlockFilter Text
name (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
items'

parserName :: Parser Text
parserName :: Parser Text
parserName =
  String -> Text
T.pack
    (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( do
            Char
a <- ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
            String
as <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"-_" :: String))
            String -> ParsecT Void Text Identity String
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
a Char -> String -> String
forall a. a -> [a] -> [a]
: String
as)
        )
    Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"name"

--------------------------------------------------------------------------------
parserRawElement :: Parser (L.IndentOpt Parser Block Block)
parserRawElement :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserRawElement = do
  [Block] -> Block
header <- Parser ([Block] -> Block)
parserAngleBracket
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
header) ParsecT Void Text Identity Block
parserBlock

parserAngleBracket :: Parser ([Block] -> Block)
parserAngleBracket :: Parser ([Block] -> Block)
parserAngleBracket = do
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<'
  Text
content <- Parser Text
parserText
  ([Block] -> Block) -> Parser ([Block] -> Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Block] -> Block) -> Parser ([Block] -> Block))
-> ([Block] -> Block) -> Parser ([Block] -> Block)
forall a b. (a -> b) -> a -> b
$ Text -> [Block] -> Block
BlockRawElem (Text -> [Block] -> Block) -> Text -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
content

--------------------------------------------------------------------------------
parserDefault :: Parser (L.IndentOpt Parser Block Block)
parserDefault :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserDefault = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"default")
  Text
name <- Parser Text
parserText
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Block] -> Block
BlockDefault Text
name) ParsecT Void Text Identity Block
parserBlock

--------------------------------------------------------------------------------
parserImport :: Parser (L.IndentOpt Parser Block Block)
parserImport :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserImport = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"import")
  String
path <- ParsecT Void Text Identity String
parserPath
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Block] -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing (Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> ([Block] -> Block)
-> [Block]
-> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe [Block] -> [Block] -> Block
BlockImport String
path Maybe [Block]
forall a. Maybe a
Nothing) ParsecT Void Text Identity Block
parserBlock

--------------------------------------------------------------------------------
parserRun :: Parser (L.IndentOpt Parser Block Block)
parserRun :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserRun = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"run")
  Text
cmd <- Parser Text
parserText
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Text -> Maybe [Block] -> Block
BlockRun Text
cmd Maybe [Block]
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
parserLet :: Parser (L.IndentOpt Parser Block Block)
parserLet :: ParsecT
  Void
  Text
  Identity
  (IndentOpt (ParsecT Void Text Identity) Block Block)
parserLet = do
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"let")
  Text
name <- Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme Parser Text
parserName
  Tokens Text
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"=")
  [ParsecT
   Void
   Text
   Identity
   (IndentOpt (ParsecT Void Text Identity) Block Block)]
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserAssignVar Text
name
    , Text
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserReadJson Text
name
    ]

parserAssignVar :: Text -> Parser (L.IndentOpt Parser Block Block)
parserAssignVar :: Text
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserAssignVar Text
name = do
  Expr
val <- Parsec Void Text Expr
parserExpr
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Block
BlockAssignVar Text
name Expr
val

parserReadJson :: Text -> Parser (L.IndentOpt Parser Block Block)
parserReadJson :: Text
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
parserReadJson Text
name = do
  String
path <- ParsecT Void Text Identity String
parserPath
  IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void Text Identity) Block Block
 -> ParsecT
      Void
      Text
      Identity
      (IndentOpt (ParsecT Void Text Identity) Block Block))
-> IndentOpt (ParsecT Void Text Identity) Block Block
-> ParsecT
     Void
     Text
     Identity
     (IndentOpt (ParsecT Void Text Identity) Block Block)
forall a b. (a -> b) -> a -> b
$ Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall (m :: * -> *) a b. a -> IndentOpt m a b
L.IndentNone (Block -> IndentOpt (ParsecT Void Text Identity) Block Block)
-> Block -> IndentOpt (ParsecT Void Text Identity) Block Block
forall a b. (a -> b) -> a -> b
$ Text -> String -> Maybe Value -> Block
BlockReadJson Text
name String
path Maybe Value
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
scn :: Parser ()
scn :: ParsecT Void Text Identity ()
scn = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 ParsecT Void Text Identity ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty ParsecT Void Text Identity ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

-- Similar to space, but counts newlines
space' :: Parser Int
space' :: Parser Int
space' = do
  Text
s <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (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
"white space") Char -> Bool
Token Text -> Bool
isSpace
  Int -> Parser Int
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> (String -> Int) -> String -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Parser Int) -> String -> Parser Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s

sc :: Parser ()
sc :: ParsecT Void Text Identity ()
sc = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (ParsecT Void Text Identity String -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\t')) ParsecT Void Text Identity ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty ParsecT Void Text Identity ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

lexeme :: Parser a -> Parser a
lexeme :: forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
sc

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = ParsecT Void Text Identity ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT Void Text Identity ()
sc

--------------------------------------------------------------------------------

-- Text interpolation stuff

-- Text interpolation modeled on the @template@ library by Johan Tibell.
-- - This uses Megaparsec instead of an internal State monad parser.
-- - This uses @#@ instead of @$@, and both @()@ and @{}@.
--   - @()@ uses the expression syntax.
--   - @{}@ uses the block syntax (although limited).
-- - Only the safe parsers are provided.
-- - Only the applicative interface is provided.
-- - We don't support #name, but only #(name), because # can appear
--   in character entities, URLs, ...
-- TODO Mention the BSD-3 license and Johan.
-- TODO Actually support #name.

--------------------------------------------------------------------------------

-- | A mapping from placeholders in the template to values with an applicative
-- lookup function. For instance the lookup function can fail, returning
-- 'Nothing' or 'Left'.
type InterpolationContext f = Text -> f Text

--------------------------------------------------------------------------------
-- Basic interface

-- | Create a template from a template string. A malformed template
-- string will cause 'parse' to return a parse error.
parse' :: Text -> Either (M.ParseErrorBundle Text Void) [Inline]
parse' :: Text -> Either (ParseErrorBundle Text Void) [Inline]
parse' = Parser [Inline]
-> String -> Text -> Either (ParseErrorBundle Text Void) [Inline]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
M.parse (Parser [Inline]
parseInlines Parser [Inline] -> ParsecT Void Text Identity () -> Parser [Inline]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof) String
"-"

combineLits :: [Inline] -> [Inline]
combineLits :: [Inline] -> [Inline]
combineLits [] = []
combineLits [Inline]
xs =
  let ([Inline]
lits, [Inline]
xs') = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Inline -> Bool
isLit [Inline]
xs
   in case [Inline]
lits of
        [] -> [Inline] -> [Inline]
gatherVars [Inline]
xs'
        [Inline
lit] -> Inline
lit Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
gatherVars [Inline]
xs'
        [Inline]
_ -> Text -> Inline
Lit ([Text] -> Text
T.concat ((Inline -> Text) -> [Inline] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
fromLit [Inline]
lits)) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
gatherVars [Inline]
xs'
 where
  gatherVars :: [Inline] -> [Inline]
gatherVars [] = []
  gatherVars [Inline]
ys =
    let ([Inline]
vars, [Inline]
ys') = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Inline -> Bool
isVar [Inline]
ys
     in [Inline]
vars [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline] -> [Inline]
combineLits [Inline]
ys'

  isLit :: Inline -> Bool
isLit (Lit Text
_) = Bool
True
  isLit Inline
_ = Bool
False

  isVar :: Inline -> Bool
isVar = Bool -> Bool
not (Bool -> Bool) -> (Inline -> Bool) -> Inline -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Bool
isLit

  fromLit :: Inline -> Text
fromLit (Lit Text
v) = Text
v
  fromLit Inline
_ = Text
forall a. HasCallStack => a
undefined

--------------------------------------------------------------------------------
-- Template parser

-- | Record whether we are parsing a template within the normal block syntax,
-- or within an inline block syntax (introduced by #{...}). This is allow a
-- closing curly bracket in the normal case without requiring to escape it, and
-- disallowing it in the inline case (since it is used to end the inline case).
data InlineContext = NormalBlock | InlineBlock

parseInlines :: Parser [Inline]
parseInlines :: Parser [Inline]
parseInlines = InlineContext -> Parser [Inline]
parseInlines' InlineContext
NormalBlock

parseInlines' :: InlineContext -> Parser [Inline]
parseInlines' :: InlineContext -> Parser [Inline]
parseInlines' InlineContext
ctx = [Inline] -> [Inline]
combineLits ([Inline] -> [Inline]) -> Parser [Inline] -> Parser [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Inline -> Parser [Inline]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (InlineContext -> ParsecT Void Text Identity Inline
parseInline InlineContext
ctx)

parseInline :: InlineContext -> Parser Inline
parseInline :: InlineContext -> ParsecT Void Text Identity Inline
parseInline InlineContext
ctx =
  [ParsecT Void Text Identity Inline]
-> ParsecT Void Text Identity Inline
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
    [ InlineContext -> ParsecT Void Text Identity Inline
parseLit InlineContext
ctx
    , ParsecT Void Text Identity Inline
parsePlaceExpr
    , ParsecT Void Text Identity Inline
parsePlaceBlock
    , ParsecT Void Text Identity Inline
parseEscape
    , ParsecT Void Text Identity Inline
parseSharpLit
    ]

-- TODO The \n condition could be optional if we want this module to be useful
-- outside Slab.
parseLit :: InlineContext -> Parser Inline
parseLit :: InlineContext -> ParsecT Void Text Identity Inline
parseLit InlineContext
ctx = do
  Text
s <- case InlineContext
ctx of
    InlineContext
NormalBlock -> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"literal") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
    InlineContext
InlineBlock -> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"literal") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}')
  Inline -> ParsecT Void Text Identity Inline
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> ParsecT Void Text Identity Inline)
-> Inline -> ParsecT Void Text Identity Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Lit Text
s

parsePlaceExpr :: Parser Inline
parsePlaceExpr :: ParsecT Void Text Identity Inline
parsePlaceExpr = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"#("
  Expr
e <- Parsec Void Text Expr
parserExpr
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
")"
  Inline -> ParsecT Void Text Identity Inline
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> ParsecT Void Text Identity Inline)
-> Inline -> ParsecT Void Text Identity Inline
forall a b. (a -> b) -> a -> b
$ Expr -> Inline
Place Expr
e

parsePlaceBlock :: Parser Inline
parsePlaceBlock :: ParsecT Void Text Identity Inline
parsePlaceBlock = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"#{"
  Expr
e <- Block -> Expr
Block (Block -> Expr)
-> ParsecT Void Text Identity Block -> Parsec Void Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Block
parseInlineBlock
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"}"
  Inline -> ParsecT Void Text Identity Inline
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> ParsecT Void Text Identity Inline)
-> Inline -> ParsecT Void Text Identity Inline
forall a b. (a -> b) -> a -> b
$ Expr -> Inline
Place Expr
e

-- | Equivalent to `parserBlock` but in an inline context.
parseInlineBlock :: Parser Block
parseInlineBlock :: ParsecT Void Text Identity Block
parseInlineBlock = do
  [Block] -> Block
header <- Parser ([Block] -> Block)
parserDiv Parser ([Block] -> Block)
-> Parser ([Block] -> Block) -> Parser ([Block] -> Block)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ([Block] -> Block)
parserCall
  [Inline]
template <- InlineContext -> Parser [Inline]
parseInlines' InlineContext
InlineBlock
  -- Don't return anything of the template is empty. to avoid a newline when
  -- rendering.
  if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
template
    then Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> Block -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header []
    else Block -> ParsecT Void Text Identity Block
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> Block -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
header [TextSyntax -> [Inline] -> Block
BlockText TextSyntax
Dot [Inline]
template]

parseEscape :: Parser Inline
parseEscape :: ParsecT Void Text Identity Inline
parseEscape = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"##"
  Inline -> ParsecT Void Text Identity Inline
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> ParsecT Void Text Identity Inline)
-> Inline -> ParsecT Void Text Identity Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Lit (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"#"

parseSharpLit :: Parser Inline
parseSharpLit :: ParsecT Void Text Identity Inline
parseSharpLit = do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"#"
  Text
s <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  Inline -> ParsecT Void Text Identity Inline
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> ParsecT Void Text Identity Inline)
-> Inline -> ParsecT Void Text Identity Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Lit (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s