{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Text.Mustache.Parser
(
parse, parseWithConf
, MustacheConf(..), defaultConf
, Parser, MustacheState
, sectionBegin, sectionEnd, invertedSectionBegin, unescape2, unescape1
, delimiterChange, nestingSeparator
) where
import Control.Monad
import Data.Char (isAlphaNum, isSpace)
import Data.List (nub)
import Data.Monoid ((<>))
import Data.Text as T (Text, null, pack)
import Prelude as Prel
import Text.Mustache.Types
import Text.Parsec as P hiding (endOfLine, parse)
data MustacheConf = MustacheConf
{ MustacheConf -> (String, String)
delimiters :: (String, String)
}
data MustacheState = MustacheState
{ MustacheState -> (String, String)
sDelimiters :: (String, String)
, MustacheState -> Text
textStack :: Text
, MustacheState -> Bool
isBeginngingOfLine :: Bool
, MustacheState -> Maybe DataIdentifier
currentSectionName :: Maybe DataIdentifier
}
data ParseTagRes
= SectionBegin Bool DataIdentifier
| SectionEnd DataIdentifier
| Tag (Node Text)
| HandledTag
sectionBegin :: Char
sectionBegin :: Char
sectionBegin = Char
'#'
sectionEnd :: Char
sectionEnd :: Char
sectionEnd = Char
'/'
partialBegin :: Char
partialBegin :: Char
partialBegin = Char
'>'
invertedSectionBegin :: Char
invertedSectionBegin :: Char
invertedSectionBegin = Char
'^'
unescape2 :: (Char, Char)
unescape2 :: (Char, Char)
unescape2 = (Char
'{', Char
'}')
unescape1 :: Char
unescape1 :: Char
unescape1 = Char
'&'
delimiterChange :: Char
delimiterChange :: Char
delimiterChange = Char
'='
nestingSeparator :: Char
nestingSeparator :: Char
nestingSeparator = Char
'.'
comment :: Char
= Char
'!'
implicitIterator :: Char
implicitIterator :: Char
implicitIterator = Char
'.'
isAllowedDelimiterCharacter :: Char -> Bool
isAllowedDelimiterCharacter :: Char -> Bool
isAllowedDelimiterCharacter =
Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Foldable t => t Bool -> Bool
Prel.or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ Char -> Bool
isSpace, Char -> Bool
isAlphaNum, (forall a. Eq a => a -> a -> Bool
== Char
nestingSeparator) ]
allowedDelimiterCharacter :: Parser Char
allowedDelimiterCharacter :: Parser Char
allowedDelimiterCharacter =
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAllowedDelimiterCharacter
emptyState :: MustacheState
emptyState :: MustacheState
emptyState = (String, String)
-> Text -> Bool -> Maybe DataIdentifier -> MustacheState
MustacheState (String
"", String
"") forall a. Monoid a => a
mempty Bool
True forall a. Maybe a
Nothing
defaultConf :: MustacheConf
defaultConf :: MustacheConf
defaultConf = (String, String) -> MustacheConf
MustacheConf (String
"{{", String
"}}")
initState :: MustacheConf -> MustacheState
initState :: MustacheConf -> MustacheState
initState (MustacheConf { (String, String)
delimiters :: (String, String)
delimiters :: MustacheConf -> (String, String)
delimiters }) = MustacheState
emptyState { sDelimiters :: (String, String)
sDelimiters = (String, String)
delimiters }
setIsBeginning :: Bool -> Parser ()
setIsBeginning :: Bool -> Parser ()
setIsBeginning Bool
b = forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\MustacheState
s -> MustacheState
s { isBeginngingOfLine :: Bool
isBeginngingOfLine = Bool
b })
type Parser = Parsec Text MustacheState
(<<) :: Monad m => m b -> m a -> m b
<< :: forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
(<<) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
endOfLine :: Parser String
endOfLine :: Parser String
endOfLine = do
Maybe Char
r <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\r'
Char
n <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
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 Char
r [Char
n]
parse :: FilePath -> Text -> Either ParseError STree
parse :: String -> Text -> Either ParseError STree
parse = MustacheConf -> String -> Text -> Either ParseError STree
parseWithConf MustacheConf
defaultConf
parseWithConf :: MustacheConf -> FilePath -> Text -> Either ParseError STree
parseWithConf :: MustacheConf -> String -> Text -> Either ParseError STree
parseWithConf = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser STree
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. MustacheConf -> MustacheState
initState
parseText :: Parser STree
parseText :: Parser STree
parseText = do
(MustacheState { Bool
isBeginngingOfLine :: Bool
isBeginngingOfLine :: MustacheState -> Bool
isBeginngingOfLine }) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if Bool
isBeginngingOfLine
then Parser STree
parseLine
else Parser STree
continueLine
appendStringStack :: String -> Parser ()
appendStringStack :: String -> Parser ()
appendStringStack String
t = forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\MustacheState
s -> MustacheState
s { textStack :: Text
textStack = MustacheState -> Text
textStack MustacheState
s forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
t})
continueLine :: Parser STree
continueLine :: Parser STree
continueLine = do
(MustacheState { sDelimiters :: MustacheState -> (String, String)
sDelimiters = ( start :: String
start@(Char
x:String
_), String
_ )}) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let forbidden :: String
forbidden = Char
x forall a. a -> [a] -> [a]
: String
"\n\r"
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
forbidden) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser ()
appendStringStack
(forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser String
endOfLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser ()
appendStringStack forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ()
setIsBeginning Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser STree
parseLine)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
start) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text MustacheState Identity ParseTagRes
switchOnTag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParseTagRes -> Parser STree
continueFromTag)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser STree
finishFile)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser ()
appendStringStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser STree
continueLine)
flushText :: Parser STree
flushText :: Parser STree
flushText = do
s :: MustacheState
s@(MustacheState { textStack :: MustacheState -> Text
textStack = Text
text }) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState forall a b. (a -> b) -> a -> b
$ MustacheState
s { textStack :: Text
textStack = forall a. Monoid a => a
mempty }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
text
then []
else [forall α. α -> Node α
TextBlock Text
text]
finishFile :: Parser STree
finishFile :: Parser STree
finishFile =
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(MustacheState {currentSectionName :: MustacheState -> Maybe DataIdentifier
currentSectionName = Maybe DataIdentifier
Nothing}) -> Parser STree
flushText
(MustacheState {currentSectionName :: MustacheState -> Maybe DataIdentifier
currentSectionName = Just DataIdentifier
name}) ->
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail forall a b. (a -> b) -> a -> b
$ String
"Unclosed section " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DataIdentifier
name
parseLine :: Parser STree
parseLine :: Parser STree
parseLine = do
(MustacheState { sDelimiters :: MustacheState -> (String, String)
sDelimiters = ( String
start, String
_ ) }) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
String
initialWhitespace <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t")
let handleStandalone :: Parser STree
handleStandalone = do
ParseTagRes
tag <- ParsecT Text MustacheState Identity ParseTagRes
switchOnTag
let continueNoStandalone :: Parser STree
continueNoStandalone = do
String -> Parser ()
appendStringStack String
initialWhitespace
Bool -> Parser ()
setIsBeginning Bool
False
ParseTagRes -> Parser STree
continueFromTag ParseTagRes
tag
standaloneEnding :: Parser ()
standaloneEnding = do
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
endOfLine))
Bool -> Parser ()
setIsBeginning Bool
True
case ParseTagRes
tag of
Tag (Partial Maybe Text
_ String
name) ->
( Parser ()
standaloneEnding forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ParseTagRes -> Parser STree
continueFromTag (Node Text -> ParseTagRes
Tag (forall α. Maybe α -> String -> Node α
Partial (forall a. a -> Maybe a
Just (String -> Text
pack String
initialWhitespace)) String
name))
) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser STree
continueNoStandalone
Tag Node Text
_ -> Parser STree
continueNoStandalone
ParseTagRes
_ ->
( Parser ()
standaloneEnding forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ParseTagRes -> Parser STree
continueFromTag ParseTagRes
tag
) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser STree
continueNoStandalone
(forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
start) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser STree
handleStandalone)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ()
appendStringStack String
initialWhitespace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser STree
finishFile)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
appendStringStack String
initialWhitespace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ()
setIsBeginning Bool
False forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser STree
continueLine)
continueFromTag :: ParseTagRes -> Parser STree
continueFromTag :: ParseTagRes -> Parser STree
continueFromTag (SectionBegin Bool
inverted DataIdentifier
name) = do
STree
textNodes <- Parser STree
flushText
state :: MustacheState
state@(MustacheState
{ currentSectionName :: MustacheState -> Maybe DataIdentifier
currentSectionName = Maybe DataIdentifier
previousSection }) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState forall a b. (a -> b) -> a -> b
$ MustacheState
state { currentSectionName :: Maybe DataIdentifier
currentSectionName = forall (m :: * -> *) a. Monad m => a -> m a
return DataIdentifier
name }
STree
innerSectionContent <- Parser STree
parseText
let sectionTag :: DataIdentifier -> ASTree α -> Node α
sectionTag =
if Bool
inverted
then forall α. DataIdentifier -> ASTree α -> Node α
InvertedSection
else forall α. DataIdentifier -> ASTree α -> Node α
Section
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState forall a b. (a -> b) -> a -> b
$ \MustacheState
s -> MustacheState
s { currentSectionName :: Maybe DataIdentifier
currentSectionName = Maybe DataIdentifier
previousSection }
STree
outerSectionContent <- Parser STree
parseText
forall (m :: * -> *) a. Monad m => a -> m a
return (STree
textNodes forall a. Semigroup a => a -> a -> a
<> [forall α. DataIdentifier -> ASTree α -> Node α
sectionTag DataIdentifier
name STree
innerSectionContent] forall a. Semigroup a => a -> a -> a
<> STree
outerSectionContent)
continueFromTag (SectionEnd DataIdentifier
name) = do
(MustacheState
{ Maybe DataIdentifier
currentSectionName :: Maybe DataIdentifier
currentSectionName :: MustacheState -> Maybe DataIdentifier
currentSectionName }) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Maybe DataIdentifier
currentSectionName of
Just DataIdentifier
name' | DataIdentifier
name' forall a. Eq a => a -> a -> Bool
== DataIdentifier
name -> Parser STree
flushText
Just DataIdentifier
name' -> forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail forall a b. (a -> b) -> a -> b
$ String
"Expected closing sequence for \"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DataIdentifier
name forall a. Semigroup a => a -> a -> a
<> String
"\" got \"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DataIdentifier
name' forall a. Semigroup a => a -> a -> a
<> String
"\"."
Maybe DataIdentifier
Nothing -> forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail forall a b. (a -> b) -> a -> b
$ String
"Encountered closing sequence for \"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DataIdentifier
name forall a. Semigroup a => a -> a -> a
<> String
"\" which has never been opened."
continueFromTag (Tag Node Text
tag) = do
STree
textNodes <- Parser STree
flushText
STree
furtherNodes <- Parser STree
parseText
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ STree
textNodes forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) a. Monad m => a -> m a
return Node Text
tag forall a. Semigroup a => a -> a -> a
<> STree
furtherNodes
continueFromTag ParseTagRes
HandledTag = Parser STree
parseText
switchOnTag :: Parser ParseTagRes
switchOnTag :: ParsecT Text MustacheState Identity ParseTagRes
switchOnTag = do
(MustacheState { sDelimiters :: MustacheState -> (String, String)
sDelimiters = ( String
_, String
end )}) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ Bool -> DataIdentifier -> ParseTagRes
SectionBegin Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
sectionBegin) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd forall a. Monoid a => a
mempty)
, DataIdentifier -> ParseTagRes
SectionEnd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
sectionEnd) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd forall a. Monoid a => a
mempty)
, Node Text -> ParseTagRes
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall α. Bool -> DataIdentifier -> Node α
Variable Bool
False
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
unescape1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd forall a. Monoid a => a
mempty)
, Node Text -> ParseTagRes
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall α. Bool -> DataIdentifier -> Node α
Variable Bool
False
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (forall a b. (a, b) -> a
fst (Char, Char)
unescape2)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Char, Char)
unescape2))
, Node Text -> ParseTagRes
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall α. Maybe α -> String -> Node α
Partial forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
partialBegin) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf (forall a. Eq a => [a] -> [a]
nub String
end) forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
end)))
, forall (m :: * -> *) a. Monad m => a -> m a
return ParseTagRes
HandledTag
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<< (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
delimiterChange) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
parseDelimChange)
, Bool -> DataIdentifier -> ParseTagRes
SectionBegin Bool
True
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
invertedSectionBegin) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd forall a. Monoid a => a
mempty forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
n :: DataIdentifier
n@(NamedData [Text]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return DataIdentifier
n
DataIdentifier
_ -> forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"Inverted Sections can not be implicit."
)
, forall (m :: * -> *) a. Monad m => a -> m a
return ParseTagRes
HandledTag forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<< (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
comment) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
end))
, Node Text -> ParseTagRes
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall α. Bool -> DataIdentifier -> Node α
Variable Bool
True
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd forall a. Monoid a => a
mempty
]
where
parseDelimChange :: Parser ()
parseDelimChange = do
(MustacheState { sDelimiters :: MustacheState -> (String, String)
sDelimiters = ( String
_, String
end )}) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
String
delim1 <- Parser Char
allowedDelimiterCharacter forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
String
delim2 <- Parser Char
allowedDelimiterCharacter forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Char
delimiterChange forall a. a -> [a] -> [a]
: String
end))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
delim1 forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| String
delim2 forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty)
forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"Tags must contain more than 0 characters"
MustacheState
oldState <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState forall a b. (a -> b) -> a -> b
$ MustacheState
oldState { sDelimiters :: (String, String)
sDelimiters = (String
delim1, String
delim2) }
genParseTagEnd :: String -> Parser DataIdentifier
genParseTagEnd :: String -> ParsecT Text MustacheState Identity DataIdentifier
genParseTagEnd String
emod = do
(MustacheState { sDelimiters :: MustacheState -> (String, String)
sDelimiters = ( String
start, String
end ) }) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let nEnd :: String
nEnd = String
emod forall a. Semigroup a => a -> a -> a
<> String
end
disallowed :: String
disallowed = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Char
nestingSeparator forall a. a -> [a] -> [a]
: String
start forall a. Semigroup a => a -> a -> a
<> String
end
parseOne :: Parser [Text]
parseOne :: Parser [Text]
parseOne = do
String
one <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
disallowed
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead
(forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
nEnd))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
nestingSeparator))
[Text]
others <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
nestingSeparator forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser [Text]
parseOne)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
nEnd))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
one forall a. a -> [a] -> [a]
: [Text]
others
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
(forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
implicitIterator) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
nEnd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DataIdentifier
Implicit)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Text] -> DataIdentifier
NamedData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Text]
parseOne)