-- |
-- Module      :  Text.Microstache.Parser
-- Copyright   :  © 2016–2017 Stack Builders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>
-- Stability   :  experimental
-- Portability :  portable
--
-- Megaparsec parser for Mustache templates. You don't usually need to
-- import the module, because "Text.Microstache" re-exports everything you may
-- need, import that module instead.

{-# LANGUAGE CPP #-}
module Text.Microstache.Parser
  ( parseMustache )
where

import Control.Applicative   (Alternative (..), (<$), (<$>))
import Control.Monad         (unless, void)
import Data.Char             (isAlphaNum, isSpace)
import Data.Functor.Identity (Identity, runIdentity)
import Data.List             (intercalate)
import Data.Maybe            (catMaybes)
import Data.Text.Lazy        (Text)
import Data.Word             (Word)
import Text.Parsec
       (ParseError, ParsecT, Stream, anyChar, between, char, choice, eof,
       getPosition, getState, label, lookAhead, manyTill, notFollowedBy, oneOf,
       putState, runParserT, satisfy, sepBy1, sourceColumn, spaces, string, try,
       (<?>))
import Text.Parsec.Char ()

import Text.Microstache.Type

import qualified Data.Text as T

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..))
#endif

----------------------------------------------------------------------------
-- Parser

-- | Parse given Mustache template.

parseMustache
  :: FilePath
     -- ^ Location of file to parse
  -> Text
     -- ^ File contents (Mustache template)
  -> Either ParseError [Node]
     -- ^ Parsed nodes or parse error
parseMustache :: String -> Text -> Either ParseError [Node]
parseMustache String
name Text
contents = forall a. Identity a -> a
runIdentity (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (Parser () -> Parser [Node]
pMustache forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) (String -> String -> Delimiters
Delimiters String
"{{" String
"}}") String
name Text
contents)

pMustache :: Parser () -> Parser [Node]
pMustache :: Parser () -> Parser [Node]
pMustache = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
choice [ParsecT Text Delimiters Identity (Maybe Node)]
alts)
  where
    alts :: [ParsecT Text Delimiters Identity (Maybe Node)]
