{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.DocTemplates.Parser
   Copyright   : Copyright (C) 2009-2019 John MacFarlane
   License     : BSD3

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable
-}

module Text.DocTemplates.Parser
    ( compileTemplate ) where

import Data.Char (isAlphaNum)
import Control.Monad (guard, when)
import Control.Monad.Trans (lift)
import qualified Text.Parsec as P
import qualified Text.Parsec.Pos as P
import Control.Applicative
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as T
import System.FilePath
import Text.DocTemplates.Internal
import qualified Text.DocLayout as DL
#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup ((<>), Semigroup)
#endif

-- | Compile a template.  The FilePath parameter is used
-- to determine a default path and extension for partials
-- and may be left empty if partials are not used.
compileTemplate :: (TemplateMonad m, TemplateTarget a)
                => FilePath -> Text -> m (Either String (Template a))
compileTemplate :: forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
templPath Text
template = do
  res <- ParsecT Text PState m (Template a)
-> PState -> FilePath -> Text -> m (Either ParseError (Template a))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
P.runParserT (ParsecT Text PState m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate ParsecT Text PState m (Template a)
-> ParsecT Text PState m () -> ParsecT Text PState m (Template a)
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof)
           PState{ templatePath :: FilePath
templatePath    = FilePath
templPath
                 , partialNesting :: Int
partialNesting  = Int
1
                 , breakingSpaces :: Bool
breakingSpaces  = Bool
False
                 , firstNonspace :: SourcePos
firstNonspace   = FilePath -> SourcePos
P.initialPos FilePath
templPath
                 , nestedCol :: Maybe Int
nestedCol       = Maybe Int
forall a. Maybe a
Nothing
                 , insideDirective :: Bool
insideDirective = Bool
False
                 } FilePath
templPath Text
template
  case res of
       Left ParseError
e   -> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Template a) -> m (Either FilePath (Template a)))
-> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (Template a)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Template a))
-> FilePath -> Either FilePath (Template a)
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
e
       Right Template a
x  -> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Template a) -> m (Either FilePath (Template a)))
-> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a b. (a -> b) -> a -> b
$ Template a -> Either FilePath (Template a)
forall a b. b -> Either a b
Right Template a
x


data PState =
  PState { PState -> FilePath
templatePath    :: FilePath
         , PState -> Int
partialNesting  :: !Int
         , PState -> Bool
breakingSpaces  :: !Bool
         , PState -> SourcePos
firstNonspace   :: P.SourcePos
         , PState -> Maybe Int
nestedCol       :: Maybe Int
         , PState -> Bool
insideDirective :: Bool
         }

type Parser = P.ParsecT Text PState

pTemplate :: (TemplateMonad m, TemplateTarget a) => Parser m (Template a)
pTemplate :: forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate = do
  ParsecT Text PState m () -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
pComment
  [Template a] -> Template a
forall a. Monoid a => [a] -> a
mconcat ([Template a] -> Template a)
-> ParsecT Text PState m [Template a]
-> ParsecT Text PState m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m (Template a)
-> ParsecT Text PState m [Template a]
forall a. ParsecT Text PState m a -> ParsecT Text PState m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
    ((ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pLit ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pNewline ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pDirective ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pEscape) ParsecT Text PState m (Template a)
-> ParsecT Text PState m () -> ParsecT Text PState m (Template a)
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m () -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
pComment)

pEndline :: Monad m => Parser m String
pEndline :: forall (m :: * -> *). Monad m => Parser m FilePath
pEndline = ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath)
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a b. (a -> b) -> a -> b
$ do
  nls <- ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding
  mbNested <- nestedCol <$> P.getState
  inside <- insideDirective <$> P.getState
  case mbNested of
    Just Int
col -> do
      ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany (ParsecT Text PState m Char -> ParsecT Text PState m ())
-> ParsecT Text PState m Char -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition ParsecT Text PState m SourcePos
-> (SourcePos -> ParsecT Text PState m ())
-> ParsecT Text PState m ()
forall a b.
ParsecT Text PState m a
-> (a -> ParsecT Text PState m b) -> ParsecT Text PState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT Text PState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState m ())
-> (SourcePos -> Bool) -> SourcePos -> ParsecT Text PState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
col) (Int -> Bool) -> (SourcePos -> Int) -> SourcePos -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
P.sourceColumn
        Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
' ' ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\t'
      curcol <- SourcePos -> Int
P.sourceColumn (SourcePos -> Int)
-> ParsecT Text PState m SourcePos -> ParsecT Text PState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
      guard $ inside || curcol >= col
    Maybe Int
Nothing  ->  () -> ParsecT Text PState m ()
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  return nls

pBlankLine :: (TemplateTarget a, Monad m) => Parser m (Template a)
pBlankLine :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pBlankLine =
  ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m (Template a)
 -> ParsecT Text PState m (Template a))
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ Doc a -> Template a
forall a. Doc a -> Template a
Literal (Doc a -> Template a)
-> (FilePath -> Doc a) -> FilePath -> Template a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString (FilePath -> Template a)
-> ParsecT Text PState m FilePath
-> ParsecT Text PState m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding ParsecT Text PState m (Template a)
-> ParsecT Text PState m () -> ParsecT Text PState m (Template a)
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m () -> ParsecT Text PState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
pNewlineOrEof

pNewline :: (TemplateTarget a, Monad m) => Parser m (Template a)
pNewline :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pNewline = ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m (Template a)
 -> ParsecT Text PState m (Template a))
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ do
  nls <- Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pEndline
  sps <- P.many (P.char ' ' <|> P.char '\t')
  breakspaces <- breakingSpaces <$> P.getState
  pos <- P.getPosition
  P.updateState $ \PState
st -> PState
st{ firstNonspace = pos }
  return $ Literal $
    if breakspaces
       then DL.BreakingSpace
       else fromString $ nls <> sps

pLit :: (TemplateTarget a, Monad m) => Parser m (Template a)
pLit :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pLit = do
  cs <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ((Char -> Bool) -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'))
  when (all (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') cs) $ do
     pos <- P.getPosition
     when (P.sourceLine pos == 1) $
       P.updateState $ \PState
st -> PState
st{ firstNonspace = pos }
  breakspaces <- breakingSpaces <$> P.getState
  if breakspaces
     then return $ toBreakable cs
     else return $ Literal $ fromString cs

toBreakable :: TemplateTarget a => String -> Template a
toBreakable :: forall a. TemplateTarget a => FilePath -> Template a
toBreakable [] = Template a
forall a. Template a
Empty
toBreakable FilePath
xs =
  case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpacy FilePath
xs of
    ([], []) -> Template a
forall a. Template a
Empty
    ([], FilePath
zs) -> Doc a -> Template a
forall a. Doc a -> Template a
Literal Doc a
forall a. Doc a
DL.BreakingSpace Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<>
                   FilePath -> Template a
forall a. TemplateTarget a => FilePath -> Template a
toBreakable ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpacy FilePath
zs)
    (FilePath
ys, []) -> Doc a -> Template a
forall a. Doc a -> Template a
Literal (FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString FilePath
ys)
    (FilePath
ys, FilePath
zs) -> Doc a -> Template a
forall a. Doc a -> Template a
Literal (FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString FilePath
ys) Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Template a
forall a. TemplateTarget a => FilePath -> Template a
toBreakable FilePath
zs

isSpacy :: Char -> Bool
isSpacy :: Char -> Bool
isSpacy Char
' '  = Bool
True
isSpacy Char
'\n' = Bool
True
isSpacy Char
'\r' = Bool
True
isSpacy Char
'\t' = Bool
True
isSpacy Char
_    = Bool
False

backupSourcePos :: Monad m => Int -> Parser m ()
backupSourcePos :: forall (m :: * -> *). Monad m => Int -> Parser m ()
backupSourcePos Int
n = do
  pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  P.setPosition $ P.incSourceColumn pos (- n)

pEscape :: (TemplateTarget a, Monad m) => Parser m (Template a)
pEscape :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pEscape = Doc a -> Template a
forall a. Doc a -> Template a
Literal Doc a
"$" Template a
-> ParsecT Text PState m FilePath
-> ParsecT Text PState m (Template a)
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"$$" ParsecT Text PState m FilePath
-> ParsecT Text PState m () -> ParsecT Text PState m FilePath
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Int -> Parser m ()
backupSourcePos Int
1)

pDirective :: (TemplateTarget a, TemplateMonad m)
           => Parser m (Template a)
pDirective :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pDirective =
  Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pConditional Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pForLoop Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(Monoid a, Semigroup a, TemplateMonad m) =>
Parser m (Template a)
pReflowToggle Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pNested Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pInterpolate Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pBarePartial

pEnclosed :: Monad m => Parser m a -> Parser m a
pEnclosed :: forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed Parser m a
parser = Parser m a -> Parser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m a -> Parser m a) -> Parser m a -> Parser m a
forall a b. (a -> b) -> a -> b
$ do
  closer <- Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpen
  P.skipMany pSpaceOrTab
  result <- parser
  P.skipMany pSpaceOrTab
  closer
  return result

pParens :: Monad m => Parser m a -> Parser m a
pParens :: forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m a
parser = do
  Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'('
  result <- Parser m a
parser
  P.char ')'
  return result

pInside :: Monad m
        => Parser m (Template a)
        -> Parser m (Template a)
pInside :: forall (m :: * -> *) a.
Monad m =>
Parser m (Template a) -> Parser m (Template a)
pInside Parser m (Template a)
parser = do
  oldInside <- PState -> Bool
insideDirective (PState -> Bool)
-> ParsecT Text PState m PState -> ParsecT Text PState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
  P.updateState $ \PState
st -> PState
st{ insideDirective = True }
  res <- parser
  P.updateState $ \PState
st -> PState
st{ insideDirective = oldInside }
  return res

pConditional :: (TemplateTarget a, TemplateMonad m)
             => Parser m (Template a)
pConditional :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pConditional = do
  v <- Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ Parser m Variable -> Parser m Variable
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"if" ParsecT Text PState m FilePath
-> Parser m Variable -> Parser m Variable
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
  pInside $ do
    multiline <- P.option False (True <$ skipEndline)
    -- if newline after the "if", then a newline after "endif" will be swallowed
    ifContents <- pTemplate
    elseContents <- P.option mempty (pElse multiline <|> pElseIf)
    pEnclosed (P.string "endif")
    when multiline $ P.option () skipEndline
    return $ Conditional v ifContents elseContents

pElse :: (TemplateTarget a, TemplateMonad m)
      => Bool -> Parser m (Template a)
pElse :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Bool -> Parser m (Template a)
pElse Bool
multiline = do
  Parser m FilePath -> Parser m FilePath
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (FilePath -> Parser m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"else")
  Bool -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
multiline (ParsecT Text PState m () -> ParsecT Text PState m ())
-> ParsecT Text PState m () -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ () -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option () ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline
  Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate

pElseIf :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pElseIf :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pElseIf = do
  v <- Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ Parser m Variable -> Parser m Variable
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"elseif" ParsecT Text PState m FilePath
-> Parser m Variable -> Parser m Variable
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
  multiline <- P.option False (True <$ skipEndline)
  ifContents <- pTemplate
  elseContents <- P.option mempty (pElse multiline <|> pElseIf)
  return $ Conditional v ifContents elseContents

skipEndline :: Monad m => Parser m ()
skipEndline :: forall (m :: * -> *). Monad m => Parser m ()
skipEndline = do
  Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pEndline
  pos <- ParsecT Text PState m SourcePos -> ParsecT Text PState m SourcePos
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (ParsecT Text PState m SourcePos
 -> ParsecT Text PState m SourcePos)
-> ParsecT Text PState m SourcePos
-> ParsecT Text PState m SourcePos
forall a b. (a -> b) -> a -> b
$ do
           ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
' ' ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\t')
           ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  P.updateState $ \PState
st -> PState
st{ firstNonspace = pos }

pReflowToggle :: (Monoid a, Semigroup a, TemplateMonad m)
              => Parser m (Template a)
