{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Text.Haiji.Syntax.AST
( AST(..)
, Loaded(..)
, parser
) where
import Prelude hiding (takeWhile)
import Control.Applicative
import Control.Monad
import Control.Monad.State.Strict
import Data.Attoparsec.Text
import Data.Char
import Data.Maybe
import qualified Data.Text as T
#if MIN_VERSION_base(4,9,0)
import Data.Kind
#define STAR Type
#else
#define STAR *
#endif
import Text.Haiji.Syntax.Identifier
import Text.Haiji.Syntax.Expression
type Scoped = Bool
type Base = Bool
data Loaded = Fully
| Partially
data AST :: Loaded -> STAR where
Literal :: T.Text -> AST a
Eval :: Expression -> AST a
Condition :: Expression -> [AST a] -> Maybe [AST a] -> AST a
Foreach :: Identifier -> Expression -> [AST a] -> Maybe [AST a] -> AST a
Include :: FilePath -> AST 'Partially
Raw :: String -> AST a
Extends :: FilePath -> AST 'Partially
Base :: [AST 'Fully] -> AST 'Fully
Block :: Base -> Identifier -> Scoped -> [AST a] -> AST a
Super :: AST a
:: String -> AST a
Set :: Identifier -> Expression -> [AST a] -> AST a
deriving instance Eq (AST a)
instance Show (AST a) where
show :: AST a -> FilePath
show (Literal Text
l) = Text -> FilePath
T.unpack Text
l
show (Eval Expression
v) = FilePath
"{{ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows Expression
v FilePath
" }}"
show (Condition Expression
p [AST a]
ts Maybe [AST a]
mfs) =
FilePath
"{% if " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Expression
p forall a. [a] -> [a] -> [a]
++ FilePath
" %}" forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show [AST a]
ts forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\[AST a]
fs -> FilePath
"{% else %}" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show [AST a]
fs) Maybe [AST a]
mfs forall a. [a] -> [a] -> [a]
++
FilePath
"{% endif %}"
show (Foreach Identifier
x Expression
xs [AST a]
loopBody Maybe [AST a]
elseBody) =
FilePath
"{% for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Identifier
x forall a. [a] -> [a] -> [a]
++ FilePath
" in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Expression
xs forall a. [a] -> [a] -> [a]
++ FilePath
" %}" forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show [AST a]
loopBody forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"{% else %}" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show) Maybe [AST a]
elseBody forall a. [a] -> [a] -> [a]
++
FilePath
"{% endfor %}"
show (Include FilePath
file) = FilePath
"{% include \"" forall a. [a] -> [a] -> [a]
++ FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
"\" %}"
show (Raw FilePath
content) = FilePath
"{% raw %}" forall a. [a] -> [a] -> [a]
++ FilePath
content forall a. [a] -> [a] -> [a]
++ FilePath
"{% endraw %}"
show (Extends FilePath
file) = FilePath
"{% extends \"" forall a. [a] -> [a] -> [a]
++ FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
"\" %}"
show (Base [AST 'Fully]
asts) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show [AST 'Fully]
asts
show (Block Bool
_ Identifier
name Bool
scoped [AST a]
body) =
FilePath
"{% block " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Identifier
name forall a. [a] -> [a] -> [a]
++ (if Bool
scoped then FilePath
" scoped" else FilePath
"") forall a. [a] -> [a] -> [a]
++FilePath
" %}" forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show [AST a]
body forall a. [a] -> [a] -> [a]
++
FilePath
"{% endblock %}"
show AST a
Super = FilePath
"{{ super() }}"
show (Comment FilePath
c) = FilePath
"{#" forall a. [a] -> [a] -> [a]
++ FilePath
c forall a. [a] -> [a] -> [a]
++ FilePath
"#}"
show (Set Identifier
lhs Expression
rhs [AST a]
scopes) = FilePath
"{% set " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Identifier
lhs forall a. [a] -> [a] -> [a]
++ FilePath
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Expression
rhs forall a. [a] -> [a] -> [a]
++ FilePath
" %}" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> FilePath
show [AST a]
scopes
data ParserState =
ParserState
{ ParserState -> Maybe (AST 'Partially)
parserStateLeadingSpaces :: Maybe (AST 'Partially)
, ParserState -> Bool
parserStateInBaseTemplate :: Bool
} deriving (ParserState -> ParserState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserState -> ParserState -> Bool
$c/= :: ParserState -> ParserState -> Bool
== :: ParserState -> ParserState -> Bool
$c== :: ParserState -> ParserState -> Bool
Eq, Int -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParserState] -> ShowS
$cshowList :: [ParserState] -> ShowS
show :: ParserState -> FilePath
$cshow :: ParserState -> FilePath
showsPrec :: Int -> ParserState -> ShowS
$cshowsPrec :: Int -> ParserState -> ShowS
Show)
defaultParserState :: ParserState
defaultParserState :: ParserState
defaultParserState =
ParserState
{ parserStateLeadingSpaces :: Maybe (AST 'Partially)
parserStateLeadingSpaces = forall a. Maybe a
Nothing
, parserStateInBaseTemplate :: Bool
parserStateInBaseTemplate = Bool
True
}
#if MIN_VERSION_base(4,13,0)
newtype HaijiParser a =
HaijiParser
{ forall a. HaijiParser a -> StateT ParserState (Parser Text) a
unHaijiParser :: StateT ParserState Parser a
} deriving (forall a b. a -> HaijiParser b -> HaijiParser a
forall a b. (a -> b) -> HaijiParser a -> HaijiParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HaijiParser b -> HaijiParser a
$c<$ :: forall a b. a -> HaijiParser b -> HaijiParser a
fmap :: forall a b. (a -> b) -> HaijiParser a -> HaijiParser b
$cfmap :: forall a b. (a -> b) -> HaijiParser a -> HaijiParser b
Functor, Functor HaijiParser
forall a. a -> HaijiParser a
forall a b. HaijiParser a -> HaijiParser b -> HaijiParser a
forall a b. HaijiParser a -> HaijiParser b -> HaijiParser b
forall a b. HaijiParser (a -> b) -> HaijiParser a -> HaijiParser b
forall a b c.
(a -> b -> c) -> HaijiParser a -> HaijiParser b -> HaijiParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. HaijiParser a -> HaijiParser b -> HaijiParser a
$c<* :: forall a b. HaijiParser a -> HaijiParser b -> HaijiParser a
*> :: forall a b. HaijiParser a -> HaijiParser b -> HaijiParser b
$c*> :: forall a b. HaijiParser a -> HaijiParser b -> HaijiParser b
liftA2 :: forall a b c.
(a -> b -> c) -> HaijiParser a -> HaijiParser b -> HaijiParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> HaijiParser a -> HaijiParser b -> HaijiParser c
<*> :: forall a b. HaijiParser (a -> b) -> HaijiParser a -> HaijiParser b
$c<*> :: forall a b. HaijiParser (a -> b) -> HaijiParser a -> HaijiParser b
pure :: forall a. a -> HaijiParser a
$cpure :: forall a. a -> HaijiParser a
Applicative, Applicative HaijiParser
forall a. HaijiParser a
forall a. HaijiParser a -> HaijiParser [a]
forall a. HaijiParser a -> HaijiParser a -> HaijiParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. HaijiParser a -> HaijiParser [a]
$cmany :: forall a. HaijiParser a -> HaijiParser [a]
some :: forall a. HaijiParser a -> HaijiParser [a]
$csome :: forall a. HaijiParser a -> HaijiParser [a]
<|> :: forall a. HaijiParser a -> HaijiParser a -> HaijiParser a
$c<|> :: forall a. HaijiParser a -> HaijiParser a -> HaijiParser a
empty :: forall a. HaijiParser a
$cempty :: forall a. HaijiParser a
Alternative, Applicative HaijiParser
forall a. a -> HaijiParser a
forall a b. HaijiParser a -> HaijiParser b -> HaijiParser b
forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> HaijiParser a
$creturn :: forall a. a -> HaijiParser a
>> :: forall a b. HaijiParser a -> HaijiParser b -> HaijiParser b
$c>> :: forall a b. HaijiParser a -> HaijiParser b -> HaijiParser b
>>= :: forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
$c>>= :: forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
Monad, MonadState ParserState, Monad HaijiParser
forall a. FilePath -> HaijiParser a
forall (m :: * -> *).
Monad m -> (forall a. FilePath -> m a) -> MonadFail m
fail :: forall a. FilePath -> HaijiParser a
$cfail :: forall a. FilePath -> HaijiParser a
MonadFail)
#else
newtype HaijiParser a =
HaijiParser
{ unHaijiParser :: StateT ParserState Parser a
} deriving (Functor, Applicative, Alternative, Monad, MonadState ParserState)
#endif
runHaijiParser :: HaijiParser a -> Parser (a, ParserState)
runHaijiParser :: forall a. HaijiParser a -> Parser (a, ParserState)
runHaijiParser HaijiParser a
p = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall a. HaijiParser a -> StateT ParserState (Parser Text) a
unHaijiParser HaijiParser a
p) ParserState
defaultParserState
evalHaijiParser :: HaijiParser a -> Parser a
evalHaijiParser :: forall a. HaijiParser a -> Parser a
evalHaijiParser HaijiParser a
p = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HaijiParser a -> Parser (a, ParserState)
runHaijiParser HaijiParser a
p
liftParser :: Parser a -> HaijiParser a
liftParser :: forall a. Parser a -> HaijiParser a
liftParser = forall a. StateT ParserState (Parser Text) a -> HaijiParser a
HaijiParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
saveLeadingSpaces :: HaijiParser ()
saveLeadingSpaces :: HaijiParser ()
saveLeadingSpaces = forall a. Parser a -> HaijiParser a
liftParser forall {a :: Loaded}. Parser Text (Maybe (AST a))
leadingSpaces forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (AST 'Partially) -> HaijiParser ()
setLeadingSpaces where
leadingSpaces :: Parser Text (Maybe (AST a))
leadingSpaces = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Loaded). Text -> AST a
Literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isSpace)
withLeadingSpacesOf :: HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf :: forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf HaijiParser a
p a -> HaijiParser b
q = do
a
a <- HaijiParser a
p
HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> HaijiParser b
q a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (AST 'Partially) -> HaijiParser ()
setLeadingSpaces
setLeadingSpaces :: Maybe (AST 'Partially) -> HaijiParser ()
setLeadingSpaces :: Maybe (AST 'Partially) -> HaijiParser ()
setLeadingSpaces Maybe (AST 'Partially)
ss = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParserState
s -> ParserState
s { parserStateLeadingSpaces :: Maybe (AST 'Partially)
parserStateLeadingSpaces = Maybe (AST 'Partially)
ss })
resetLeadingSpaces :: HaijiParser ()
resetLeadingSpaces :: HaijiParser ()
resetLeadingSpaces = Maybe (AST 'Partially) -> HaijiParser ()
setLeadingSpaces forall a. Maybe a
Nothing
getLeadingSpaces :: HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces :: HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ParserState -> Maybe (AST 'Partially)
parserStateLeadingSpaces
setWhetherBaseTemplate :: Bool -> HaijiParser ()
setWhetherBaseTemplate :: Bool -> HaijiParser ()
setWhetherBaseTemplate Bool
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParserState
s -> ParserState
s { parserStateInBaseTemplate :: Bool
parserStateInBaseTemplate = Bool
x })
getWhetherBaseTemplate :: HaijiParser Bool
getWhetherBaseTemplate :: HaijiParser Bool
getWhetherBaseTemplate = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ParserState -> Bool
parserStateInBaseTemplate
parser :: Parser [AST 'Partially]
parser :: Parser [AST 'Partially]
parser = forall a. HaijiParser a -> Parser a
evalHaijiParser (HaijiParser [AST 'Partially]
haijiParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parser a -> HaijiParser a
liftParser forall t. Chunk t => Parser t ()
endOfInput)
haijiParser :: HaijiParser [AST 'Partially]
haijiParser :: HaijiParser [AST 'Partially]
haijiParser = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (HaijiParser ()
resetLeadingSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice (forall a b. (a -> b) -> [a] -> [b]
map HaijiParser (AST 'Partially) -> HaijiParser [AST 'Partially]
toList [HaijiParser (AST 'Partially)]
parsers)) where
parsers :: [HaijiParser (AST 'Partially)]
parsers = [ HaijiParser (AST 'Partially)
literal
, HaijiParser (AST 'Partially)
evaluation
, HaijiParser (AST 'Partially)
condition
, HaijiParser (AST 'Partially)
foreach
, HaijiParser (AST 'Partially)
include
, HaijiParser (AST 'Partially)
raw
, HaijiParser (AST 'Partially)
extends
, HaijiParser (AST 'Partially)
block
, HaijiParser (AST 'Partially)
super
, HaijiParser (AST 'Partially)
comment
, HaijiParser (AST 'Partially)
set
]
toList :: HaijiParser (AST 'Partially) -> HaijiParser [AST 'Partially]
toList HaijiParser (AST 'Partially)
p = do
AST 'Partially
b <- HaijiParser (AST 'Partially)
p
Maybe (AST 'Partially)
a <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe (AST 'Partially)
a [AST 'Partially
b]
literal :: HaijiParser (AST 'Partially)
literal :: HaijiParser (AST 'Partially)
literal = forall a. Parser a -> HaijiParser a
liftParser forall a b. (a -> b) -> a -> b
$ forall (a :: Loaded). Text -> AST a
Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text
go where
go :: Parser Text
go = do
Text
sp <- (Char -> Bool) -> Parser Text
takeTill (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
Maybe Char
pc <- Parser (Maybe Char)
peekChar
case Maybe Char
pc of
Maybe Char
Nothing -> if Text -> Bool
T.null Text
sp then forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"literal" else forall (m :: * -> *) a. Monad m => a -> m a
return Text
sp
Just Char
'{' -> do FilePath
x <- forall i a. Parser i a -> Parser i a
try forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Char -> Parser Text Char
char Char
'{', (Char -> Bool) -> Parser Text Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (FilePath
"{%#" :: String))]
Text -> Text -> Text
T.append (Text
sp Text -> Text -> Text
`T.append` FilePath -> Text
T.pack FilePath
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c))
Maybe Char
_ -> Text -> Text -> Text
T.append Text
sp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c))
evaluation :: HaijiParser (AST 'Partially)
evaluation :: HaijiParser (AST 'Partially)
evaluation = HaijiParser ()
saveLeadingSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> HaijiParser a
liftParser forall {a :: Loaded}. Parser Text (AST a)
deref where
deref :: Parser Text (AST a)
deref = forall (a :: Loaded). Expression -> AST a
Eval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> Parser Text
string Text
"{{" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
skipSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Expression
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
string Text
"}}"))
statement :: Parser a -> HaijiParser a
statement :: forall a. Parser a -> HaijiParser a
statement Parser a
f = Text -> HaijiParser a
start Text
"{%" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> HaijiParser a
start Text
"{%-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* HaijiParser ()
resetLeadingSpaces) where
start :: Text -> HaijiParser a
start Text
s = HaijiParser ()
saveLeadingSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> HaijiParser a
liftParser ((Text -> Parser Text
string Text
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
skipSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
f forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text
end))
end :: Parser Text
end = Text -> Parser Text
string Text
"%}" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text
string Text
"-%}" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipSpace)
condition :: HaijiParser (AST 'Partially)
condition :: HaijiParser (AST 'Partially)
condition = forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf (Text -> HaijiParser Expression
start Text
"if") Expression -> HaijiParser (AST 'Partially)
rest where
start :: Text -> HaijiParser Expression
start Text
kwd = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
kwd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Expression
expression
rest :: Expression -> HaijiParser (AST 'Partially)
rest Expression
cond = do
[AST 'Partially]
ifPart <- HaijiParser [AST 'Partially]
haijiParser
Maybe (AST 'Partially)
mElifPart <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf (Text -> HaijiParser Expression
start Text
"elif") Expression -> HaijiParser (AST 'Partially)
rest)
case Maybe (AST 'Partially)
mElifPart of
Just AST 'Partially
elif -> do
Maybe (AST 'Partially)
leadingElifSpaces <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Loaded).
Expression -> [AST a] -> Maybe [AST a] -> AST a
Condition Expression
cond ([AST 'Partially]
ifPart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingElifSpaces) (forall a. a -> Maybe a
Just [AST 'Partially
elif])
Maybe (AST 'Partially)
Nothing -> do
Maybe [AST 'Partially]
mElsePart <- HaijiParser (Maybe [AST 'Partially])
mayElse
Maybe (AST 'Partially)
leadingElseSpaces <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
Text
_ <- forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"endif"
Maybe (AST 'Partially)
leadingEndIfSpaces <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe [AST 'Partially]
mElsePart of
Maybe [AST 'Partially]
Nothing -> forall (a :: Loaded).
Expression -> [AST a] -> Maybe [AST a] -> AST a
Condition Expression
cond ([AST 'Partially]
ifPart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingEndIfSpaces) forall a. Maybe a
Nothing
Just [AST 'Partially]
elsePart -> forall (a :: Loaded).
Expression -> [AST a] -> Maybe [AST a] -> AST a
Condition Expression
cond ([AST 'Partially]
ifPart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingElseSpaces ) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [AST 'Partially]
elsePart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingEndIfSpaces)
mayElse :: HaijiParser (Maybe [AST 'Partially])
mayElse :: HaijiParser (Maybe [AST 'Partially])
mayElse = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HaijiParser [AST 'Partially]
elseParser) where
elseParser :: HaijiParser [AST 'Partially]
elseParser = forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf (forall a. Parser a -> HaijiParser a
statement (Text -> Parser Text
string Text
"else")) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const HaijiParser [AST 'Partially]
haijiParser
foreach :: HaijiParser (AST 'Partially)
foreach :: HaijiParser (AST 'Partially)
foreach = forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf forall {a :: Loaded}.
HaijiParser ([AST a] -> Maybe [AST a] -> AST a)
start forall {b}.
([AST 'Partially] -> Maybe [AST 'Partially] -> b) -> HaijiParser b
rest where
start :: HaijiParser ([AST a] -> Maybe [AST a] -> AST a)
start = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ forall (a :: Loaded).
Identifier -> Expression -> [AST a] -> Maybe [AST a] -> AST a
Foreach
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"for" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Identifier
identifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
string Text
"in" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Expression
expression)
rest :: ([AST 'Partially] -> Maybe [AST 'Partially] -> b) -> HaijiParser b
rest [AST 'Partially] -> Maybe [AST 'Partially] -> b
f = do
[AST 'Partially]
loopPart <- HaijiParser [AST 'Partially]
haijiParser
Maybe [AST 'Partially]
mElsePart <- HaijiParser (Maybe [AST 'Partially])
mayElse
Maybe (AST 'Partially)
leadingElseSpaces <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
Text
_ <- forall a. Parser a -> HaijiParser a
statement (Text -> Parser Text
string Text
"endfor")
Maybe (AST 'Partially)
leadingEndForSpaces <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe [AST 'Partially]
mElsePart of
Maybe [AST 'Partially]
Nothing -> [AST 'Partially] -> Maybe [AST 'Partially] -> b
f ([AST 'Partially]
loopPart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingEndForSpaces) forall a. Maybe a
Nothing
Just [AST 'Partially]
elsePart -> [AST 'Partially] -> Maybe [AST 'Partially] -> b
f ([AST 'Partially]
loopPart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingElseSpaces ) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [AST 'Partially]
elsePart forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingEndForSpaces)
include :: HaijiParser (AST 'Partially)
include :: HaijiParser (AST 'Partially)
include = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"include" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> AST 'Partially
Include forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text
quotedBy Char
'"' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text
quotedBy Char
'\'') where
quotedBy :: Char -> Parser Text
quotedBy Char
c = Char -> Parser Text Char
char Char
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeTill (forall a. Eq a => a -> a -> Bool
== Char
c) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
c
raw :: HaijiParser (AST 'Partially)
raw :: HaijiParser (AST 'Partially)
raw = forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf HaijiParser Text
start forall {p} {a :: Loaded}. p -> HaijiParser (AST a)
rest where
start :: HaijiParser Text
start = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"raw"
rest :: p -> HaijiParser (AST a)
rest p
_ = do
(FilePath
content, Maybe (AST 'Partially)
leadingEndRawSpaces) <- forall (f :: * -> *) a b. Alternative f => f a -> f b -> f ([a], b)
till (forall a. Parser a -> HaijiParser a
liftParser Parser Text Char
anyChar) (forall a. Parser a -> HaijiParser a
statement (Text -> Parser Text
string Text
"endraw") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Loaded). FilePath -> AST a
Raw forall a b. (a -> b) -> a -> b
$ FilePath
content forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" forall a. Show a => a -> FilePath
show Maybe (AST 'Partially)
leadingEndRawSpaces where
till :: Alternative f => f a -> f b -> f ([a], b)
till :: forall (f :: * -> *) a b. Alternative f => f a -> f b -> f ([a], b)
till f a
p f b
end = f ([a], b)
go where
go :: f ([a], b)
go = ((,) [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
end) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\a
a ([a]
as,b
b) -> (a
aforall a. a -> [a] -> [a]
:[a]
as, b
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ([a], b)
go)
extends :: HaijiParser (AST 'Partially)
extends :: HaijiParser (AST 'Partially)
extends = do
Bool
base <- HaijiParser Bool
getWhetherBaseTemplate
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
base forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"extends"
HaijiParser (AST 'Partially)
go forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> HaijiParser ()
setWhetherBaseTemplate Bool
False where
go :: HaijiParser (AST 'Partially)
go = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"extends" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> AST 'Partially
Extends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text
quotedBy Char
'"' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text
quotedBy Char
'\'')
quotedBy :: Char -> Parser Text
quotedBy Char
c = Char -> Parser Text Char
char Char
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeTill (forall a. Eq a => a -> a -> Bool
== Char
c) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
c
block :: HaijiParser (AST 'Partially)
block :: HaijiParser (AST 'Partially)
block = forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf HaijiParser Identifier
start Identifier -> HaijiParser (AST 'Partially)
rest where
start :: HaijiParser Identifier
start = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"block" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Identifier
identifier
rest :: Identifier -> HaijiParser (AST 'Partially)
rest Identifier
name = do
[AST 'Partially]
body <- HaijiParser [AST 'Partially]
haijiParser
Maybe Identifier
mayEndName <- forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"endblock" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Identifier
identifier))
Maybe (AST 'Partially)
leadingEndBlockSpaces <- HaijiParser (Maybe (AST 'Partially))
getLeadingSpaces
Bool
base <- HaijiParser Bool
getWhetherBaseTemplate
if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Identifier
name forall a. Eq a => a -> a -> Bool
==) Maybe Identifier
mayEndName
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: Loaded).
Bool -> Identifier -> Bool -> [AST a] -> AST a
Block Bool
base Identifier
name Bool
False ([AST 'Partially]
body forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (AST 'Partially)
leadingEndBlockSpaces)
else forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"block"
super :: HaijiParser (AST 'Partially)
super :: HaijiParser (AST 'Partially)
super = do
HaijiParser ()
saveLeadingSpaces
Char
_ <- forall a. Parser a -> HaijiParser a
liftParser ((Text -> Parser Text
string Text
"{{" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
skipSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(Text -> Parser Text
string Text
"super" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Text Char
char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Text Char
char Char
')') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
(Parser Text ()
skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
string Text
"}}"))
forall (m :: * -> *) a. Monad m => a -> m a
return forall (a :: Loaded). AST a
Super
comment :: HaijiParser (AST 'Partially)
= HaijiParser ()
saveLeadingSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> HaijiParser a
liftParser (Text -> Parser Text
string Text
"{#" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (a :: Loaded). FilePath -> AST a
Comment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text
string Text
"#}"))
set :: HaijiParser (AST 'Partially)
set :: HaijiParser (AST 'Partially)
set = forall a b. HaijiParser a -> (a -> HaijiParser b) -> HaijiParser b
withLeadingSpacesOf forall {a :: Loaded}. HaijiParser ([AST a] -> AST a)
start forall {b}. ([AST 'Partially] -> b) -> HaijiParser b
rest where
start :: HaijiParser ([AST a] -> AST a)
start = forall a. Parser a -> HaijiParser a
statement forall a b. (a -> b) -> a -> b
$ forall (a :: Loaded). Identifier -> Expression -> [AST a] -> AST a
Set
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"set" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Identifier
identifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
string Text
"=" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 Parser Text Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Expression
expression)
rest :: ([AST 'Partially] -> b) -> HaijiParser b
rest [AST 'Partially] -> b
f = [AST 'Partially] -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HaijiParser [AST 'Partially]
haijiParser