{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-unused-imports  #-}

module Language.Ginger.Parse
( P
, expr
, statement
, template
, parseGinger
, parseGingerFile
, parseGingerWith
, parseGingerFileWith
, POptions (..)
, defPOptions
, BlockTrimming (..)
, BlockStripping (..)
, simplifyS
)
where

import Control.Monad (void, when, replicateM)
import Control.Monad.Reader (Reader, runReader, ask, asks)
import Data.Char (isAlphaNum, isAlpha, isDigit, isSpace, chr)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Void (Void)
import Text.Megaparsec as Megaparsec
import Text.Megaparsec.Char

import Language.Ginger.AST as AST
import Language.Ginger.SourcePosition as AST

--------------------------------------------------------------------------------
-- Parser Type
--------------------------------------------------------------------------------

type P = ParsecT Void Text (Reader POptions)

data BlockTrimming
  = NoTrimBlocks
  | TrimBlocks
  deriving (Int -> BlockTrimming -> ShowS
[BlockTrimming] -> ShowS
BlockTrimming -> String
(Int -> BlockTrimming -> ShowS)
-> (BlockTrimming -> String)
-> ([BlockTrimming] -> ShowS)
-> Show BlockTrimming
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockTrimming -> ShowS
showsPrec :: Int -> BlockTrimming -> ShowS
$cshow :: BlockTrimming -> String
show :: BlockTrimming -> String
$cshowList :: [BlockTrimming] -> ShowS
showList :: [BlockTrimming] -> ShowS
Show, ReadPrec [BlockTrimming]
ReadPrec BlockTrimming
Int -> ReadS BlockTrimming
ReadS [BlockTrimming]
(Int -> ReadS BlockTrimming)
-> ReadS [BlockTrimming]
-> ReadPrec BlockTrimming
-> ReadPrec [BlockTrimming]
-> Read BlockTrimming
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BlockTrimming
readsPrec :: Int -> ReadS BlockTrimming
$creadList :: ReadS [BlockTrimming]
readList :: ReadS [BlockTrimming]
$creadPrec :: ReadPrec BlockTrimming
readPrec :: ReadPrec BlockTrimming
$creadListPrec :: ReadPrec [BlockTrimming]
readListPrec :: ReadPrec [BlockTrimming]
Read, BlockTrimming -> BlockTrimming -> Bool
(BlockTrimming -> BlockTrimming -> Bool)
-> (BlockTrimming -> BlockTrimming -> Bool) -> Eq BlockTrimming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockTrimming -> BlockTrimming -> Bool
== :: BlockTrimming -> BlockTrimming -> Bool
$c/= :: BlockTrimming -> BlockTrimming -> Bool
/= :: BlockTrimming -> BlockTrimming -> Bool
Eq, Eq BlockTrimming
Eq BlockTrimming =>
(BlockTrimming -> BlockTrimming -> Ordering)
-> (BlockTrimming -> BlockTrimming -> Bool)
-> (BlockTrimming -> BlockTrimming -> Bool)
-> (BlockTrimming -> BlockTrimming -> Bool)
-> (BlockTrimming -> BlockTrimming -> Bool)
-> (BlockTrimming -> BlockTrimming -> BlockTrimming)
-> (BlockTrimming -> BlockTrimming -> BlockTrimming)
-> Ord BlockTrimming
BlockTrimming -> BlockTrimming -> Bool
BlockTrimming -> BlockTrimming -> Ordering
BlockTrimming -> BlockTrimming -> BlockTrimming
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockTrimming -> BlockTrimming -> Ordering
compare :: BlockTrimming -> BlockTrimming -> Ordering
$c< :: BlockTrimming -> BlockTrimming -> Bool
< :: BlockTrimming -> BlockTrimming -> Bool
$c<= :: BlockTrimming -> BlockTrimming -> Bool
<= :: BlockTrimming -> BlockTrimming -> Bool
$c> :: BlockTrimming -> BlockTrimming -> Bool
> :: BlockTrimming -> BlockTrimming -> Bool
$c>= :: BlockTrimming -> BlockTrimming -> Bool
>= :: BlockTrimming -> BlockTrimming -> Bool
$cmax :: BlockTrimming -> BlockTrimming -> BlockTrimming
max :: BlockTrimming -> BlockTrimming -> BlockTrimming
$cmin :: BlockTrimming -> BlockTrimming -> BlockTrimming
min :: BlockTrimming -> BlockTrimming -> BlockTrimming
Ord, Int -> BlockTrimming
BlockTrimming -> Int
BlockTrimming -> [BlockTrimming]
BlockTrimming -> BlockTrimming
BlockTrimming -> BlockTrimming -> [BlockTrimming]
BlockTrimming -> BlockTrimming -> BlockTrimming -> [BlockTrimming]
(BlockTrimming -> BlockTrimming)
-> (BlockTrimming -> BlockTrimming)
-> (Int -> BlockTrimming)
-> (BlockTrimming -> Int)
-> (BlockTrimming -> [BlockTrimming])
-> (BlockTrimming -> BlockTrimming -> [BlockTrimming])
-> (BlockTrimming -> BlockTrimming -> [BlockTrimming])
-> (BlockTrimming
    -> BlockTrimming -> BlockTrimming -> [BlockTrimming])
-> Enum BlockTrimming
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BlockTrimming -> BlockTrimming
succ :: BlockTrimming -> BlockTrimming
$cpred :: BlockTrimming -> BlockTrimming
pred :: BlockTrimming -> BlockTrimming
$ctoEnum :: Int -> BlockTrimming
toEnum :: Int -> BlockTrimming
$cfromEnum :: BlockTrimming -> Int
fromEnum :: BlockTrimming -> Int
$cenumFrom :: BlockTrimming -> [BlockTrimming]
enumFrom :: BlockTrimming -> [BlockTrimming]
$cenumFromThen :: BlockTrimming -> BlockTrimming -> [BlockTrimming]
enumFromThen :: BlockTrimming -> BlockTrimming -> [BlockTrimming]
$cenumFromTo :: BlockTrimming -> BlockTrimming -> [BlockTrimming]
enumFromTo :: BlockTrimming -> BlockTrimming -> [BlockTrimming]
$cenumFromThenTo :: BlockTrimming -> BlockTrimming -> BlockTrimming -> [BlockTrimming]
enumFromThenTo :: BlockTrimming -> BlockTrimming -> BlockTrimming -> [BlockTrimming]
Enum, BlockTrimming
BlockTrimming -> BlockTrimming -> Bounded BlockTrimming
forall a. a -> a -> Bounded a
$cminBound :: BlockTrimming
minBound :: BlockTrimming
$cmaxBound :: BlockTrimming
maxBound :: BlockTrimming
Bounded)

data BlockStripping
  = NoStripBlocks
  | StripBlocks
  deriving (Int -> BlockStripping -> ShowS
[BlockStripping] -> ShowS
BlockStripping -> String
(Int -> BlockStripping -> ShowS)
-> (BlockStripping -> String)
-> ([BlockStripping] -> ShowS)
-> Show BlockStripping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockStripping -> ShowS
showsPrec :: Int -> BlockStripping -> ShowS
$cshow :: BlockStripping -> String
show :: BlockStripping -> String
$cshowList :: [BlockStripping] -> ShowS
showList :: [BlockStripping] -> ShowS
Show, ReadPrec [BlockStripping]
ReadPrec BlockStripping
Int -> ReadS BlockStripping
ReadS [BlockStripping]
(Int -> ReadS BlockStripping)
-> ReadS [BlockStripping]
-> ReadPrec BlockStripping
-> ReadPrec [BlockStripping]
-> Read BlockStripping
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BlockStripping
readsPrec :: Int -> ReadS BlockStripping
$creadList :: ReadS [BlockStripping]
readList :: ReadS [BlockStripping]
$creadPrec :: ReadPrec BlockStripping
readPrec :: ReadPrec BlockStripping
$creadListPrec :: ReadPrec [BlockStripping]
readListPrec :: ReadPrec [BlockStripping]
Read, BlockStripping -> BlockStripping -> Bool
(BlockStripping -> BlockStripping -> Bool)
-> (BlockStripping -> BlockStripping -> Bool) -> Eq BlockStripping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockStripping -> BlockStripping -> Bool
== :: BlockStripping -> BlockStripping -> Bool
$c/= :: BlockStripping -> BlockStripping -> Bool
/= :: BlockStripping -> BlockStripping -> Bool
Eq, Eq BlockStripping
Eq BlockStripping =>
(BlockStripping -> BlockStripping -> Ordering)
-> (BlockStripping -> BlockStripping -> Bool)
-> (BlockStripping -> BlockStripping -> Bool)
-> (BlockStripping -> BlockStripping -> Bool)
-> (BlockStripping -> BlockStripping -> Bool)
-> (BlockStripping -> BlockStripping -> BlockStripping)
-> (BlockStripping -> BlockStripping -> BlockStripping)
-> Ord BlockStripping
BlockStripping -> BlockStripping -> Bool
BlockStripping -> BlockStripping -> Ordering
BlockStripping -> BlockStripping -> BlockStripping
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockStripping -> BlockStripping -> Ordering
compare :: BlockStripping -> BlockStripping -> Ordering
$c< :: BlockStripping -> BlockStripping -> Bool
< :: BlockStripping -> BlockStripping -> Bool
$c<= :: BlockStripping -> BlockStripping -> Bool
<= :: BlockStripping -> BlockStripping -> Bool
$c> :: BlockStripping -> BlockStripping -> Bool
> :: BlockStripping -> BlockStripping -> Bool
$c>= :: BlockStripping -> BlockStripping -> Bool
>= :: BlockStripping -> BlockStripping -> Bool
$cmax :: BlockStripping -> BlockStripping -> BlockStripping
max :: BlockStripping -> BlockStripping -> BlockStripping
$cmin :: BlockStripping -> BlockStripping -> BlockStripping
min :: BlockStripping -> BlockStripping -> BlockStripping
Ord, Int -> BlockStripping
BlockStripping -> Int
BlockStripping -> [BlockStripping]
BlockStripping -> BlockStripping
BlockStripping -> BlockStripping -> [BlockStripping]
BlockStripping
-> BlockStripping -> BlockStripping -> [BlockStripping]
(BlockStripping -> BlockStripping)
-> (BlockStripping -> BlockStripping)
-> (Int -> BlockStripping)
-> (BlockStripping -> Int)
-> (BlockStripping -> [BlockStripping])
-> (BlockStripping -> BlockStripping -> [BlockStripping])
-> (BlockStripping -> BlockStripping -> [BlockStripping])
-> (BlockStripping
    -> BlockStripping -> BlockStripping -> [BlockStripping])
-> Enum BlockStripping
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BlockStripping -> BlockStripping
succ :: BlockStripping -> BlockStripping
$cpred :: BlockStripping -> BlockStripping
pred :: BlockStripping -> BlockStripping
$ctoEnum :: Int -> BlockStripping
toEnum :: Int -> BlockStripping
$cfromEnum :: BlockStripping -> Int
fromEnum :: BlockStripping -> Int
$cenumFrom :: BlockStripping -> [BlockStripping]
enumFrom :: BlockStripping -> [BlockStripping]
$cenumFromThen :: BlockStripping -> BlockStripping -> [BlockStripping]
enumFromThen :: BlockStripping -> BlockStripping -> [BlockStripping]
$cenumFromTo :: BlockStripping -> BlockStripping -> [BlockStripping]
enumFromTo :: BlockStripping -> BlockStripping -> [BlockStripping]
$cenumFromThenTo :: BlockStripping
-> BlockStripping -> BlockStripping -> [BlockStripping]
enumFromThenTo :: BlockStripping
-> BlockStripping -> BlockStripping -> [BlockStripping]
Enum, BlockStripping
BlockStripping -> BlockStripping -> Bounded BlockStripping
forall a. a -> a -> Bounded a
$cminBound :: BlockStripping
minBound :: BlockStripping
$cmaxBound :: BlockStripping
maxBound :: BlockStripping
Bounded)

data PolicyOverride
  = Default
  | Never
  | Always
  deriving (Int -> PolicyOverride -> ShowS
[PolicyOverride] -> ShowS
PolicyOverride -> String
(Int -> PolicyOverride -> ShowS)
-> (PolicyOverride -> String)
-> ([PolicyOverride] -> ShowS)
-> Show PolicyOverride
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PolicyOverride -> ShowS
showsPrec :: Int -> PolicyOverride -> ShowS
$cshow :: PolicyOverride -> String
show :: PolicyOverride -> String
$cshowList :: [PolicyOverride] -> ShowS
showList :: [PolicyOverride] -> ShowS
Show, ReadPrec [PolicyOverride]
ReadPrec PolicyOverride
Int -> ReadS PolicyOverride
ReadS [PolicyOverride]
(Int -> ReadS PolicyOverride)
-> ReadS [PolicyOverride]
-> ReadPrec PolicyOverride
-> ReadPrec [PolicyOverride]
-> Read PolicyOverride
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PolicyOverride
readsPrec :: Int -> ReadS PolicyOverride
$creadList :: ReadS [PolicyOverride]
readList :: ReadS [PolicyOverride]
$creadPrec :: ReadPrec PolicyOverride
readPrec :: ReadPrec PolicyOverride
$creadListPrec :: ReadPrec [PolicyOverride]
readListPrec :: ReadPrec [PolicyOverride]
Read, PolicyOverride -> PolicyOverride -> Bool
(PolicyOverride -> PolicyOverride -> Bool)
-> (PolicyOverride -> PolicyOverride -> Bool) -> Eq PolicyOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PolicyOverride -> PolicyOverride -> Bool
== :: PolicyOverride -> PolicyOverride -> Bool
$c/= :: PolicyOverride -> PolicyOverride -> Bool
/= :: PolicyOverride -> PolicyOverride -> Bool
Eq, Eq PolicyOverride
Eq PolicyOverride =>
(PolicyOverride -> PolicyOverride -> Ordering)
-> (PolicyOverride -> PolicyOverride -> Bool)
-> (PolicyOverride -> PolicyOverride -> Bool)
-> (PolicyOverride -> PolicyOverride -> Bool)
-> (PolicyOverride -> PolicyOverride -> Bool)
-> (PolicyOverride -> PolicyOverride -> PolicyOverride)
-> (PolicyOverride -> PolicyOverride -> PolicyOverride)
-> Ord PolicyOverride
PolicyOverride -> PolicyOverride -> Bool
PolicyOverride -> PolicyOverride -> Ordering
PolicyOverride -> PolicyOverride -> PolicyOverride
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PolicyOverride -> PolicyOverride -> Ordering
compare :: PolicyOverride -> PolicyOverride -> Ordering
$c< :: PolicyOverride -> PolicyOverride -> Bool
< :: PolicyOverride -> PolicyOverride -> Bool
$c<= :: PolicyOverride -> PolicyOverride -> Bool
<= :: PolicyOverride -> PolicyOverride -> Bool
$c> :: PolicyOverride -> PolicyOverride -> Bool
> :: PolicyOverride -> PolicyOverride -> Bool
$c>= :: PolicyOverride -> PolicyOverride -> Bool
>= :: PolicyOverride -> PolicyOverride -> Bool
$cmax :: PolicyOverride -> PolicyOverride -> PolicyOverride
max :: PolicyOverride -> PolicyOverride -> PolicyOverride
$cmin :: PolicyOverride -> PolicyOverride -> PolicyOverride
min :: PolicyOverride -> PolicyOverride -> PolicyOverride
Ord, Int -> PolicyOverride
PolicyOverride -> Int
PolicyOverride -> [PolicyOverride]
PolicyOverride -> PolicyOverride
PolicyOverride -> PolicyOverride -> [PolicyOverride]
PolicyOverride
-> PolicyOverride -> PolicyOverride -> [PolicyOverride]
(PolicyOverride -> PolicyOverride)
-> (PolicyOverride -> PolicyOverride)
-> (Int -> PolicyOverride)
-> (PolicyOverride -> Int)
-> (PolicyOverride -> [PolicyOverride])
-> (PolicyOverride -> PolicyOverride -> [PolicyOverride])
-> (PolicyOverride -> PolicyOverride -> [PolicyOverride])
-> (PolicyOverride
    -> PolicyOverride -> PolicyOverride -> [PolicyOverride])
-> Enum PolicyOverride
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PolicyOverride -> PolicyOverride
succ :: PolicyOverride -> PolicyOverride
$cpred :: PolicyOverride -> PolicyOverride
pred :: PolicyOverride -> PolicyOverride
$ctoEnum :: Int -> PolicyOverride
toEnum :: Int -> PolicyOverride
$cfromEnum :: PolicyOverride -> Int
fromEnum :: PolicyOverride -> Int
$cenumFrom :: PolicyOverride -> [PolicyOverride]
enumFrom :: PolicyOverride -> [PolicyOverride]
$cenumFromThen :: PolicyOverride -> PolicyOverride -> [PolicyOverride]
enumFromThen :: PolicyOverride -> PolicyOverride -> [PolicyOverride]
$cenumFromTo :: PolicyOverride -> PolicyOverride -> [PolicyOverride]
enumFromTo :: PolicyOverride -> PolicyOverride -> [PolicyOverride]
$cenumFromThenTo :: PolicyOverride
-> PolicyOverride -> PolicyOverride -> [PolicyOverride]
enumFromThenTo :: PolicyOverride
-> PolicyOverride -> PolicyOverride -> [PolicyOverride]
Enum, PolicyOverride
PolicyOverride -> PolicyOverride -> Bounded PolicyOverride
forall a. a -> a -> Bounded a
$cminBound :: PolicyOverride
minBound :: PolicyOverride
$cmaxBound :: PolicyOverride
maxBound :: PolicyOverride
Bounded)

class OverridablePolicy a where
  override :: PolicyOverride -> a -> a

instance OverridablePolicy BlockTrimming where
  override :: PolicyOverride -> BlockTrimming -> BlockTrimming
override PolicyOverride
Default BlockTrimming
a = BlockTrimming
a
  override PolicyOverride
Never BlockTrimming
_ = BlockTrimming
NoTrimBlocks
  override PolicyOverride
Always BlockTrimming
_ = BlockTrimming
TrimBlocks

instance OverridablePolicy BlockStripping where
  override :: PolicyOverride -> BlockStripping -> BlockStripping
override PolicyOverride
Default BlockStripping
a = BlockStripping
a
  override PolicyOverride
Never BlockStripping
_ = BlockStripping
NoStripBlocks
  override PolicyOverride
Always BlockStripping
_ = BlockStripping
StripBlocks

data POptions =
  POptions
    { POptions -> BlockTrimming
pstateTrimBlocks :: !BlockTrimming
    , POptions -> BlockStripping
pstateStripBlocks :: !BlockStripping
    }
  deriving (Int -> POptions -> ShowS
[POptions] -> ShowS
POptions -> String
(Int -> POptions -> ShowS)
-> (POptions -> String) -> ([POptions] -> ShowS) -> Show POptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> POptions -> ShowS
showsPrec :: Int -> POptions -> ShowS
$cshow :: POptions -> String
show :: POptions -> String
$cshowList :: [POptions] -> ShowS
showList :: [POptions] -> ShowS
Show, ReadPrec [POptions]
ReadPrec POptions
Int -> ReadS POptions
ReadS [POptions]
(Int -> ReadS POptions)
-> ReadS [POptions]
-> ReadPrec POptions
-> ReadPrec [POptions]
-> Read POptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS POptions
readsPrec :: Int -> ReadS POptions
$creadList :: ReadS [POptions]
readList :: ReadS [POptions]
$creadPrec :: ReadPrec POptions
readPrec :: ReadPrec POptions
$creadListPrec :: ReadPrec [POptions]
readListPrec :: ReadPrec [POptions]
Read, POptions -> POptions -> Bool
(POptions -> POptions -> Bool)
-> (POptions -> POptions -> Bool) -> Eq POptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: POptions -> POptions -> Bool
== :: POptions -> POptions -> Bool
$c/= :: POptions -> POptions -> Bool
/= :: POptions -> POptions -> Bool
Eq)

instance OverridablePolicy POptions where
  override :: PolicyOverride -> POptions -> POptions
override PolicyOverride
o (POptions BlockTrimming
tr BlockStripping
st) = BlockTrimming -> BlockStripping -> POptions
POptions (PolicyOverride -> BlockTrimming -> BlockTrimming
forall a. OverridablePolicy a => PolicyOverride -> a -> a
override PolicyOverride
o BlockTrimming
tr) (PolicyOverride -> BlockStripping -> BlockStripping
forall a. OverridablePolicy a => PolicyOverride -> a -> a
override PolicyOverride
o BlockStripping
st)


defPOptions :: POptions
defPOptions :: POptions
defPOptions = POptions
  { pstateTrimBlocks :: BlockTrimming
pstateTrimBlocks = BlockTrimming
TrimBlocks
  , pstateStripBlocks :: BlockStripping
pstateStripBlocks = BlockStripping
NoStripBlocks
  }

--------------------------------------------------------------------------------
-- Running Parsers
--------------------------------------------------------------------------------

parseGinger :: P a -> FilePath -> Text -> Either String a
parseGinger :: forall a. P a -> String -> Text -> Either String a
parseGinger = POptions -> P a -> String -> Text -> Either String a
forall a. POptions -> P a -> String -> Text -> Either String a
parseGingerWith POptions
defPOptions

parseGingerWith :: POptions -> P a -> FilePath -> Text -> Either String a
parseGingerWith :: forall a. POptions -> P a -> String -> Text -> Either String a
parseGingerWith POptions
options P a
p String
filename Text
input =
  (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle Text Void) a -> Either String a)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a b. (a -> b) -> a -> b
$ Reader POptions (Either (ParseErrorBundle Text Void) a)
-> POptions -> Either (ParseErrorBundle Text Void) a
forall r a. Reader r a -> r -> a
runReader (P a
-> String
-> Text
-> Reader POptions (Either (ParseErrorBundle Text Void) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT P a
p String
filename Text
input) POptions
options

parseGingerFile :: P a -> FilePath -> IO (Either String a)
parseGingerFile :: forall a. P a -> String -> IO (Either String a)
parseGingerFile = POptions -> P a -> String -> IO (Either String a)
forall a. POptions -> P a -> String -> IO (Either String a)
parseGingerFileWith POptions
defPOptions

parseGingerFileWith :: POptions -> P a -> FilePath -> IO (Either String a)
parseGingerFileWith :: forall a. POptions -> P a -> String -> IO (Either String a)
parseGingerFileWith POptions
options P a
p String
filename = do
  Text
input <- String -> IO Text
Text.readFile String
filename
  Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle Text Void) a -> Either String a)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a b. (a -> b) -> a -> b
$ Reader POptions (Either (ParseErrorBundle Text Void) a)
-> POptions -> Either (ParseErrorBundle Text Void) a
forall r a. Reader r a -> r -> a
runReader (P a
-> String
-> Text
-> Reader POptions (Either (ParseErrorBundle Text Void) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT P a
p String
filename Text
input) POptions
options

mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft :: forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft a -> b
f (Left a
x) = b -> Either b c
forall a b. a -> Either a b
Left (a -> b
f a
x)
mapLeft a -> b
_ (Right c
x) = c -> Either b c
forall a b. b -> Either a b
Right c
x

--------------------------------------------------------------------------------
-- Primitives etc.
--------------------------------------------------------------------------------

positioned :: (SourcePosition -> a -> b) -> P a -> P b
positioned :: forall a b. (SourcePosition -> a -> b) -> P a -> P b
positioned SourcePosition -> a -> b
setPos P a
inner = do
  SourcePosition
pos <- SourcePos -> SourcePosition
convertSourcePos (SourcePos -> SourcePosition)
-> ParsecT Void Text (Reader POptions) SourcePos
-> ParsecT Void Text (Reader POptions) SourcePosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  SourcePosition -> a -> b
setPos SourcePosition
pos (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P a
inner

convertSourcePos :: SourcePos -> SourcePosition
convertSourcePos :: SourcePos -> SourcePosition
convertSourcePos SourcePos
sp =
  SourcePosition
    { sourceFile :: Text
AST.sourceFile = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
Megaparsec.sourceName SourcePos
sp
    , sourceLine :: Int
AST.sourceLine = Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
Megaparsec.sourceLine SourcePos
sp
    , sourceColumn :: Int
AST.sourceColumn = Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
Megaparsec.sourceColumn SourcePos
sp
    }

identifierChar :: P Char
identifierChar :: P Char
identifierChar = (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isIdentifierChar

isIdentifierChar :: Char -> Bool
isIdentifierChar :: Char -> Bool
isIdentifierChar Char
c =
  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

identifierInitialChar :: P Char
identifierInitialChar :: P Char
identifierInitialChar = (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isIdentifierInitialChar

isIdentifierInitialChar :: Char -> Bool
isIdentifierInitialChar :: Char -> Bool
isIdentifierInitialChar Char
c =
  Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

isOperatorChar :: Char -> Bool
isOperatorChar :: Char -> Bool
isOperatorChar Char
c =
  Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"&|%^*+-/~.=!,(){}[]" :: [Char])

operatorChar :: P Char
operatorChar :: P Char
operatorChar = (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isOperatorChar

operator :: Text -> P ()
operator :: Text -> P ()
operator Text
op = P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader POptions) (Tokens Text) -> P ())
-> ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
op
  P Char -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P Char
operatorChar
  P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

keyword :: Text -> P ()
keyword :: Text -> P ()
keyword Text
kw = P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader POptions) (Tokens Text) -> P ())
-> ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
kw
  P Char -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P Char
identifierChar
  P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

identifierRaw :: P Text
identifierRaw :: P Text
identifierRaw = do
  Char -> Text -> Text
Text.cons (Char -> Text -> Text)
-> P Char -> ParsecT Void Text (Reader POptions) (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Char
identifierInitialChar
            ParsecT Void Text (Reader POptions) (Text -> Text)
-> P Text -> P Text
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
-> (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (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
"identifier char") Char -> Bool
Token Text -> Bool
isIdentifierChar
            P Text -> P () -> P Text
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

identifier :: P Identifier
identifier :: P Identifier
identifier = Text -> Identifier
Identifier (Text -> Identifier) -> P Text -> P Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Text
identifierRaw

stringLit :: P Text
stringLit :: P Text
stringLit =
  [P Text] -> P Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
q P Char -> P Text -> P Text
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
Text.pack (String -> Text)
-> ([Maybe Char] -> String) -> [Maybe Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Char] -> String
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Char] -> Text)
-> ParsecT Void Text (Reader POptions) [Maybe Char] -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) (Maybe Char)
-> ParsecT Void Text (Reader POptions) [Maybe Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
stringLitChar Char
q)) P Text -> P Char -> P Text
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
q P Text -> P () -> P Text
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    | Char
q <- [Char
'"', Char
'\'']
    ]

stringLitChar :: Char -> P (Maybe Char)
stringLitChar :: Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
stringLitChar Char
q =
  ParsecT Void Text (Reader POptions) (Maybe Char)
escapedStringLitChar ParsecT Void Text (Reader POptions) (Maybe Char)
-> ParsecT Void Text (Reader POptions) (Maybe Char)
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> P Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> P Char
plainStringLitChar Char
q)

escapedStringLitChar :: P (Maybe Char)
escapedStringLitChar :: ParsecT Void Text (Reader POptions) (Maybe Char)
escapedStringLitChar = do
  P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
  Char
c <- (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
  case Char
c of
    Char
'0' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\0'
    Char
'a' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\a'
    Char
'b' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\b'
    Char
'f' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\f'
    Char
'n' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\n'
    Char
'r' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\r'
    Char
't' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\t'
    Char
'v' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\v'
    Char
'"' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'"'
    Char
'\'' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\''
    Char
'\\' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Char -> Maybe Char)
-> Char
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\\'
    Char
'&' -> Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Char
forall a. Maybe a
Nothing
    Char
'x' -> Int -> ParsecT Void Text (Reader POptions) (Maybe Char)
hexEscape Int
2
    Char
'u' -> Int -> ParsecT Void Text (Reader POptions) (Maybe Char)
hexEscape Int
4
    Char
'U' -> Int -> ParsecT Void Text (Reader POptions) (Maybe Char)
hexEscape Int
8
    Char
t -> ErrorItem (Token Text)
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (NonEmpty (Token Text) -> ErrorItem (Token Text)
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty (Token Text) -> ErrorItem (Token Text))
-> NonEmpty (Token Text) -> ErrorItem (Token Text)
forall a b. (a -> b) -> a -> b
$ Char
t Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [])
  where
    hexEscape :: Int -> ParsecT Void Text (Reader POptions) (Maybe Char)
hexEscape Int
n = do
      String
ns <- Int -> P Char -> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n P Char
hexChar
      Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> (Int -> Maybe Char)
-> Int
-> ParsecT Void Text (Reader POptions) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> (Int -> Char) -> Int -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> ParsecT Void Text (Reader POptions) (Maybe Char))
-> Int -> ParsecT Void Text (Reader POptions) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ns)

hexChar :: P Char
hexChar :: P Char
hexChar = (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isHexChar

isHexChar :: Char -> Bool
isHexChar :: Char -> Bool
isHexChar Char
x =
  Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
||
  (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| 
  (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')

plainStringLitChar :: Char -> P Char
plainStringLitChar :: Char -> P Char
plainStringLitChar Char
q = (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Token Text -> [Token Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\\', Char
q])

intLit :: P Integer
intLit :: P Integer
intLit = do
  String -> Integer
forall a. Read a => String -> a
read (String -> Integer)
-> ParsecT Void Text (Reader POptions) String -> P Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text (Reader POptions) String
intDigits ParsecT Void Text (Reader POptions) String
-> P () -> ParsecT Void Text (Reader POptions) String
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)

intDigits :: P String
intDigits :: ParsecT Void Text (Reader POptions) String
intDigits = ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) String
 -> ParsecT Void Text (Reader POptions) String)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ do
  String
sign <- ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) String
 -> ParsecT Void Text (Reader POptions) String)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ (String
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option String
"" (ParsecT Void Text (Reader POptions) String
 -> ParsecT Void Text (Reader POptions) String)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ String
"-" String -> P Char -> ParsecT Void Text (Reader POptions) String
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-')
  String
str <- P Char -> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some P Char
digit
  String -> ParsecT Void Text (Reader POptions) String
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
sign String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str)

floatLit :: P Double
floatLit :: P Double
floatLit = do
  String
m <- do
    String
sign <- ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) String
 -> ParsecT Void Text (Reader POptions) String)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ (String
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option String
"" (ParsecT Void Text (Reader POptions) String
 -> ParsecT Void Text (Reader POptions) String)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ String
"-" String -> P Char -> ParsecT Void Text (Reader POptions) String
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-')
    String
intPart <- P Char -> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many P Char
digit
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
    String
fracPart <- P Char -> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many P Char
digit
    Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
intPart Bool -> Bool -> Bool
&& String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fracPart)
      (ErrorItem (Token Text) -> P ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (ErrorItem (Token Text) -> P ()) -> ErrorItem (Token Text) -> P ()
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> ErrorItem (Token Text)
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem (Token Text))
-> NonEmpty Char -> ErrorItem (Token Text)
forall a b. (a -> b) -> a -> b
$ Char
'd' Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| String
"ot-only float")
    String -> ParsecT Void Text (Reader POptions) String
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT Void Text (Reader POptions) String)
-> String -> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ String
sign String -> ShowS
forall a. [a] -> [a] -> [a]
++
           (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
intPart then String
"0" else String
intPart) String -> ShowS
forall a. [a] -> [a] -> [a]
++
           String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++
           (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fracPart then String
"0" else String
fracPart)
  String
e <- String
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option String
"" (ParsecT Void Text (Reader POptions) String
 -> ParsecT Void Text (Reader POptions) String)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall a b. (a -> b) -> a -> b
$ do
    P Char -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P Char -> P ()) -> P Char -> P ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'E' P Char -> P Char -> P Char
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'e'
    (Char
'e' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) String
intDigits
  P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  Double -> P Double
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> P Double) -> (String -> Double) -> String -> P Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double
forall a. Read a => String -> a
read (String -> P Double) -> String -> P Double
forall a b. (a -> b) -> a -> b
$ String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e


digit :: P Char
digit :: P Char
digit = (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDigit

equals :: P ()
equals :: P ()
equals = Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=' P Char -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

comma :: P ()
comma :: P ()
comma = Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' P Char -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

colon :: P ()
colon :: P ()
colon = Token Text -> ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' P Char -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

parenthesized :: P a -> P a
parenthesized :: forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
parenthesized = Text -> Text -> P a -> P a
forall c. Text -> Text -> P c -> P c
betweenT Text
"(" Text
")"

bracketed :: P a -> P a
bracketed :: forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
bracketed = Text -> Text -> P a -> P a
forall c. Text -> Text -> P c -> P c
betweenT Text
"[" Text
"]"

braced :: P a -> P a
braced :: forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
braced = Text -> Text -> P a -> P a
forall c. Text -> Text -> P c -> P c
betweenT Text
"{" Text
"}"

betweenT :: Text -> Text -> P c -> P c
betweenT :: forall c. Text -> Text -> P c -> P c
betweenT Text
o Text
c =
  P ()
-> P ()
-> ParsecT Void Text (Reader POptions) c
-> ParsecT Void Text (Reader POptions) c
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
o ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
c ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)

--------------------------------------------------------------------------------
-- Argument lists
--------------------------------------------------------------------------------

callArgs :: P ([Expr], [(Identifier, Expr)])
callArgs :: P ([Expr], [(Identifier, Expr)])
callArgs = do
  [(Maybe Identifier, Expr)]
args <- P [(Maybe Identifier, Expr)] -> P [(Maybe Identifier, Expr)]
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
parenthesized (P [(Maybe Identifier, Expr)] -> P [(Maybe Identifier, Expr)])
-> P [(Maybe Identifier, Expr)] -> P [(Maybe Identifier, Expr)]
forall a b. (a -> b) -> a -> b
$ P (Maybe Identifier, Expr)
argPair P (Maybe Identifier, Expr) -> P () -> P [(Maybe Identifier, Expr)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` P ()
comma
  let posArgs :: [Expr]
posArgs = [ Expr
e | (Maybe Identifier
Nothing, Expr
e) <- [(Maybe Identifier, Expr)]
args ]
      kwArgs :: [(Identifier, Expr)]
kwArgs = [ (Identifier
k, Expr
e) | (Just Identifier
k, Expr
e) <- [(Maybe Identifier, Expr)]
args ]
  ([Expr], [(Identifier, Expr)]) -> P ([Expr], [(Identifier, Expr)])
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr]
posArgs, [(Identifier, Expr)]
kwArgs)

argPair :: P (Maybe Identifier, Expr)
argPair :: P (Maybe Identifier, Expr)
argPair = P (Maybe Identifier, Expr) -> P (Maybe Identifier, Expr)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try P (Maybe Identifier, Expr)
kwArgPair P (Maybe Identifier, Expr)
-> P (Maybe Identifier, Expr) -> P (Maybe Identifier, Expr)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Identifier
forall a. Maybe a
Nothing ,) (Expr -> (Maybe Identifier, Expr))
-> ParsecT Void Text (Reader POptions) Expr
-> P (Maybe Identifier, Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
expr)

kwArgPair :: P (Maybe Identifier, Expr)
kwArgPair :: P (Maybe Identifier, Expr)
kwArgPair =
  (,) (Maybe Identifier -> Expr -> (Maybe Identifier, Expr))
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
-> ParsecT
     Void Text (Reader POptions) (Expr -> (Maybe Identifier, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe Identifier)
-> P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier) ParsecT
  Void Text (Reader POptions) (Expr -> (Maybe Identifier, Expr))
-> ParsecT Void Text (Reader POptions) Expr
-> P (Maybe Identifier, Expr)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P ()
equals P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Expr
expr)

argsSig :: P [(Identifier, Maybe Expr)]
argsSig :: P [(Identifier, Maybe Expr)]
argsSig = P [(Identifier, Maybe Expr)] -> P [(Identifier, Maybe Expr)]
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
parenthesized (P [(Identifier, Maybe Expr)] -> P [(Identifier, Maybe Expr)])
-> P [(Identifier, Maybe Expr)] -> P [(Identifier, Maybe Expr)]
forall a b. (a -> b) -> a -> b
$ P (Identifier, Maybe Expr)
argSig P (Identifier, Maybe Expr) -> P () -> P [(Identifier, Maybe Expr)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` P ()
comma

argSig :: P (Identifier, Maybe Expr)
argSig :: P (Identifier, Maybe Expr)
argSig =
  (,) (Identifier -> Maybe Expr -> (Identifier, Maybe Expr))
-> P Identifier
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe Expr -> (Identifier, Maybe Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier
      ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe Expr -> (Identifier, Maybe Expr))
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
-> P (Identifier, Maybe Expr)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"=" ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Expr
expr)
  

--------------------------------------------------------------------------------
-- Expression parsers
--------------------------------------------------------------------------------

expr :: P Expr
expr :: ParsecT Void Text (Reader POptions) Expr
expr = (SourcePosition -> Expr -> Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b. (SourcePosition -> a -> b) -> P a -> P b
positioned SourcePosition -> Expr -> Expr
PositionedE ParsecT Void Text (Reader POptions) Expr
ternaryExpr ParsecT Void Text (Reader POptions) Expr
-> String -> ParsecT Void Text (Reader POptions) Expr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"expression"

ternaryExpr :: P Expr
ternaryExpr :: ParsecT Void Text (Reader POptions) Expr
ternaryExpr = do
  Expr
lhs <- ParsecT Void Text (Reader POptions) Expr
booleanExpr
  Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Expr
lhs (ParsecT Void Text (Reader POptions) Expr
 -> ParsecT Void Text (Reader POptions) Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs
  where
    exprTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs = ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) Expr
 -> ParsecT Void Text (Reader POptions) Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ do
      Text -> P ()
keyword Text
"if"
      Expr
cond <- ParsecT Void Text (Reader POptions) Expr
booleanExpr
      Text -> P ()
keyword Text
"else"
      Expr
rhs <- ParsecT Void Text (Reader POptions) Expr
ternaryExpr
      Expr -> ParsecT Void Text (Reader POptions) Expr
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Void Text (Reader POptions) Expr)
-> Expr -> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
TernaryE Expr
cond Expr
lhs Expr
rhs

binaryExpr :: P BinaryOperator -> P Expr -> P Expr
binaryExpr :: P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
op ParsecT Void Text (Reader POptions) Expr
sub = do
  Expr
lhs <- ParsecT Void Text (Reader POptions) Expr
sub
  Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs
  where
    exprTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs = [ParsecT Void Text (Reader POptions) Expr]
-> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ do
          BinaryOperator
o <- P BinaryOperator
op
          Expr
rhs <- ParsecT Void Text (Reader POptions) Expr
sub
          Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail (BinaryOperator -> Expr -> Expr -> Expr
BinaryE BinaryOperator
o Expr
lhs Expr
rhs)
      , Expr -> ParsecT Void Text (Reader POptions) Expr
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
lhs
      ]

booleanExpr :: P Expr
booleanExpr :: ParsecT Void Text (Reader POptions) Expr
booleanExpr = P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
booleanOp ParsecT Void Text (Reader POptions) Expr
unaryNotExpr

booleanOp :: P BinaryOperator
booleanOp :: P BinaryOperator
booleanOp = [P BinaryOperator] -> P BinaryOperator
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ BinaryOperator
BinopAnd BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"and"
  , BinaryOperator
BinopOr BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"or"
  ]

unaryNotExpr :: P Expr
unaryNotExpr :: ParsecT Void Text (Reader POptions) Expr
unaryNotExpr =
  (Text -> P ()
keyword Text
"not" P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Expr
NotE (Expr -> Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
unaryNotExpr))
  ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void Text (Reader POptions) Expr
comparativeExpr

comparativeExpr :: P Expr
comparativeExpr :: ParsecT Void Text (Reader POptions) Expr
comparativeExpr = P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
comparativeOp ParsecT Void Text (Reader POptions) Expr
testExpr

comparativeOp :: P BinaryOperator
comparativeOp :: P BinaryOperator
comparativeOp = [P BinaryOperator] -> P BinaryOperator
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ BinaryOperator
BinopEqual BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"=="
  , BinaryOperator
BinopNotEqual BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"!="
  , BinaryOperator
BinopGT BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
">"
  , BinaryOperator
BinopGTE BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
">="
  , BinaryOperator
BinopLT BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"<"
  , BinaryOperator
BinopLTE BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"<="
  , BinaryOperator
BinopIn BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"in"
  ]

testExpr :: P Expr
testExpr :: ParsecT Void Text (Reader POptions) Expr
testExpr = do
  Expr
lhs <- ParsecT Void Text (Reader POptions) Expr
sub
  Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Expr
lhs (ParsecT Void Text (Reader POptions) Expr
 -> ParsecT Void Text (Reader POptions) Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs
  where
    sub :: ParsecT Void Text (Reader POptions) Expr
sub = ParsecT Void Text (Reader POptions) Expr
concatExpr

    exprTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs = do
      Text -> P ()
keyword Text
"is"
      Expr -> Expr
wrapper <- (Expr -> Expr)
-> ParsecT Void Text (Reader POptions) (Expr -> Expr)
-> ParsecT Void Text (Reader POptions) (Expr -> Expr)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Expr -> Expr
forall a. a -> a
id (ParsecT Void Text (Reader POptions) (Expr -> Expr)
 -> ParsecT Void Text (Reader POptions) (Expr -> Expr))
-> ParsecT Void Text (Reader POptions) (Expr -> Expr)
-> ParsecT Void Text (Reader POptions) (Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
NotE (Expr -> Expr)
-> P () -> ParsecT Void Text (Reader POptions) (Expr -> Expr)
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"not"
      Expr
test <- Identifier -> Expr
VarE (Identifier -> Expr)
-> P Identifier -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier
      ([Expr]
posArgs, [(Identifier, Expr)]
kwArgs) <- ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option ([], []) (P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try P ([Expr], [(Identifier, Expr)])
callArgs P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try P ([Expr], [(Identifier, Expr)])
soloArg)
      Expr -> ParsecT Void Text (Reader POptions) Expr
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Void Text (Reader POptions) Expr)
-> (Expr -> Expr)
-> Expr
-> ParsecT Void Text (Reader POptions) Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
wrapper (Expr -> ParsecT Void Text (Reader POptions) Expr)
-> Expr -> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> [Expr] -> [(Identifier, Expr)] -> Expr
IsE Expr
lhs Expr
test [Expr]
posArgs [(Identifier, Expr)]
kwArgs

soloArg :: P ([Expr], [(Identifier, Expr)])
soloArg :: P ([Expr], [(Identifier, Expr)])
soloArg = do
  P () -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ [P ()] -> P ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> P ()
keyword Text
"and"
    , Text -> P ()
keyword Text
"or"
    , Text -> P ()
keyword Text
"in"
    , Text -> P ()
keyword Text
"is"
    , Text -> P ()
keyword Text
"not"
    ]
  Expr
arg <- ParsecT Void Text (Reader POptions) Expr
expr
  ([Expr], [(Identifier, Expr)]) -> P ([Expr], [(Identifier, Expr)])
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr
arg], [])

concatExpr :: P Expr
concatExpr :: ParsecT Void Text (Reader POptions) Expr
concatExpr = P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
concatOp ParsecT Void Text (Reader POptions) Expr
additiveExpr

concatOp :: P BinaryOperator
concatOp :: P BinaryOperator
concatOp = BinaryOperator
BinopConcat BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"~"

additiveExpr :: P Expr
additiveExpr :: ParsecT Void Text (Reader POptions) Expr
additiveExpr = P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
additiveOp ParsecT Void Text (Reader POptions) Expr
multiplicativeExpr

additiveOp :: P BinaryOperator
additiveOp :: P BinaryOperator
additiveOp = [P BinaryOperator] -> P BinaryOperator
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ BinaryOperator
BinopPlus BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"+"
  , BinaryOperator
BinopMinus BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"-"
  ]

multiplicativeExpr :: P Expr
multiplicativeExpr :: ParsecT Void Text (Reader POptions) Expr
multiplicativeExpr = P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
multiplicativeOp ParsecT Void Text (Reader POptions) Expr
powerExpr

multiplicativeOp :: P BinaryOperator
multiplicativeOp :: P BinaryOperator
multiplicativeOp = [P BinaryOperator] -> P BinaryOperator
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ BinaryOperator
BinopIntDiv BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"//"
  , BinaryOperator
BinopDiv BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"/"
  , BinaryOperator
BinopMod BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"%"
  , BinaryOperator
BinopMul BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"*"
  ]

powerExpr :: P Expr
powerExpr :: ParsecT Void Text (Reader POptions) Expr
powerExpr = P BinaryOperator
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
binaryExpr P BinaryOperator
powerOp ParsecT Void Text (Reader POptions) Expr
memberAccessExpr

powerOp :: P BinaryOperator
powerOp :: P BinaryOperator
powerOp = BinaryOperator
BinopPower BinaryOperator -> P () -> P BinaryOperator
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
operator Text
"**"

memberAccessExpr :: P Expr
memberAccessExpr :: ParsecT Void Text (Reader POptions) Expr
memberAccessExpr = do
  Expr
lhs <- ParsecT Void Text (Reader POptions) Expr
simpleExpr
  Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs
  where
    exprTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
lhs = Expr -> ParsecT Void Text (Reader POptions) Expr
dotTail Expr
lhs
              ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> ParsecT Void Text (Reader POptions) Expr
bracketsTail Expr
lhs
              ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> ParsecT Void Text (Reader POptions) Expr
callTail Expr
lhs
              ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> ParsecT Void Text (Reader POptions) Expr
filterTail Expr
lhs
              ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr -> ParsecT Void Text (Reader POptions) Expr
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
lhs

    dotTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
dotTail Expr
lhs = do
      Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"." ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
      Identifier
selector <- P Identifier
identifier
      Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail (Expr -> Identifier -> Expr
DotE Expr
lhs Identifier
selector)

    sliceCont :: Expr -> Maybe Expr -> ParsecT Void Text (Reader POptions) Expr
sliceCont Expr
lhs Maybe Expr
op1May = do
      P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
":" ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
      Maybe Expr
op2May <- ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text (Reader POptions) Expr
expr
      Expr -> ParsecT Void Text (Reader POptions) Expr
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Void Text (Reader POptions) Expr)
-> Expr -> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr -> Maybe Expr -> Expr
SliceE Expr
lhs Maybe Expr
op1May Maybe Expr
op2May

    bracketsTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
bracketsTail Expr
lhs = do
      Expr
t <- ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
bracketed (ParsecT Void Text (Reader POptions) Expr
 -> ParsecT Void Text (Reader POptions) Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ do
        Maybe Expr
op1May <- ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text (Reader POptions) Expr
expr
        case Maybe Expr
op1May of
          Maybe Expr
Nothing ->
            Expr -> Maybe Expr -> ParsecT Void Text (Reader POptions) Expr
sliceCont Expr
lhs Maybe Expr
op1May
          Just Expr
op1 -> do
            [ParsecT Void Text (Reader POptions) Expr]
-> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
              [ Expr -> Maybe Expr -> ParsecT Void Text (Reader POptions) Expr
sliceCont Expr
lhs Maybe Expr
op1May
              , Expr -> ParsecT Void Text (Reader POptions) Expr
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Void Text (Reader POptions) Expr)
-> Expr -> ParsecT Void Text (Reader POptions) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
IndexE Expr
lhs Expr
op1
              ]
      Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail Expr
t

    callTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
callTail Expr
lhs = do
      ([Expr]
posArgs, [(Identifier, Expr)]
kwArgs) <- P ([Expr], [(Identifier, Expr)])
callArgs
      Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail (Expr -> [Expr] -> [(Identifier, Expr)] -> Expr
CallE Expr
lhs [Expr]
posArgs [(Identifier, Expr)]
kwArgs)

    filterTail :: Expr -> ParsecT Void Text (Reader POptions) Expr
filterTail Expr
lhs = do
      Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"|" ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
      Expr
callable <- ParsecT Void Text (Reader POptions) Expr
simpleExpr
      ([Expr]
posArgs, [(Identifier, Expr)]
kwArgs) <- ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option ([], []) (P ([Expr], [(Identifier, Expr)])
 -> P ([Expr], [(Identifier, Expr)]))
-> P ([Expr], [(Identifier, Expr)])
-> P ([Expr], [(Identifier, Expr)])
forall a b. (a -> b) -> a -> b
$ P ([Expr], [(Identifier, Expr)])
callArgs
      Expr -> ParsecT Void Text (Reader POptions) Expr
exprTail (Expr -> Expr -> [Expr] -> [(Identifier, Expr)] -> Expr
FilterE Expr
lhs Expr
callable [Expr]
posArgs [(Identifier, Expr)]
kwArgs)

list :: P (Vector Expr)
list :: P (Vector Expr)
list = [Expr] -> Vector Expr
forall a. [a] -> Vector a
V.fromList ([Expr] -> Vector Expr)
-> ParsecT Void Text (Reader POptions) [Expr] -> P (Vector Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) [Expr]
-> ParsecT Void Text (Reader POptions) [Expr]
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
bracketed (ParsecT Void Text (Reader POptions) Expr
expr ParsecT Void Text (Reader POptions) Expr
-> P () -> ParsecT Void Text (Reader POptions) [Expr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` P ()
comma)

dict :: P [(Expr, Expr)]
dict :: P [(Expr, Expr)]
dict = P [(Expr, Expr)] -> P [(Expr, Expr)]
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
braced (P (Expr, Expr)
dictPair P (Expr, Expr) -> P () -> P [(Expr, Expr)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` P ()
comma)

dictPair :: P (Expr, Expr)
dictPair :: P (Expr, Expr)
dictPair =
  (,) (Expr -> Expr -> (Expr, Expr))
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Expr -> (Expr, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
expr ParsecT Void Text (Reader POptions) (Expr -> (Expr, Expr))
-> ParsecT Void Text (Reader POptions) Expr -> P (Expr, Expr)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P ()
colon P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Expr
expr)

simpleExpr :: P Expr
simpleExpr :: ParsecT Void Text (Reader POptions) Expr
simpleExpr = [ParsecT Void Text (Reader POptions) Expr]
-> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
parenthesized ParsecT Void Text (Reader POptions) Expr
expr
  , Text -> Expr
StringLitE (Text -> Expr)
-> P Text -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Text
stringLit
  , Vector Expr -> Expr
ListE (Vector Expr -> Expr)
-> P (Vector Expr) -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Vector Expr)
list
  , [(Expr, Expr)] -> Expr
DictE ([(Expr, Expr)] -> Expr)
-> P [(Expr, Expr)] -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P [(Expr, Expr)]
dict
  , Double -> Expr
FloatLitE (Double -> Expr)
-> P Double -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Double -> P Double
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try P Double
floatLit
  , Integer -> Expr
IntLitE (Integer -> Expr)
-> P Integer -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Integer -> P Integer
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try P Integer
intLit
  , P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> P ()
operator Text
"-") P () -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Expr
NegateE (Expr -> Expr)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
parenthesized ParsecT Void Text (Reader POptions) Expr
expr ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Identifier -> Expr
VarE (Identifier -> Expr)
-> P Identifier -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier)))
  , Bool -> Expr
BoolE Bool
True Expr -> P () -> ParsecT Void Text (Reader POptions) Expr
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> P ()
keyword Text
"true" P () -> P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> P ()
keyword Text
"True")
  , Bool -> Expr
BoolE Bool
False Expr -> P () -> ParsecT Void Text (Reader POptions) Expr
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> P ()
keyword Text
"false" P () -> P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> P ()
keyword Text
"False")
  , Expr
NoneE Expr -> P () -> ParsecT Void Text (Reader POptions) Expr
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> P ()
keyword Text
"none" P () -> P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> P ()
keyword Text
"None")
  , Identifier -> Expr
VarE (Identifier -> Expr)
-> P Identifier -> ParsecT Void Text (Reader POptions) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier
  ]

-------------------------------------------------------------------------------- 
-- Statement-level tokens
--------------------------------------------------------------------------------

overrideToken :: P PolicyOverride
overrideToken :: P PolicyOverride
overrideToken =
  [P PolicyOverride] -> P PolicyOverride
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ PolicyOverride
Always PolicyOverride
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> P PolicyOverride
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"-"
    , PolicyOverride
Never PolicyOverride
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> P PolicyOverride
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"+"
    , PolicyOverride -> P PolicyOverride
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PolicyOverride
Default
    ]

openWithOverride :: Text -> P ()
openWithOverride :: Text -> P ()
openWithOverride Text
base = do
  POptions
policy <- ParsecT Void Text (Reader POptions) POptions
forall r (m :: * -> *). MonadReader r m => m r
ask
  let defLeader :: P ()
defLeader = case POptions -> BlockStripping
pstateStripBlocks POptions
policy of
        BlockStripping
StripBlocks -> P ()
inlineSpace
        BlockStripping
NoStripBlocks -> () -> P ()
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader POptions) (Tokens Text) -> P ())
-> ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall a b. (a -> b) -> a -> b
$ [ParsecT Void Text (Reader POptions) (Tokens Text)]
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) (Tokens Text)
 -> ParsecT Void Text (Reader POptions) (Tokens Text))
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b. (a -> b) -> a -> b
$ P ()
inlineSpace P ()
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
base ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"-" ParsecT Void Text (Reader POptions) (Tokens Text)
-> P () -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P Char -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P Char
operatorChar
        , ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) (Tokens Text)
 -> ParsecT Void Text (Reader POptions) (Tokens Text))
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
base ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"+" ParsecT Void Text (Reader POptions) (Tokens Text)
-> P () -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P Char -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P Char
operatorChar
        , ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) (Tokens Text)
 -> ParsecT Void Text (Reader POptions) (Tokens Text))
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
base ParsecT Void Text (Reader POptions) (Tokens Text)
-> P () -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P Char -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P Char
operatorChar
        , ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) (Tokens Text)
 -> ParsecT Void Text (Reader POptions) (Tokens Text))
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b. (a -> b) -> a -> b
$ P ()
defLeader P ()
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
base ParsecT Void Text (Reader POptions) (Tokens Text)
-> P () -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P Char -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P Char
operatorChar
        ]
  P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

inlineSpace :: P ()
inlineSpace :: P ()
inlineSpace =
  ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader POptions) (Tokens Text) -> P ())
-> ParsecT Void Text (Reader POptions) (Tokens Text) -> P ()
forall a b. (a -> b) -> a -> b
$
    Maybe String
-> (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (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
"non-newline whitespace")
      (\Token Text
c -> Char -> Bool
isSpace Char
Token Text
c Bool -> Bool -> Bool
&& Char
Token Text
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\r', Char
'\n'])

anyNewline :: P Text
anyNewline :: P Text
anyNewline =
  [P Text] -> P Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"\r\n"
    , Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"\n"
    , Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"\r"
    ]

closeWithOverride :: Text -> P ()
closeWithOverride :: Text -> P ()
closeWithOverride Text
base = do
  PolicyOverride
ovr <- P PolicyOverride -> P PolicyOverride
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P PolicyOverride -> P PolicyOverride)
-> P PolicyOverride -> P PolicyOverride
forall a b. (a -> b) -> a -> b
$ P PolicyOverride
overrideToken P PolicyOverride
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> P PolicyOverride
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
base
  POptions
policy <- (POptions -> POptions)
-> ParsecT Void Text (Reader POptions) POptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PolicyOverride -> POptions -> POptions
forall a. OverridablePolicy a => PolicyOverride -> a -> a
override PolicyOverride
ovr)
  Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (POptions -> BlockTrimming
pstateTrimBlocks POptions
policy BlockTrimming -> BlockTrimming -> Bool
forall a. Eq a => a -> a -> Bool
== BlockTrimming
TrimBlocks) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
    ParsecT Void Text (Reader POptions) (Maybe ()) -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader POptions) (Maybe ()) -> P ())
-> (P () -> ParsecT Void Text (Reader POptions) (Maybe ()))
-> P ()
-> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P () -> ParsecT Void Text (Reader POptions) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P () -> ParsecT Void Text (Reader POptions) (Maybe ()))
-> (P () -> P ())
-> P ()
-> ParsecT Void Text (Reader POptions) (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P ()
inlineSpace P () -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (P Text -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void P Text
anyNewline P () -> P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

openComment :: P ()
openComment :: P ()
openComment = Text -> P ()
openWithOverride Text
"{#"

closeComment :: P ()
closeComment :: P ()
closeComment = Text -> P ()
closeWithOverride Text
"#}"

openInterpolation :: P ()
openInterpolation :: P ()
openInterpolation = Text -> P ()
openWithOverride Text
"{{"

closeInterpolation :: P ()
closeInterpolation :: P ()
closeInterpolation = Text -> P ()
closeWithOverride Text
"}}"

openFlow :: P ()
openFlow :: P ()
openFlow = Text -> P ()
openWithOverride Text
"{%"

closeFlow :: P ()
closeFlow :: P ()
closeFlow = Text -> P ()
closeWithOverride Text
"%}"


-------------------------------------------------------------------------------- 
-- Statement parsers
--------------------------------------------------------------------------------

template :: P Template
template :: P Template
template = do
  Maybe Text -> Statement -> Template
Template (Maybe Text -> Statement -> Template)
-> ParsecT Void Text (Reader POptions) (Maybe Text)
-> ParsecT Void Text (Reader POptions) (Statement -> Template)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) (Maybe Text)
extends ParsecT Void Text (Reader POptions) (Statement -> Template)
-> ParsecT Void Text (Reader POptions) Statement -> P Template
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text (Reader POptions) Statement
statement

extends :: P (Maybe Text)
extends :: ParsecT Void Text (Reader POptions) (Maybe Text)
extends =
  P Text -> ParsecT Void Text (Reader POptions) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P Text -> ParsecT Void Text (Reader POptions) (Maybe Text))
-> (P Text -> P Text)
-> P Text
-> ParsecT Void Text (Reader POptions) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> P Text -> P Text
forall a. Text -> P a -> P a
flow Text
"extends" (P Text -> ParsecT Void Text (Reader POptions) (Maybe Text))
-> P Text -> ParsecT Void Text (Reader POptions) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    P Text
stringLit P Text -> P () -> P Text
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

simplifyS :: Statement -> Statement
simplifyS :: Statement -> Statement
simplifyS = (Statement -> Statement)
-> (Expr -> Expr) -> Statement -> Statement
traverseS Statement -> Statement
simplifyOne Expr -> Expr
forall a. a -> a
id
  where
    simplifyOne :: Statement -> Statement
simplifyOne (GroupS [Statement]
xs) = [Statement] -> Statement
wrap [Statement]
xs
    simplifyOne Statement
s = Statement
s

statement :: P Statement
statement :: ParsecT Void Text (Reader POptions) Statement
statement =
  [Statement] -> Statement
wrap ([Statement] -> Statement)
-> ParsecT Void Text (Reader POptions) [Statement]
-> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) [Statement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (Reader POptions) Statement
singleStatement

joinImmediates :: [Statement] -> [Statement]
joinImmediates :: [Statement] -> [Statement]
joinImmediates (ImmediateS Encoded
a : ImmediateS Encoded
b : [Statement]
xs) =
  [Statement] -> [Statement]
joinImmediates (Encoded -> Statement
ImmediateS (Encoded
a Encoded -> Encoded -> Encoded
forall a. Semigroup a => a -> a -> a
<> Encoded
b) Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
xs)
joinImmediates (PositionedS SourcePosition
pos (ImmediateS Encoded
a) : PositionedS SourcePosition
_ (ImmediateS Encoded
b) : [Statement]
xs) =
  [Statement] -> [Statement]
joinImmediates (SourcePosition -> Statement -> Statement
PositionedS SourcePosition
pos (Encoded -> Statement
ImmediateS (Encoded
a Encoded -> Encoded -> Encoded
forall a. Semigroup a => a -> a -> a
<> Encoded
b)) Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
xs)
joinImmediates (PositionedS SourcePosition
pos (ImmediateS Encoded
a) : ImmediateS Encoded
b : [Statement]
xs) =
  [Statement] -> [Statement]
joinImmediates (SourcePosition -> Statement -> Statement
PositionedS SourcePosition
pos (Encoded -> Statement
ImmediateS (Encoded
a Encoded -> Encoded -> Encoded
forall a. Semigroup a => a -> a -> a
<> Encoded
b)) Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
xs)
joinImmediates (Statement
x:[Statement]
xs) = Statement
x Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement] -> [Statement]
joinImmediates [Statement]
xs
joinImmediates [] = []

wrap :: [Statement] -> Statement
wrap :: [Statement] -> Statement
wrap [] = Encoded -> Statement
ImmediateS Encoded
forall a. Monoid a => a
mempty
wrap [Statement
x] = Statement
x
wrap [Statement]
xs = [Statement] -> Statement
GroupS ([Statement] -> [Statement]
joinImmediates [Statement]
xs)

singleStatement :: P Statement
singleStatement :: ParsecT Void Text (Reader POptions) Statement
singleStatement =
  (SourcePosition -> Statement -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (SourcePosition -> a -> b) -> P a -> P b
positioned SourcePosition -> Statement -> Statement
PositionedS (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$
    [ParsecT Void Text (Reader POptions) Statement]
-> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ ParsecT Void Text (Reader POptions) Statement
commentStatement
      , ParsecT Void Text (Reader POptions) Statement
interpolationStatement
      , ParsecT Void Text (Reader POptions) Statement
controlStatement
      , ParsecT Void Text (Reader POptions) Statement
immediateStatement
      ]

immediateStatement :: P Statement
immediateStatement :: ParsecT Void Text (Reader POptions) Statement
immediateStatement =
  Encoded -> Statement
ImmediateS (Encoded -> Statement) -> (Text -> Encoded) -> Text -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoded
Encoded (Text -> Statement)
-> P Text -> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 
    [P Text] -> P Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ P Text
anyNewline
      , ([Text] -> Text)
-> ParsecT Void Text (Reader POptions) [Text] -> P Text
forall a b.
(a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (ParsecT Void Text (Reader POptions) [Text] -> P Text)
-> (P Text -> ParsecT Void Text (Reader POptions) [Text])
-> P Text
-> P Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P Text -> ParsecT Void Text (Reader POptions) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (P Text -> P Text) -> P Text -> P Text
forall a b. (a -> b) -> a -> b
$
          P () -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (P ()
openComment P () -> P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
openInterpolation P () -> P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
openFlow) P () -> P Text -> P Text
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"{"
          P Text -> P Text -> P Text
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          Maybe String
-> (Token Text -> Bool)
-> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Token Text -> [Token Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'{', Char
'\n', Char
'\r'])
      ]

commentStatement :: P Statement
commentStatement :: ParsecT Void Text (Reader POptions) Statement
commentStatement =
  P ()
-> P ()
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between P ()
openComment P ()
closeComment (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$
    Text -> Statement
CommentS (Text -> Statement) -> (String -> Text) -> String -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Statement)
-> ParsecT Void Text (Reader POptions) String
-> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Char -> ParsecT Void Text (Reader POptions) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (P () -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy P ()
closeComment P () -> P Char -> P Char
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Char
ParsecT Void Text (Reader POptions) (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)

interpolationStatement :: P Statement
interpolationStatement :: ParsecT Void Text (Reader POptions) Statement
interpolationStatement =
  P ()
-> P ()
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between P ()
openInterpolation P ()
closeInterpolation (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$
    Expr -> Statement
InterpolationS (Expr -> Statement)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
expr

controlStatement :: P Statement
controlStatement :: ParsecT Void Text (Reader POptions) Statement
controlStatement =
  [ParsecT Void Text (Reader POptions) Statement]
-> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text (Reader POptions) Statement
ifStatement
    , ParsecT Void Text (Reader POptions) Statement
forStatement
    , ParsecT Void Text (Reader POptions) Statement
macroStatement
    , ParsecT Void Text (Reader POptions) Statement
callStatement
    , ParsecT Void Text (Reader POptions) Statement
filterStatement
    , ParsecT Void Text (Reader POptions) Statement
setStatement
    , ParsecT Void Text (Reader POptions) Statement
setBlockStatement
    , ParsecT Void Text (Reader POptions) Statement
includeStatement
    , ParsecT Void Text (Reader POptions) Statement
importStatement
    , ParsecT Void Text (Reader POptions) Statement
blockStatement
    , ParsecT Void Text (Reader POptions) Statement
withStatement
    ]

flow :: Text -> P a -> P a
flow :: forall a. Text -> P a -> P a
flow Text
kw P a
inner = do
  P () -> P ()
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (P ()
openFlow P () -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> P ()
keyword Text
kw)
  P a
inner P a -> P () -> P a
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
closeFlow

flow_ :: Text -> P ()
flow_ :: Text -> P ()
flow_ Text
kw = Text -> P () -> P ()
forall a. Text -> P a -> P a
flow Text
kw P ()
nop

withFlow :: Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow :: forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
kw P a
header P b
body a -> b -> c
combine =
  a -> b -> c
combine (a -> b -> c)
-> P a -> ParsecT Void Text (Reader POptions) (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> P a -> P a
forall a. Text -> P a -> P a
flow Text
kw P a
header ParsecT Void Text (Reader POptions) (b -> c)
-> P b -> ParsecT Void Text (Reader POptions) c
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P b
body ParsecT Void Text (Reader POptions) c
-> P () -> ParsecT Void Text (Reader POptions) c
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
flow_ (Text
"end" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kw)

nop :: P ()
nop :: P ()
nop = () -> P ()
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

ifStatement :: P Statement
ifStatement :: ParsecT Void Text (Reader POptions) Statement
ifStatement = do
  Text
-> ParsecT Void Text (Reader POptions) Expr
-> P (Statement, Maybe Statement)
-> (Expr -> (Statement, Maybe Statement) -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"if" ParsecT Void Text (Reader POptions) Expr
expr P (Statement, Maybe Statement)
body Expr -> (Statement, Maybe Statement) -> Statement
makeIf
  where
    body :: P (Statement, Maybe Statement)
body = do
      Statement
yes <- ParsecT Void Text (Reader POptions) Statement
statement
      [(Expr, Statement)]
elifs <- ParsecT Void Text (Reader POptions) (Expr, Statement)
-> ParsecT Void Text (Reader POptions) [(Expr, Statement)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text (Reader POptions) (Expr, Statement)
 -> ParsecT Void Text (Reader POptions) [(Expr, Statement)])
-> ParsecT Void Text (Reader POptions) (Expr, Statement)
-> ParsecT Void Text (Reader POptions) [(Expr, Statement)]
forall a b. (a -> b) -> a -> b
$ do
                Expr
cond' <- Text
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a. Text -> P a -> P a
flow Text
"elif" ParsecT Void Text (Reader POptions) Expr
expr
                Statement
body' <- ParsecT Void Text (Reader POptions) Statement
statement
                (Expr, Statement)
-> ParsecT Void Text (Reader POptions) (Expr, Statement)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
cond', Statement
body')
      Maybe Statement
finalElseMay <- ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) (Maybe Statement)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) (Maybe Statement))
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) (Maybe Statement)
forall a b. (a -> b) -> a -> b
$ Text -> P ()
flow_ Text
"else" P ()
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Statement
statement
      let noMay :: Maybe Statement
noMay = [(Expr, Statement)] -> Maybe Statement -> Maybe Statement
mergeElifs [(Expr, Statement)]
elifs Maybe Statement
finalElseMay
      (Statement, Maybe Statement) -> P (Statement, Maybe Statement)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement
yes, Maybe Statement
noMay)
    makeIf :: Expr -> (Statement, Maybe Statement) -> Statement
makeIf Expr
cond (Statement
yes, Maybe Statement
noMay) = Expr -> Statement -> Maybe Statement -> Statement
IfS Expr
cond Statement
yes Maybe Statement
noMay 

    mergeElifs :: [(Expr, Statement)] -> Maybe Statement -> Maybe Statement
    mergeElifs :: [(Expr, Statement)] -> Maybe Statement -> Maybe Statement
mergeElifs [] Maybe Statement
noMay = Maybe Statement
noMay
    mergeElifs ((Expr
cond', Statement
body'):[(Expr, Statement)]
elifs) Maybe Statement
noMay =
      Statement -> Maybe Statement
forall a. a -> Maybe a
Just (Statement -> Maybe Statement) -> Statement -> Maybe Statement
forall a b. (a -> b) -> a -> b
$ Expr -> Statement -> Maybe Statement -> Statement
IfS Expr
cond' Statement
body' ([(Expr, Statement)] -> Maybe Statement -> Maybe Statement
mergeElifs [(Expr, Statement)]
elifs Maybe Statement
noMay)

forStatement :: P Statement
forStatement :: ParsecT Void Text (Reader POptions) Statement
forStatement = do
  Text
-> P (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
-> P (Statement, Maybe Statement)
-> ((Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
    -> (Statement, Maybe Statement) -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"for" P (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
forHeader P (Statement, Maybe Statement)
forBody (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
-> (Statement, Maybe Statement) -> Statement
makeFor
  where
    forHeader :: P (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
forHeader = do
      (Maybe Identifier
keyMay, Identifier
val) <- do
        Identifier
a' <- P Identifier
identifier
        Maybe Identifier
bMay' <- P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P Identifier
 -> ParsecT Void Text (Reader POptions) (Maybe Identifier))
-> P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall a b. (a -> b) -> a -> b
$ P ()
comma P () -> P Identifier -> P Identifier
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Identifier
identifier
        (Maybe Identifier, Identifier)
-> ParsecT
     Void Text (Reader POptions) (Maybe Identifier, Identifier)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Identifier, Identifier)
 -> ParsecT
      Void Text (Reader POptions) (Maybe Identifier, Identifier))
-> (Maybe Identifier, Identifier)
-> ParsecT
     Void Text (Reader POptions) (Maybe Identifier, Identifier)
forall a b. (a -> b) -> a -> b
$ case (Identifier
a', Maybe Identifier
bMay') of
          (Identifier
a, Just Identifier
b) -> (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
a, Identifier
b)
          (Identifier
a, Maybe Identifier
Nothing) -> (Maybe Identifier
forall a. Maybe a
Nothing, Identifier
a)
      Text -> P ()
keyword Text
"in"
      Expr
iteree <- ParsecT Void Text (Reader POptions) Expr
expr
      Maybe Expr
filterMay <- ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (Reader POptions) Expr
 -> ParsecT Void Text (Reader POptions) (Maybe Expr))
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ Text -> P ()
keyword Text
"if" P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Expr
expr
      Recursivity
recursivity <- Recursivity
-> ParsecT Void Text (Reader POptions) Recursivity
-> ParsecT Void Text (Reader POptions) Recursivity
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Recursivity
NotRecursive (ParsecT Void Text (Reader POptions) Recursivity
 -> ParsecT Void Text (Reader POptions) Recursivity)
-> ParsecT Void Text (Reader POptions) Recursivity
-> ParsecT Void Text (Reader POptions) Recursivity
forall a b. (a -> b) -> a -> b
$ Recursivity
Recursive Recursivity
-> P () -> ParsecT Void Text (Reader POptions) Recursivity
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"recursive"
      (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
-> P (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Identifier
keyMay, Identifier
val, Expr
iteree, Maybe Expr
filterMay, Recursivity
recursivity)
    forBody :: P (Statement, Maybe Statement)
forBody = do
      Statement
body <- ParsecT Void Text (Reader POptions) Statement
statement
      Maybe Statement
elseMay <- ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) (Maybe Statement)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) (Maybe Statement))
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) (Maybe Statement)
forall a b. (a -> b) -> a -> b
$ Text -> P ()
flow_ Text
"else" P ()
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Statement
statement
      (Statement, Maybe Statement) -> P (Statement, Maybe Statement)
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement
body, Maybe Statement
elseMay)
    makeFor :: (Maybe Identifier, Identifier, Expr, Maybe Expr, Recursivity)