pReflowToggle :: forall a (m :: * -> *).
(Monoid a, Semigroup a, TemplateMonad m) =>
Parser m (Template a)
pReflowToggle = do
  Parser m Char -> Parser m Char
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Char -> Parser m Char) -> Parser m Char -> Parser m Char
forall a b. (a -> b) -> a -> b
$ Char -> Parser m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'~'
  (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.modifyState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ breakingSpaces = not (breakingSpaces st) }
  Template a -> ParsecT Text PState m (Template a)
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Template a
forall a. Monoid a => a
mempty

pNested :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pNested :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pNested = do
  col <- SourcePos -> Int
P.sourceColumn (SourcePos -> Int)
-> ParsecT Text PState m SourcePos -> ParsecT Text PState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  pEnclosed $ P.char '^'
  oldNested <- nestedCol <$> P.getState
  P.updateState $ \PState
st -> PState
st{ nestedCol = Just col }
  x <- pTemplate
  xs <- P.many $ P.try $ do
          y <- mconcat <$> P.many1 pBlankLine
          z <- pTemplate
          return (y <> z)
  let contents = Template a
x Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<> [Template a] -> Template a
forall a. Monoid a => [a] -> a
mconcat [Template a]
xs
  P.updateState $ \PState
st -> PState
st{ nestedCol = oldNested }
  return $ Nested contents

pForLoop :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pForLoop :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pForLoop = do
  v <- Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ Parser m Variable -> Parser m Variable
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"for" ParsecT Text PState m FilePath
-> Parser m Variable -> Parser m Variable
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
  -- if newline after the "for", then a newline after "endfor" will be swallowed
  pInside $ do
    multiline <- P.option False $ skipEndline >> return True
    contents <- pTemplate
    sep <- P.option mempty $
             do pEnclosed (P.string "sep")
                when multiline $ P.option () skipEndline
                pTemplate
    pEnclosed (P.string "endfor")
    when multiline $ P.option () skipEndline
    return $ Iterate v contents sep

pInterpolate :: (TemplateTarget a, TemplateMonad m)
             => Parser m (Template a)
pInterpolate :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pInterpolate = do
  pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  -- we don't used pEnclosed here, to get better error messages:
  (closer, var) <- P.try $ do
    cl <- pOpen
    P.skipMany pSpaceOrTab
    v <- pVar
    P.notFollowedBy (P.char '(') -- bare partial
    return (cl, v)
  res <- (P.char ':' *> (pPartialName >>= pPartial (Just var)))
      <|> Iterate var (Interpolate (Variable ["it"] [])) <$> pSep
      <|> return (Interpolate var)
  P.skipMany pSpaceOrTab
  closer
  handleNesting False pos res

pLineEnding :: Monad m => Parser m String
pLineEnding :: forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding = FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\n" ParsecT Text PState m FilePath
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\r\n") ParsecT Text PState m FilePath
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\r"

pNewlineOrEof :: Monad m => Parser m ()
pNewlineOrEof :: forall (m :: * -> *). Monad m => Parser m ()
pNewlineOrEof = () () -> ParsecT Text PState m FilePath -> ParsecT Text PState m ()
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding ParsecT Text PState m ()
-> ParsecT Text PState m () -> ParsecT Text PState m ()
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof

handleNesting :: TemplateMonad m
              => Bool -> P.SourcePos -> Template a -> Parser m (Template a)
handleNesting :: forall (m :: * -> *) a.
TemplateMonad m =>
Bool -> SourcePos -> Template a -> Parser m (Template a)
handleNesting Bool
eatEndline SourcePos
pos Template a
templ = do
  firstNonspacePos <- PState -> SourcePos
firstNonspace (PState -> SourcePos)
-> ParsecT Text PState m PState -> ParsecT Text PState m SourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
  let beginline = SourcePos
firstNonspacePos SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
pos
  endofline <- (True <$ P.lookAhead pNewlineOrEof) <|> pure False
  when (eatEndline && beginline) $ P.optional skipEndline
  mbNested <- nestedCol <$> P.getState
  let toNested t :: Template a
t@(Nested{}) = Template a
t
      toNested Template a
t = case SourcePos -> Int
P.sourceColumn SourcePos
pos of
                     Int
1 -> Template a
t
                     Int
n | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
mbNested -> Template a
t
                       | Bool
otherwise          -> Template a -> Template a
forall a. Template a -> Template a
Nested Template a
t
  return $ if beginline && endofline
              then toNested templ
              else templ

pBarePartial :: (TemplateTarget a, TemplateMonad m)
             => Parser m (Template a)
pBarePartial :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pBarePartial = do
  pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  (closer, fp) <- P.try $ do
    closer <- pOpen
    P.skipMany pSpaceOrTab
    fp <- pPartialName
    return (closer, fp)
  res <- pPartial Nothing fp
  P.skipMany pSpaceOrTab
  closer
  handleNesting True pos res

pPartialName :: TemplateMonad m
             => Parser m FilePath
pPartialName :: forall (m :: * -> *). TemplateMonad m => Parser m FilePath
pPartialName = ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath)
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a b. (a -> b) -> a -> b
$ do
  fp <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 (ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
P.oneOf [Char
'_',Char
'-',Char
'.',Char
'/',Char
'\\'])
  P.string "()"
  return fp

pPartial :: (TemplateTarget a, TemplateMonad m)
         => Maybe Variable -> FilePath -> Parser m (Template a)
pPartial :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Maybe Variable -> FilePath -> Parser m (Template a)
pPartial Maybe Variable
mbvar FilePath
fp = do
  oldst <- ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
  separ <- P.option mempty pSep
  tp <- templatePath <$> P.getState
  let fp' = case FilePath -> FilePath
takeExtension FilePath
fp of
               FilePath
"" -> FilePath -> FilePath -> FilePath
replaceBaseName FilePath
tp FilePath
fp
               FilePath
_  -> FilePath -> FilePath -> FilePath
replaceFileName FilePath
tp FilePath
fp
  partial <- lift $ removeFinalNewline <$> getPartial fp'
  nesting <- partialNesting <$> P.getState
  t <- if nesting > 50
          then return $ Literal "(loop)"
          else do
            oldInput <- P.getInput
            oldPos <- P.getPosition
            P.setPosition $ P.initialPos fp'
            P.setInput partial
            P.updateState $ \PState
st -> PState
st{ partialNesting = nesting + 1 }
            P.updateState $ \PState
st -> PState
st{ nestedCol = Nothing }
            res' <- pTemplate <* P.eof
            P.updateState $ \PState
st -> PState
st{ partialNesting = nesting }
            P.setInput oldInput
            P.setPosition oldPos
            return res'
  P.putState oldst
  fs <- many pPipe
  case mbvar of
    Just Variable
var -> Template a -> ParsecT Text PState m (Template a)
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> ParsecT Text PState m (Template a))
-> Template a -> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ Variable -> Template a -> Template a -> Template a
forall a. Variable -> Template a -> Template a -> Template a
Iterate Variable
var ([Pipe] -> Template a -> Template a
forall a. [Pipe] -> Template a -> Template a
Partial [Pipe]
fs Template a
t) Template a
separ
    Maybe Variable
Nothing  -> Template a -> ParsecT Text PState m (Template a)
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> ParsecT Text PState m (Template a))
-> Template a -> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ [Pipe] -> Template a -> Template a
forall a. [Pipe] -> Template a -> Template a
Partial [Pipe]
fs Template a
t

removeFinalNewline :: Text -> Text
removeFinalNewline :: Text -> Text
removeFinalNewline Text
t =
  case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
    Just (Text
t', Char
'\n') -> Text
t'
    Maybe (Text, Char)
_ -> Text
t

pSep :: (TemplateTarget a, Monad m) => Parser m (Template a)
pSep :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pSep = do
    Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'['
    xs <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ((Char -> Bool) -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']'))
    P.char ']'
    return $ Literal (fromString xs)

pSpaceOrTab :: Monad m => Parser m Char
pSpaceOrTab :: forall (m :: * -> *). Monad m => Parser m Char
pSpaceOrTab = (Char -> Bool) -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

pComment :: Monad m => Parser m ()
pComment :: forall (m :: * -> *). Monad m => Parser m ()
pComment = do
  pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  P.try (P.string "$--")
  P.skipMany (P.satisfy (/='\n'))
  -- If the comment begins in the first column, the line ending
  -- will be consumed; otherwise not.
  when (P.sourceColumn pos == 1) $ () <$ pNewlineOrEof

pOpenDollar :: Monad m => Parser m (Parser m ())
pOpenDollar :: forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenDollar =
  ParsecT Text PState m ()
forall {u}. ParsecT Text u m ()
pCloseDollar ParsecT Text PState m ()
-> ParsecT Text PState m Char
-> ParsecT Text PState m (ParsecT Text PState m ())
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m Char -> ParsecT Text PState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$' ParsecT Text PState m Char
-> ParsecT Text PState m () -> ParsecT Text PState m Char
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                   ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$' ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'{'))
  where
   pCloseDollar :: ParsecT Text u m ()
pCloseDollar = () () -> ParsecT Text u m Char -> ParsecT Text u m ()
forall a b. a -> ParsecT Text u m b -> ParsecT Text u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$'

pOpenBraces :: Monad m => Parser m (Parser m ())
pOpenBraces :: forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenBraces =
  ParsecT Text PState m ()
forall {u}. ParsecT Text u m ()
pCloseBraces ParsecT Text PState m ()
-> ParsecT Text PState m FilePath
-> ParsecT Text PState m (ParsecT Text PState m ())
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"${" ParsecT Text PState m FilePath
-> ParsecT Text PState m () -> ParsecT Text PState m FilePath
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'}'))
  where
   pCloseBraces :: ParsecT Text u m ()
pCloseBraces = () () -> ParsecT Text u m Char -> ParsecT Text u m ()
forall a b. a -> ParsecT Text u m b -> ParsecT Text u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text u m Char -> ParsecT Text u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'}')

pOpen :: Monad m => Parser m (Parser m ())
pOpen :: forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpen = Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenDollar Parser m (Parser m ())
-> Parser m (Parser m ()) -> Parser m (Parser m ())
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenBraces

pVar :: Monad m => Parser m Variable
pVar :: forall (m :: * -> *). Monad m => Parser m Variable
pVar = do
  first <- Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIdentPart Parser m Text -> Parser m Text -> Parser m Text
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIt
  rest <- P.many (P.char '.' *> pIdentPart)
  pipes <- P.many pPipe
  return $ Variable (first:rest) pipes

pPipe :: Monad m => Parser m Pipe
pPipe :: forall (m :: * -> *). Monad m => Parser m Pipe
pPipe = do
  Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'/'
  pipeName <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter
  P.notFollowedBy P.letter
  case pipeName of
    FilePath
"uppercase"  -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToUppercase
    FilePath
"lowercase"  -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLowercase
    FilePath
"pairs"      -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToPairs
    FilePath
"length"     -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLength
    FilePath
"alpha"      -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToAlpha
    FilePath
"roman"      -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToRoman
    FilePath
"reverse"    -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Reverse
    FilePath
"first"      -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
FirstItem
    FilePath
"rest"       -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Rest
    FilePath
"last"       -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
LastItem
    FilePath
"allbutlast" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
AllButLast
    FilePath
"chomp"      -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Chomp
    FilePath
"nowrap"     -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
NoWrap
    FilePath
"left"       -> Alignment -> Int -> Border -> Pipe
Block Alignment
LeftAligned (Int -> Border -> Pipe)
-> ParsecT Text PState m Int
-> ParsecT Text PState m (Border -> Pipe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m Int
forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth ParsecT Text PState m (Border -> Pipe)
-> ParsecT Text PState m Border -> ParsecT Text PState m Pipe
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState m Border
forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders
    FilePath
"right"      -> Alignment -> Int -> Border -> Pipe
Block Alignment
RightAligned (Int -> Border -> Pipe)
-> ParsecT Text PState m Int
-> ParsecT Text PState m (Border -> Pipe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m Int
forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth ParsecT Text PState m (Border -> Pipe)
-> ParsecT Text PState m Border -> ParsecT Text PState m Pipe
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState m Border
forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders
    FilePath
"center"     -> Alignment -> Int -> Border -> Pipe
Block Alignment
Centered (Int -> Border -> Pipe)
-> ParsecT Text PState m Int
-> ParsecT Text PState m (Border -> Pipe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m Int
forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth ParsecT Text PState m (Border -> Pipe)
-> ParsecT Text PState m Border -> ParsecT Text PState m Pipe
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState m Border
forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders
    FilePath
_            -> FilePath -> ParsecT Text PState m Pipe
forall a. FilePath -> ParsecT Text PState m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT Text PState m Pipe)
-> FilePath -> ParsecT Text PState m Pipe
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown pipe " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pipeName

pBlockWidth :: Monad m => Parser m Int
pBlockWidth :: forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth = ParsecT Text PState m Int -> ParsecT Text PState m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (do
  _ <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space
  ds <- P.many1 P.digit
  case T.decimal (T.pack ds) of
        Right (Int
n,Text
"") -> Int -> ParsecT Text PState m Int
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
        Either FilePath (Int, Text)
_            -> FilePath -> ParsecT Text PState m Int
forall a. FilePath -> ParsecT Text PState m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expected integer parameter for pipe") ParsecT Text PState m Int -> FilePath -> ParsecT Text PState m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
P.<?>
          FilePath
"integer parameter for pipe"

pBlockBorders :: Monad m => Parser m Border
pBlockBorders :: forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders = do
  ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space
  let pBorder :: ParsecT Text u m Text
pBorder = do
        Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"'
        cs <- ParsecT Text u m Char -> ParsecT Text u m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (ParsecT Text u m Char -> ParsecT Text u m FilePath)
-> ParsecT Text u m Char -> ParsecT Text u m FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
P.noneOf [Char
'"',Char
'\\']) ParsecT Text u m Char
-> ParsecT Text u m Char -> ParsecT Text u m Char
forall a.
ParsecT Text u m a -> ParsecT Text u m a -> ParsecT Text u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\\' ParsecT Text u m Char
-> ParsecT Text u m Char -> ParsecT Text u m Char
forall a b.
ParsecT Text u m a -> ParsecT Text u m b -> ParsecT Text u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar)
        P.char '"'
        P.skipMany P.space
        return $ T.pack cs
  Text -> Text -> Border
Border (Text -> Text -> Border)
-> ParsecT Text PState m Text
-> ParsecT Text PState m (Text -> Border)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Text PState m Text -> ParsecT Text PState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Text
forall a. Monoid a => a
mempty ParsecT Text PState m Text
forall {u}. ParsecT Text u m Text
pBorder ParsecT Text PState m (Text -> Border)
-> ParsecT Text PState m Text -> ParsecT Text PState m Border
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ParsecT Text PState m Text -> ParsecT Text PState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Text
forall a. Monoid a => a
mempty ParsecT Text PState m Text
forall {u}. ParsecT Text u m Text
pBorder

pIt :: Monad m => Parser m Text
pIt :: forall (m :: * -> *). Monad m => Parser m Text
pIt = FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (FilePath -> Text)
-> ParsecT Text PState m FilePath -> ParsecT Text PState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"it")

pIdentPart :: Monad m => Parser m Text
pIdentPart :: forall (m :: * -> *). Monad m => Parser m Text
pIdentPart = ParsecT Text PState m Text -> ParsecT Text PState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m Text -> ParsecT Text PState m Text)
-> ParsecT Text PState m Text -> ParsecT Text PState m Text
forall a b. (a -> b) -> a -> b
$ do
  first <- ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter
  rest <- P.many (P.satisfy (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'))
  let part = Char
first Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
rest
  guard $ part `notElem` reservedWords
  return $ fromString part

reservedWords :: [String]
reservedWords :: [FilePath]
reservedWords = [FilePath
"if",FilePath
"else",FilePath
"endif",FilePath
"elseif",FilePath
"for",FilePath
"endfor",FilePath
"sep",FilePath
"it"]