alts =
      [ forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. Parser a -> Parser a
withStandalone Parser ()
pComment
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Key -> [Node] -> Node) -> Parser Node
pSection String
"#" Key -> [Node] -> Node
Section
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Key -> [Node] -> Node) -> Parser Node
pSection String
"^" Key -> [Node] -> Node
InvertedSection
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
pStandalone ((Word -> Maybe Word) -> Parser Node
pPartial forall a. a -> Maybe a
Just)
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> Maybe Word) -> Parser Node
pPartial (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
      , forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. Parser a -> Parser a
withStandalone Parser ()
pSetDelimiters
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Node
pUnescapedVariable
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Node
pUnescapedSpecial
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Node
pEscapedVariable
      , forall a. a -> Maybe a
Just    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Node
pTextBlock ]
{-# INLINE pMustache #-}

pTextBlock :: Parser Node
pTextBlock :: Parser Node
pTextBlock = do
  String
start <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
openingDel
  (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
string') String
start
  let terminator :: Parser ()
terminator = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
        [ (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
string') String
start
        , Parser ()
pBol
        , forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ]
  Text -> Node
TextBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
someTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar Parser ()
terminator
{-# INLINE pTextBlock #-}

pUnescapedVariable :: Parser Node
pUnescapedVariable :: Parser Node
pUnescapedVariable = Key -> Node
UnescapedVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Key
pTag String
"&"
{-# INLINE pUnescapedVariable #-}

pUnescapedSpecial :: Parser Node
pUnescapedSpecial :: Parser Node
pUnescapedSpecial = do
  String
start <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
openingDel
  String
end   <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
closingDel
  forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> Parser String
symbol forall a b. (a -> b) -> a -> b
$ String
start forall a. [a] -> [a] -> [a]
++ String
"{") (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string forall a b. (a -> b) -> a -> b
$ String
"}" forall a. [a] -> [a] -> [a]
++ String
end) forall a b. (a -> b) -> a -> b
$
    Key -> Node
UnescapedVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Key
pKey
{-# INLINE pUnescapedSpecial #-}

pSection :: String -> (Key -> [Node] -> Node) -> Parser Node
pSection :: String -> (Key -> [Node] -> Node) -> Parser Node
pSection String
suffix Key -> [Node] -> Node
f = do
  Key
key   <- forall a. Parser a -> Parser a
withStandalone (String -> Parser Key
pTag String
suffix)
  [Node]
nodes <- (Parser () -> Parser [Node]
pMustache forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
withStandalone forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Parser ()
pClosingTag) Key
key
  forall (m :: * -> *) a. Monad m => a -> m a
return (Key -> [Node] -> Node
f Key
key [Node]
nodes)
{-# INLINE pSection #-}

pPartial :: (Word -> Maybe Word) -> Parser Node
pPartial :: (Word -> Maybe Word) -> Parser Node
pPartial Word -> Maybe Word
f = do
  Maybe Word
pos <- Word -> Maybe Word
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word
indentLevel
  Key
key <- String -> Parser Key
pTag String
">"
  let pname :: PName
pname = Text -> PName
PName forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack String
".") (Key -> [Text]
unKey Key
key)
  forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Maybe Word -> Node
Partial PName
pname Maybe Word
pos)
{-# INLINE pPartial #-}

pComment :: Parser ()
pComment :: Parser ()
pComment = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ do
  String
start <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
openingDel
  String
end   <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
closingDel
  (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
symbol) (String
start forall a. [a] -> [a] -> [a]
++ String
"!")
  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 (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
end)
{-# INLINE pComment #-}

pSetDelimiters :: Parser ()
pSetDelimiters :: Parser ()
pSetDelimiters = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ do
  String
start <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
openingDel
  String
end   <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
closingDel
  (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
symbol) (String
start forall a. [a] -> [a] -> [a]
++ String
"=")
  String
start' <- Parser String
pDelimiter forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn
  String
end'   <- Parser String
pDelimiter forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn
  (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string) (String
"=" forall a. [a] -> [a] -> [a]
++ String
end)
  forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (String -> String -> Delimiters
Delimiters String
start' String
end')
{-# INLINE pSetDelimiters #-}

pEscapedVariable :: Parser Node
pEscapedVariable :: Parser Node
pEscapedVariable = Key -> Node
EscapedVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Key
pTag String
""
{-# INLINE pEscapedVariable #-}

withStandalone :: Parser a -> Parser a
withStandalone :: forall a. Parser a -> Parser a
withStandalone Parser a
p = forall a. Parser a -> Parser a
pStandalone Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
p
{-# INLINE withStandalone #-}

pStandalone :: Parser a -> Parser a
pStandalone :: forall a. Parser a -> Parser a
pStandalone Parser a
p = Parser ()
pBol forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between Parser ()
sc (Parser ()
sc forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
eol forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)) Parser a
p)
{-# INLINE pStandalone #-}

pTag :: String -> Parser Key
pTag :: String -> Parser Key
pTag String
suffix = do
  String
start <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
openingDel
  String
end   <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
closingDel
  forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> Parser String
symbol forall a b. (a -> b) -> a -> b
$ String
start forall a. [a] -> [a] -> [a]
++ String
suffix) (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
end) Parser Key
pKey
{-# INLINE pTag #-}

pClosingTag :: Key -> Parser ()
pClosingTag :: Key -> Parser ()
pClosingTag Key
key = do
  String
start <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
openingDel
  String
end   <- forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets Delimiters -> String
closingDel
  let str :: String
str = Key -> String
keyToString Key
key
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> Parser String
symbol forall a b. (a -> b) -> a -> b
$ String
start forall a. [a] -> [a] -> [a]
++ String
"/") (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
end) (String -> Parser String
symbol String
str)
{-# INLINE pClosingTag #-}

pKey :: Parser Key
pKey :: Parser Key
pKey = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Key
Key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
label String
"key") (forall {u} {a}. ParsecT Text u Identity [a]
implicit forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text Delimiters Identity [Text]
other)
  where
    implicit :: ParsecT Text u Identity [a]
implicit = [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
    other :: ParsecT Text Delimiters Identity [Text]
other    = 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]
sepBy1 (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text Delimiters Identity Char
ch) (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
    ch :: ParsecT Text Delimiters Identity Char
ch       = ParsecT Text Delimiters Identity Char
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"-_"
{-# INLINE pKey #-}

pDelimiter :: Parser String
pDelimiter :: Parser String
pDelimiter = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
delChar) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"delimiter"
  where delChar :: Char -> Bool
delChar Char
x = Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'='
{-# INLINE pDelimiter #-}

indentLevel :: Parser Word
indentLevel :: Parser Word
indentLevel = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Column
sourceColumn) forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition

pBol :: Parser ()
pBol :: Parser ()
pBol = do
  Word
level <- Parser Word
indentLevel
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word
level forall a. Eq a => a -> a -> Bool
== Word
1) forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE pBol #-}

----------------------------------------------------------------------------
-- Auxiliary types

-- | Type of Mustache parser monad stack.

type Parser = ParsecT Text Delimiters Identity

-- | State used in Mustache parser. It includes currently set opening and
-- closing delimiters.

data Delimiters = Delimiters
  { Delimiters -> String
openingDel :: String
  , Delimiters -> String
closingDel :: String }

----------------------------------------------------------------------------
-- Lexer helpers and other

-- TODO: OLEG inline
scn :: Parser ()
scn :: Parser ()
scn = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
{-# INLINE scn #-}

sc :: Parser ()
sc :: Parser ()
sc = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"))
{-# INLINE sc #-}

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme Parser a
p = Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
{-# INLINE lexeme #-}

eol :: Parser ()
eol :: Parser ()
eol = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\r' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')

string' :: String -> Parser String
string' :: String -> Parser String
string' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string

symbol :: String -> Parser String
symbol :: String -> Parser String
symbol = forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
string'
{-# INLINE symbol #-}

keyToString :: Key -> String
keyToString :: Key -> String
keyToString (Key []) = String
"."
keyToString (Key [Text]
ks) = forall a. [a] -> [[a]] -> [a]
intercalate String
"." (Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ks)
{-# INLINE keyToString #-}

someTill :: Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
someTill :: 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]
someTill ParsecT s u m a
p ParsecT s u m end
end = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 ParsecT s u m a
p ParsecT s u m end
end

gets :: Monad m => (u -> a) -> ParsecT s u m a
gets :: forall (m :: * -> *) u a s. Monad m => (u -> a) -> ParsecT s u m a
gets u -> a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap u -> a
f forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

alphaNumChar :: Parser Char
alphaNumChar :: ParsecT Text Delimiters Identity Char
alphaNumChar = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaNum