{-# 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

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Arrow (left)
-- >>> let execHaijiParser p = snd <$> runHaijiParser p

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
  Comment :: 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]

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser literal)
-- >>> eval "テスト{test"
-- Right テスト{test
-- >>> eval "テスト{{test"
-- Right テスト
-- >>> eval "   テスト  {test"
-- Right    テスト  {test
-- >>> eval "   テスト  {{test"
-- Right    テスト
-- >>> eval "   テスト  {%-test"
-- Right    テスト
-- >>> eval "   テスト  テスト  {%-test"
-- Right    テスト  テスト
-- >>> eval "main() {  }"
-- Right main() {  }
--
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))

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser evaluation)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser evaluation)
-- >>> eval "{{ foo }}"
-- Right {{ foo }}
-- >>> exec "{{ foo }}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{{bar}}"
-- Right {{ bar }}
-- >>> eval "{{   baz}}"
-- Right {{ baz }}
-- >>> eval " {{ foo }}"
-- Right {{ foo }}
-- >>> exec " {{ foo }}"
-- Right (ParserState {parserStateLeadingSpaces = Just  , parserStateInBaseTemplate = True})
-- >>> eval "{ { foo }}"
-- Left "parse error"
-- >>> eval "{{ foo } }"
-- Left "parse error"
-- >>> eval "{{ foo }} "
-- Right {{ foo }}
--
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
"}}"))

-- |
--
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser $ statement $ return ())
-- >>> exec "{%%}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> exec "{% %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> exec " {% %} "
-- Right (ParserState {parserStateLeadingSpaces = Just  , parserStateInBaseTemplate = True})
-- >>> exec " {%- -%} "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
--
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)

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser condition)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser condition)
-- >>> eval "{% if foo %}テスト{% endif %}"
-- Right {% if foo %}テスト{% endif %}
-- >>> exec "{% if foo %}テスト{% endif %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{%if foo%}テスト{%endif%}"
-- Right {% if foo %}テスト{% endif %}
-- >>> eval "{% iffoo %}テスト{% endif %}"
-- Left "parse error"
-- >>> eval "{% if foo %}真{% else %}偽{% endif %}"
-- Right {% if foo %}真{% else %}偽{% endif %}
-- >>> eval "{%if foo%}{%if bar%}{%else%}{%endif%}{%else%}{%if baz%}{%else%}{%endif%}{%endif%}"
-- Right {% if foo %}{% if bar %}{% else %}{% endif %}{% else %}{% if baz %}{% else %}{% endif %}{% endif %}
-- >>> eval "    {% if foo %}テスト{% endif %}"
-- Right {% if foo %}テスト{% endif %}
-- >>> exec "    {% if foo %}テスト{% endif %}"
-- Right (ParserState {parserStateLeadingSpaces = Just     , parserStateInBaseTemplate = True})
-- >>> eval "    {%- if foo -%}    テスト    {%- endif -%}    "
-- Right {% if foo %}テスト{% endif %}
-- >>> exec "    {%- if foo -%}    テスト    {%- endif -%}    "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{% if foo %}テスト{% elif bar %}hoge{% endif %}"
-- Right {% if foo %}テスト{% else %}{% if bar %}hoge{% endif %}{% endif %}
-- >>> eval "{% if foo %}  テスト  {% elif bar %}  hoge  {% endif %}"
-- Right {% if foo %}  テスト  {% else %}{% if bar %}  hoge  {% endif %}{% endif %}
-- >>> eval "{% if foo -%}  テスト  {%- elif bar -%}  hoge  {%- endif %}"
-- Right {% if foo %}テスト{% else %}{% if bar %}hoge{% endif %}{% endif %}
--
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

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser foreach)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser foreach)
-- >>> eval "{% for _ in foo %}loop{% endfor %}"
-- Right {% for _ in foo %}loop{% endfor %}
-- >>> exec "{% for _ in foo %}loop{% endfor %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{%for _ in foo%}loop{%endfor%}"
-- Right {% for _ in foo %}loop{% endfor %}
-- >>> eval "{% for_ in foo %}loop{% endfor %}"
-- Left "parse error"
-- >>> eval "{% for _in foo %}loop{% endfor %}"
-- Left "parse error"
-- >>> eval "{% for _ infoo %}loop{% endfor %}"
-- Left "parse error"
-- >>> eval "{% for _ in foo %}loop{% else %}else block{% endfor %}"
-- Right {% for _ in foo %}loop{% else %}else block{% endfor %}
-- >>> eval "{%for _ in foo%}loop{%else%}else block{%endfor%}"
-- Right {% for _ in foo %}loop{% else %}else block{% endfor %}
-- >>> eval "  {% for _ in foo %}  loop  {% endfor %}  "
-- Right {% for _ in foo %}  loop  {% endfor %}
-- >>> exec "  {% for _ in foo %}  loop  {% endfor %}  "
-- Right (ParserState {parserStateLeadingSpaces = Just   , parserStateInBaseTemplate = True})
-- >>> eval "  {%- for _ in foo -%}  loop  {%- endfor -%}  "
-- Right {% for _ in foo %}loop{% endfor %}
-- >>> exec "  {%- for _ in foo -%}  loop  {%- endfor -%}  "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
--
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)

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser include)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser include)
-- >>> eval "{% include \"foo.tmpl\" %}"
-- Right {% include "foo.tmpl" %}
-- >>> exec "{% include \"foo.tmpl\" %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{%include\"foo.tmpl\"%}"
-- Right {% include "foo.tmpl" %}
-- >>> eval "{% include 'foo.tmpl' %}"
-- Right {% include "foo.tmpl" %}
-- >>> eval "  {% include \"foo.tmpl\" %}"
-- Right {% include "foo.tmpl" %}
-- >>> exec "  {% include \"foo.tmpl\" %}"
-- Right (ParserState {parserStateLeadingSpaces = Just   , parserStateInBaseTemplate = True})
-- >>> eval "  {%- include \"foo.tmpl\" -%}   "
-- Right {% include "foo.tmpl" %}
-- >>> exec "  {%- include \"foo.tmpl\" -%}   "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
--
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 -- TODO: ここもっとマジメにやらないと

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser raw)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser raw)
-- >>> eval "{% raw %}test{% endraw %}"
-- Right {% raw %}test{% endraw %}
-- >>> exec "{% raw %}test{% endraw %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{%raw%}test{%endraw%}"
-- Right {% raw %}test{% endraw %}
-- >>> eval "{% raw %}{{ test }}{% endraw %}"
-- Right {% raw %}{{ test }}{% endraw %}
-- >>> eval "  {% raw %}  test  {% endraw %}"
-- Right {% raw %}  test  {% endraw %}
-- >>> exec "  {% raw %}  test  {% endraw %}"
-- Right (ParserState {parserStateLeadingSpaces = Just   , parserStateInBaseTemplate = True})
-- >>> eval "  {%- raw -%}   test  {%- endraw -%}  "
-- Right {% raw %}test{% endraw %}
-- >>> exec "  {%- raw -%}   test  {%- endraw -%}  "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
--
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)

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser extends)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser extends)
-- >>> eval "{% extends \"foo.tmpl\" %}"
-- Right {% extends "foo.tmpl" %}
-- >>> exec "{% extends \"foo.tmpl\" %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = False})
-- >>> eval "{%extends\"foo.tmpl\"%}"
-- Right {% extends "foo.tmpl" %}
-- >>> eval "{% extends 'foo.tmpl' %}"
-- Right {% extends "foo.tmpl" %}
-- >>> eval "  {% extends \"foo.tmpl\" %}"
-- Right {% extends "foo.tmpl" %}
-- >>> exec "  {% extends \"foo.tmpl\" %}"
-- Right (ParserState {parserStateLeadingSpaces = Just   , parserStateInBaseTemplate = False})
-- >>> eval "  {%- extends \"foo.tmpl\" -%}   "
-- Right {% extends "foo.tmpl" %}
-- >>> exec "  {%- extends \"foo.tmpl\" -%}   "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = False})
--
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 -- TODO: ここもっとマジメにやらないと

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser block)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser block)
-- >>> eval "{% block foo %}テスト{% endblock %}"
-- Right {% block foo %}テスト{% endblock %}
-- >>> exec "{% block foo %}テスト{% endblock %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "{% block foo %}テスト{% endblock foo %}"
-- Right {% block foo %}テスト{% endblock %}
-- >>> eval "{% block foo %}テスト{% endblock bar %}"
-- Left "parse error"
-- >>> eval "{%block foo%}テスト{%endblock%}"
-- Right {% block foo %}テスト{% endblock %}
-- >>> eval "{% blockfoo %}テスト{% endblock %}"
-- Left "parse error"
-- >>> eval "    {% block foo %}テスト{% endblock %}"
-- Right {% block foo %}テスト{% endblock %}
-- >>> exec "    {% block foo %}テスト{% endblock %}"
-- Right (ParserState {parserStateLeadingSpaces = Just     , parserStateInBaseTemplate = True})
-- >>> eval "    {%- block foo -%}    テスト    {%- endblock -%}    "
-- Right {% block foo %}テスト{% endblock %}
-- >>> exec "    {%- block foo -%}    テスト    {%- endblock -%}    "
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
--
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

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser comment)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser comment)
-- >>> eval "{# comment #}"
-- Right {# comment #}
-- >>> exec "{# comment #}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "  {# comment #}"
-- Right {# comment #}
-- >>> exec "  {# comment #}"
-- Right (ParserState {parserStateLeadingSpaces = Just   , parserStateInBaseTemplate = True})
--
comment :: HaijiParser (AST 'Partially)
comment :: HaijiParser (AST 'Partially)
comment = 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
"#}"))

-- |
--
-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser set)
-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser set)
-- >>> eval "{% set lhs = rhs %}"
-- Right {% set lhs = rhs %}
-- >>> exec "{% set lhs = rhs %}"
-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})
-- >>> eval "  {% set lhs = rhs %}"
-- Right {% set lhs = rhs %}
-- >>> exec "  {% set lhs = rhs %}"
-- Right (ParserState {parserStateLeadingSpaces = Just   , parserStateInBaseTemplate = True})
--
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