-> (Statement, Maybe Statement) -> Statement
makeFor (Maybe Identifier
keyMay, Identifier
val, Expr
iteree, Maybe Expr
filterMay, Recursivity
recursivity) (Statement
body, Maybe Statement
elseMay) =
      Maybe Identifier
-> Identifier
-> Expr
-> Maybe Expr
-> Recursivity
-> Statement
-> Maybe Statement
-> Statement
ForS Maybe Identifier
keyMay Identifier
val Expr
iteree Maybe Expr
filterMay Recursivity
recursivity Statement
body Maybe Statement
elseMay

macroStatement :: P Statement
macroStatement :: ParsecT Void Text (Reader POptions) Statement
macroStatement = do
  Text
-> P (Identifier, [(Identifier, Maybe Expr)])
-> ParsecT Void Text (Reader POptions) Statement
-> ((Identifier, [(Identifier, Maybe Expr)])
    -> Statement -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"macro" P (Identifier, [(Identifier, Maybe Expr)])
macroHeader ParsecT Void Text (Reader POptions) Statement
macroBody (Identifier, [(Identifier, Maybe Expr)]) -> Statement -> Statement
makeMacro
  where
    macroHeader :: P (Identifier, [MacroArg])
    macroHeader :: P (Identifier, [(Identifier, Maybe Expr)])
macroHeader =
      (,) (Identifier
 -> [(Identifier, Maybe Expr)]
 -> (Identifier, [(Identifier, Maybe Expr)]))
-> P Identifier
-> ParsecT
     Void
     Text
     (Reader POptions)
     ([(Identifier, Maybe Expr)]
      -> (Identifier, [(Identifier, Maybe Expr)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier ParsecT
  Void
  Text
  (Reader POptions)
  ([(Identifier, Maybe Expr)]
   -> (Identifier, [(Identifier, Maybe Expr)]))
-> P [(Identifier, Maybe Expr)]
-> P (Identifier, [(Identifier, Maybe Expr)])
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Identifier, Maybe Expr)]
-> P [(Identifier, Maybe Expr)] -> P [(Identifier, Maybe Expr)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] P [(Identifier, Maybe Expr)]
argsSig
    macroBody :: ParsecT Void Text (Reader POptions) Statement
macroBody =
      ParsecT Void Text (Reader POptions) Statement
statement
    makeMacro :: (Identifier, [MacroArg]) -> Statement -> Statement
    makeMacro :: (Identifier, [(Identifier, Maybe Expr)]) -> Statement -> Statement
makeMacro (Identifier
name, [(Identifier, Maybe Expr)]
args) Statement
body = Identifier -> [(Identifier, Maybe Expr)] -> Statement -> Statement
MacroS Identifier
name [(Identifier, Maybe Expr)]
args Statement
body

callStatement :: P Statement
callStatement :: ParsecT Void Text (Reader POptions) Statement
callStatement = do
  Text
-> P (Identifier, ([Expr], [(Identifier, Expr)]))
-> ParsecT Void Text (Reader POptions) Statement
-> ((Identifier, ([Expr], [(Identifier, Expr)]))
    -> Statement -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"call" P (Identifier, ([Expr], [(Identifier, Expr)]))
callHeader ParsecT Void Text (Reader POptions) Statement
callBody (Identifier, ([Expr], [(Identifier, Expr)]))
-> Statement -> Statement
makeCall
  where
    callHeader :: P (Identifier, ([Expr], [(Identifier, Expr)]))
callHeader = do
      (,) (Identifier
 -> ([Expr], [(Identifier, Expr)])
 -> (Identifier, ([Expr], [(Identifier, Expr)])))
-> P Identifier
-> ParsecT
     Void
     Text
     (Reader POptions)
     (([Expr], [(Identifier, Expr)])
      -> (Identifier, ([Expr], [(Identifier, Expr)])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier ParsecT
  Void
  Text
  (Reader POptions)
  (([Expr], [(Identifier, Expr)])
   -> (Identifier, ([Expr], [(Identifier, Expr)])))
-> P ([Expr], [(Identifier, Expr)])
-> P (Identifier, ([Expr], [(Identifier, Expr)]))
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P ([Expr], [(Identifier, Expr)])
callArgs
    callBody :: ParsecT Void Text (Reader POptions) Statement
callBody = ParsecT Void Text (Reader POptions) Statement
statement
    makeCall :: (Identifier, ([Expr], [(Identifier, Expr)]))
-> Statement -> Statement
makeCall (Identifier
callee, ([Expr]
args, [(Identifier, Expr)]
kwargs)) Statement
body = Identifier
-> [Expr] -> [(Identifier, Expr)] -> Statement -> Statement
CallS Identifier
callee [Expr]
args [(Identifier, Expr)]
kwargs Statement
body

filterStatement :: P Statement
filterStatement :: ParsecT Void Text (Reader POptions) Statement
filterStatement = do
  Text
-> P (Identifier, ([Expr], [(Identifier, Expr)]))
-> ParsecT Void Text (Reader POptions) Statement
-> ((Identifier, ([Expr], [(Identifier, Expr)]))
    -> Statement -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"filter" P (Identifier, ([Expr], [(Identifier, Expr)]))
filterHeader ParsecT Void Text (Reader POptions) Statement
filterBody (Identifier, ([Expr], [(Identifier, Expr)]))
-> Statement -> Statement
makeFilter
  where
    filterHeader :: P (Identifier, ([Expr], [(Identifier, Expr)]))
filterHeader = do
      (,) (Identifier
 -> ([Expr], [(Identifier, Expr)])
 -> (Identifier, ([Expr], [(Identifier, Expr)])))
-> P Identifier
-> ParsecT
     Void
     Text
     (Reader POptions)
     (([Expr], [(Identifier, Expr)])
      -> (Identifier, ([Expr], [(Identifier, Expr)])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier ParsecT
  Void
  Text
  (Reader POptions)
  (([Expr], [(Identifier, Expr)])
   -> (Identifier, ([Expr], [(Identifier, Expr)])))
-> P ([Expr], [(Identifier, Expr)])
-> P (Identifier, ([Expr], [(Identifier, Expr)]))
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P ([Expr], [(Identifier, Expr)])
callArgs
    filterBody :: ParsecT Void Text (Reader POptions) Statement
filterBody = ParsecT Void Text (Reader POptions) Statement
statement
    makeFilter :: (Identifier, ([Expr], [(Identifier, Expr)]))
-> Statement -> Statement
makeFilter (Identifier
filteree, ([Expr]
args, [(Identifier, Expr)]
kwargs)) Statement
body = Identifier
-> [Expr] -> [(Identifier, Expr)] -> Statement -> Statement
FilterS Identifier
filteree [Expr]
args [(Identifier, Expr)]
kwargs Statement
body

setPair :: P (Identifier, Expr)
setPair :: P (Identifier, Expr)
setPair = (,) (Identifier -> Expr -> (Identifier, Expr))
-> P Identifier
-> ParsecT Void Text (Reader POptions) (Expr -> (Identifier, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier ParsecT Void Text (Reader POptions) (Expr -> (Identifier, Expr))
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Expr -> (Identifier, Expr))
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"=" ParsecT Void Text (Reader POptions) (Expr -> (Identifier, Expr))
-> P ()
-> ParsecT Void Text (Reader POptions) (Expr -> (Identifier, Expr))
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text (Reader POptions) (Expr -> (Identifier, Expr))
-> ParsecT Void Text (Reader POptions) Expr -> P (Identifier, Expr)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text (Reader POptions) Expr
expr

setTargetPair :: P (SetTarget, Expr)
setTargetPair :: P (SetTarget, Expr)
setTargetPair = (,) (SetTarget -> Expr -> (SetTarget, Expr))
-> ParsecT Void Text (Reader POptions) SetTarget
-> ParsecT Void Text (Reader POptions) (Expr -> (SetTarget, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) SetTarget
setTarget ParsecT Void Text (Reader POptions) (Expr -> (SetTarget, Expr))
-> ParsecT Void Text (Reader POptions) (Tokens Text)
-> ParsecT Void Text (Reader POptions) (Expr -> (SetTarget, Expr))
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"=" ParsecT Void Text (Reader POptions) (Expr -> (SetTarget, Expr))
-> P ()
-> ParsecT Void Text (Reader POptions) (Expr -> (SetTarget, Expr))
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text (Reader POptions) (Expr -> (SetTarget, Expr))
-> ParsecT Void Text (Reader POptions) Expr -> P (SetTarget, Expr)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text (Reader POptions) Expr
expr

setTarget :: P SetTarget
setTarget :: ParsecT Void Text (Reader POptions) SetTarget
setTarget = do
  Identifier
leader <- P Identifier
identifier
  Maybe Identifier
selectorMay <- P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P Identifier
 -> ParsecT Void Text (Reader POptions) (Maybe Identifier))
-> P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"." ParsecT Void Text (Reader POptions) (Tokens Text)
-> P Identifier -> P Identifier
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Identifier
identifier
  SetTarget -> ParsecT Void Text (Reader POptions) SetTarget
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SetTarget -> ParsecT Void Text (Reader POptions) SetTarget)
-> SetTarget -> ParsecT Void Text (Reader POptions) SetTarget
forall a b. (a -> b) -> a -> b
$ case Maybe Identifier
selectorMay of
    Maybe Identifier
Nothing -> Identifier -> SetTarget
SetVar Identifier
leader
    Just Identifier
selector -> Identifier -> Identifier -> SetTarget
SetMutable Identifier
leader Identifier
selector

setStatement :: P Statement
setStatement :: ParsecT Void Text (Reader POptions) Statement
setStatement = ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$ do
  Text
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a. Text -> P a -> P a
flow Text
"set" (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$ (SetTarget -> Expr -> Statement) -> (SetTarget, Expr) -> Statement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SetTarget -> Expr -> Statement
SetS ((SetTarget, Expr) -> Statement)
-> P (SetTarget, Expr)
-> ParsecT Void Text (Reader POptions) Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (SetTarget, Expr)
setTargetPair

setBlockStatement :: P Statement
setBlockStatement :: ParsecT Void Text (Reader POptions) Statement
setBlockStatement = do
  Text
-> P (SetTarget, Maybe Expr)
-> ParsecT Void Text (Reader POptions) Statement
-> ((SetTarget, Maybe Expr) -> Statement -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"set" P (SetTarget, Maybe Expr)
setBlockHeader ParsecT Void Text (Reader POptions) Statement
setBlockBody (SetTarget, Maybe Expr) -> Statement -> Statement
makeSetBlock
  where
    setBlockHeader :: P (SetTarget, Maybe Expr)
setBlockHeader = (,) (SetTarget -> Maybe Expr -> (SetTarget, Maybe Expr))
-> ParsecT Void Text (Reader POptions) SetTarget
-> ParsecT
     Void Text (Reader POptions) (Maybe Expr -> (SetTarget, Maybe Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) SetTarget
setTarget ParsecT
  Void Text (Reader POptions) (Maybe Expr -> (SetTarget, Maybe Expr))
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
-> P (SetTarget, Maybe Expr)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text (Reader POptions) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"|" ParsecT Void Text (Reader POptions) (Tokens Text) -> P () -> P ()
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space P ()
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT Void Text (Reader POptions) Expr
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (Reader POptions) Expr
expr)
    setBlockBody :: ParsecT Void Text (Reader POptions) Statement
setBlockBody = ParsecT Void Text (Reader POptions) Statement
statement
    makeSetBlock :: (SetTarget, Maybe Expr) -> Statement -> Statement
makeSetBlock (SetTarget
name, Maybe Expr
filterMay) Statement
body =
      SetTarget -> Statement -> Maybe Expr -> Statement
SetBlockS SetTarget
name Statement
body Maybe Expr
filterMay

includeStatement :: P Statement
includeStatement :: ParsecT Void Text (Reader POptions) Statement
includeStatement =
  Text
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a. Text -> P a -> P a
flow Text
"include" (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$
    Expr -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement
IncludeS
      (Expr -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT
     Void
     Text
     (Reader POptions)
     (IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
expr
      ParsecT
  Void
  Text
  (Reader POptions)
  (IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> ParsecT
     Void Text (Reader POptions) (IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IncludeMissingPolicy
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option IncludeMissingPolicy
RequireMissing (IncludeMissingPolicy
IgnoreMissing IncludeMissingPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"ignore" ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"missing")
      ParsecT
  Void Text (Reader POptions) (IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) Statement
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option IncludeContextPolicy
WithContext ([ParsecT Void Text (Reader POptions) IncludeContextPolicy]
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ IncludeContextPolicy
WithContext IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"with" ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"context"
            , IncludeContextPolicy
WithoutContext IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"without" ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"context"
            ]
          )

importStatement :: P Statement
importStatement :: ParsecT Void Text (Reader POptions) Statement
importStatement =
  ParsecT Void Text (Reader POptions) Statement
wildcardImportStatement ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text (Reader POptions) Statement
explicitImportStatement

wildcardImportStatement :: P Statement
wildcardImportStatement :: ParsecT Void Text (Reader POptions) Statement
wildcardImportStatement =
  Text
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a. Text -> P a -> P a
flow Text
"import" (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$
    Expr
-> Maybe Identifier
-> Maybe [(Identifier, Maybe Identifier)]
-> IncludeMissingPolicy
-> IncludeContextPolicy
-> Statement
ImportS
      (Expr
 -> Maybe Identifier
 -> Maybe [(Identifier, Maybe Identifier)]
 -> IncludeMissingPolicy
 -> IncludeContextPolicy
 -> Statement)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe Identifier
      -> Maybe [(Identifier, Maybe Identifier)]
      -> IncludeMissingPolicy
      -> IncludeContextPolicy
      -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
expr
      ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe Identifier
   -> Maybe [(Identifier, Maybe Identifier)]
   -> IncludeMissingPolicy
   -> IncludeContextPolicy
   -> Statement)
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)]
      -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> P ()
keyword Text
"as" P () -> P Identifier -> P Identifier
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Identifier
identifier)
      ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe [(Identifier, Maybe Identifier)]
   -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)])
-> ParsecT
     Void
     Text
     (Reader POptions)
     (IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [(Identifier, Maybe Identifier)]
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)])
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(Identifier, Maybe Identifier)]
forall a. Maybe a
Nothing
      ParsecT
  Void
  Text
  (Reader POptions)
  (IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> ParsecT
     Void Text (Reader POptions) (IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IncludeMissingPolicy
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option IncludeMissingPolicy
RequireMissing (IncludeMissingPolicy
IgnoreMissing IncludeMissingPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"ignore" ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"missing")
      ParsecT
  Void Text (Reader POptions) (IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) Statement
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option IncludeContextPolicy
WithoutContext ([ParsecT Void Text (Reader POptions) IncludeContextPolicy]
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ IncludeContextPolicy
WithContext IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"with" ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"context"
            , IncludeContextPolicy
WithoutContext IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"without" ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"context"
            ]
          )

explicitImportStatement :: P Statement
explicitImportStatement :: ParsecT Void Text (Reader POptions) Statement
explicitImportStatement =
  Text
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a. Text -> P a -> P a
flow Text
"from" (ParsecT Void Text (Reader POptions) Statement
 -> ParsecT Void Text (Reader POptions) Statement)
-> ParsecT Void Text (Reader POptions) Statement
-> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$
    Expr
-> Maybe Identifier
-> Maybe [(Identifier, Maybe Identifier)]
-> IncludeMissingPolicy
-> IncludeContextPolicy
-> Statement
ImportS
      (Expr
 -> Maybe Identifier
 -> Maybe [(Identifier, Maybe Identifier)]
 -> IncludeMissingPolicy
 -> IncludeContextPolicy
 -> Statement)
-> ParsecT Void Text (Reader POptions) Expr
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe Identifier
      -> Maybe [(Identifier, Maybe Identifier)]
      -> IncludeMissingPolicy
      -> IncludeContextPolicy
      -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader POptions) Expr
expr
      ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe Identifier
   -> Maybe [(Identifier, Maybe Identifier)]
   -> IncludeMissingPolicy
   -> IncludeContextPolicy
   -> Statement)
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)]
      -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> P ()
keyword Text
"as" P () -> P Identifier -> P Identifier
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Identifier
identifier)
      ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe [(Identifier, Maybe Identifier)]
   -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> P ()
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)]
      -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Text -> P ()
keyword Text
"import"
      ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe [(Identifier, Maybe Identifier)]
   -> IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)])
-> ParsecT
     Void
     Text
     (Reader POptions)
     (IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(Identifier, Maybe Identifier)]
-> Maybe [(Identifier, Maybe Identifier)]
forall a. a -> Maybe a
Just ([(Identifier, Maybe Identifier)]
 -> Maybe [(Identifier, Maybe Identifier)])
-> ParsecT
     Void Text (Reader POptions) [(Identifier, Maybe Identifier)]
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe [(Identifier, Maybe Identifier)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            P () -> P ()
forall a. ParsecT Void Text (Reader POptions) a -> P ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ([P ()] -> P ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([P ()] -> P ()) -> [P ()] -> P ()
forall a b. (a -> b) -> a -> b
$ (Text -> P ()) -> [Text] -> [P ()]
forall a b. (a -> b) -> [a] -> [b]
map Text -> P ()
keyword [Text
"ignore", Text
"with", Text
"without"])
            P (Identifier, Maybe Identifier)
importPair P (Identifier, Maybe Identifier)
-> P ()
-> ParsecT
     Void Text (Reader POptions) [(Identifier, Maybe Identifier)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` P ()
comma
          )
      ParsecT
  Void
  Text
  (Reader POptions)
  (IncludeMissingPolicy -> IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> ParsecT
     Void Text (Reader POptions) (IncludeContextPolicy -> Statement)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IncludeMissingPolicy
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option IncludeMissingPolicy
RequireMissing (IncludeMissingPolicy
IgnoreMissing IncludeMissingPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"ignore" ParsecT Void Text (Reader POptions) IncludeMissingPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeMissingPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"missing")
      ParsecT
  Void Text (Reader POptions) (IncludeContextPolicy -> Statement)
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) Statement
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option IncludeContextPolicy
WithoutContext ([ParsecT Void Text (Reader POptions) IncludeContextPolicy]
-> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ IncludeContextPolicy
WithContext IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"with" ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"context"
            , IncludeContextPolicy
WithoutContext IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"without" ParsecT Void Text (Reader POptions) IncludeContextPolicy
-> P () -> ParsecT Void Text (Reader POptions) IncludeContextPolicy
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> P ()
keyword Text
"context"
            ]
          )

importPair :: P (Identifier, Maybe Identifier)
importPair :: P (Identifier, Maybe Identifier)
importPair = (,) (Identifier -> Maybe Identifier -> (Identifier, Maybe Identifier))
-> P Identifier
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Maybe Identifier -> (Identifier, Maybe Identifier))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier ParsecT
  Void
  Text
  (Reader POptions)
  (Maybe Identifier -> (Identifier, Maybe Identifier))
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
-> P (Identifier, Maybe Identifier)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Identifier
-> ParsecT Void Text (Reader POptions) (Maybe Identifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> P ()
keyword Text
"as" P () -> P Identifier -> P Identifier
forall a b.
ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Identifier
identifier)

withStatement :: P Statement
withStatement :: ParsecT Void Text (Reader POptions) Statement
withStatement = do
  Text
-> P [(Identifier, Expr)]
-> ParsecT Void Text (Reader POptions) Statement
-> ([(Identifier, Expr)] -> Statement -> Statement)
-> ParsecT Void Text (Reader POptions) Statement
forall a b c. Text -> P a -> P b -> (a -> b -> c) -> P c
withFlow Text
"with" P [(Identifier, Expr)]
withHeader ParsecT Void Text (Reader POptions) Statement
withBody [(Identifier, Expr)] -> Statement -> Statement
makeWith
  where
    withHeader :: P [(Identifier, Expr)]
withHeader = P (Identifier, Expr)
setPair P (Identifier, Expr) -> P () -> P [(Identifier, Expr)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` P ()
comma
    withBody :: ParsecT Void Text (Reader POptions) Statement
withBody = ParsecT Void Text (Reader POptions) Statement
statement
    makeWith :: [(Identifier, Expr)] -> Statement -> Statement
makeWith = [(Identifier, Expr)] -> Statement -> Statement
WithS

blockStatement :: P Statement
blockStatement :: ParsecT Void Text (Reader POptions) Statement
blockStatement = do
  (Identifier
name, Scoped
scopedness, Required
requiredness) <- Text
-> P (Identifier, Scoped, Required)
-> P (Identifier, Scoped, Required)
forall a. Text -> P a -> P a
flow Text
"block" (P (Identifier, Scoped, Required)
 -> P (Identifier, Scoped, Required))
-> P (Identifier, Scoped, Required)
-> P (Identifier, Scoped, Required)
forall a b. (a -> b) -> a -> b
$
    (,,) (Identifier
 -> Scoped -> Required -> (Identifier, Scoped, Required))
-> P Identifier
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Scoped -> Required -> (Identifier, Scoped, Required))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
identifier
         ParsecT
  Void
  Text
  (Reader POptions)
  (Scoped -> Required -> (Identifier, Scoped, Required))
-> ParsecT Void Text (Reader POptions) Scoped
-> ParsecT
     Void
     Text
     (Reader POptions)
     (Required -> (Identifier, Scoped, Required))
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Scoped
-> ParsecT Void Text (Reader POptions) Scoped
-> ParsecT Void Text (Reader POptions) Scoped
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Scoped
NotScoped (ParsecT Void Text (Reader POptions) Scoped
 -> ParsecT Void Text (Reader POptions) Scoped)
-> ParsecT Void Text (Reader POptions) Scoped
-> ParsecT Void Text (Reader POptions) Scoped
forall a b. (a -> b) -> a -> b
$ Scoped
Scoped Scoped -> P () -> ParsecT Void Text (Reader POptions) Scoped
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"scoped")
         ParsecT
  Void
  Text
  (Reader POptions)
  (Required -> (Identifier, Scoped, Required))
-> ParsecT Void Text (Reader POptions) Required
-> P (Identifier, Scoped, Required)
forall a b.
ParsecT Void Text (Reader POptions) (a -> b)
-> ParsecT Void Text (Reader POptions) a
-> ParsecT Void Text (Reader POptions) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Required
-> ParsecT Void Text (Reader POptions) Required
-> ParsecT Void Text (Reader POptions) Required
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Required
Optional (ParsecT Void Text (Reader POptions) Required
 -> ParsecT Void Text (Reader POptions) Required)
-> ParsecT Void Text (Reader POptions) Required
-> ParsecT Void Text (Reader POptions) Required
forall a b. (a -> b) -> a -> b
$ Required
Required Required -> P () -> ParsecT Void Text (Reader POptions) Required
forall a b.
a
-> ParsecT Void Text (Reader POptions) b
-> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> P ()
keyword Text
"required")
  Statement
body <- ParsecT Void Text (Reader POptions) Statement
statement
  ParsecT Void Text (Reader POptions) (Maybe ()) -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader POptions) (Maybe ()) -> P ())
-> ParsecT Void Text (Reader POptions) (Maybe ()) -> P ()
forall a b. (a -> b) -> a -> b
$ Text
-> ParsecT Void Text (Reader POptions) (Maybe ())
-> ParsecT Void Text (Reader POptions) (Maybe ())
forall a. Text -> P a -> P a
flow Text
"endblock" (P () -> ParsecT Void Text (Reader POptions) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (P () -> ParsecT Void Text (Reader POptions) (Maybe ()))
-> P () -> ParsecT Void Text (Reader POptions) (Maybe ())
forall a b. (a -> b) -> a -> b
$ Text -> P ()
keyword (Identifier -> Text
identifierName Identifier
name))
  Statement -> ParsecT Void Text (Reader POptions) Statement
forall a. a -> ParsecT Void Text (Reader POptions) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement -> ParsecT Void Text (Reader POptions) Statement)
-> Statement -> ParsecT Void Text (Reader POptions) Statement
forall a b. (a -> b) -> a -> b
$ Identifier -> Block -> Statement
BlockS Identifier
name (Statement -> Scoped -> Required -> Block
Block Statement
body Scoped
scopedness Required
requiredness)