{-# 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 :: FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
templPath Text
template = do
  Either ParseError (Template a)
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 (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 :: FilePath -> Int -> Bool -> SourcePos -> Maybe Int -> Bool -> PState
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 Either ParseError (Template a)
res of
       Left ParseError
e   -> Either FilePath (Template a) -> m (Either FilePath (Template 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 (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 :: 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] -> Parser m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m (Template a) -> ParsecT Text PState m [Template a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
    ((Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pLit Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pNewline Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template 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)
pDirective Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pEscape) Parser m (Template a)
-> ParsecT Text PState m () -> Parser m (Template 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 :: Parser m FilePath
pEndline = Parser m FilePath -> Parser m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m FilePath -> Parser m FilePath)
-> Parser m FilePath -> Parser m FilePath
forall a b. (a -> b) -> a -> b
$ do
  FilePath
nls <- Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding
  Maybe Int
mbNested <- PState -> Maybe Int
nestedCol (PState -> Maybe Int)
-> ParsecT Text PState m PState
-> ParsecT Text PState m (Maybe Int)
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
  Bool
inside <- 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
  case Maybe Int
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 (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 (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'
      Int
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
      Bool -> ParsecT Text PState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState m ())
-> Bool -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ Bool
inside Bool -> Bool -> Bool
|| Int
curcol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
col
    Maybe Int
Nothing  ->  () -> ParsecT Text PState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  FilePath -> Parser m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
nls

pBlankLine :: (TemplateTarget a, Monad m) => Parser m (Template a)
pBlankLine :: Parser m (Template a)
pBlankLine =
  Parser m (Template a) -> Parser m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m (Template a) -> Parser m (Template a))
-> Parser m (Template a) -> Parser 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 -> Parser 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 Parser m (Template a)
-> ParsecT Text PState m () -> Parser m (Template 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 :: Parser m (Template a)
pNewline = Parser m (Template a) -> Parser m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m (Template a) -> Parser m (Template a))
-> Parser m (Template a) -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ do
  FilePath
nls <- Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pEndline
  FilePath
sps <- ParsecT Text PState m Char -> Parser m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (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 (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')
  Bool
breakspaces <- PState -> Bool
breakingSpaces (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
  SourcePos
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ firstNonspace :: SourcePos
firstNonspace = SourcePos
pos }
  Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser 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) -> Doc a -> Template a
forall a b. (a -> b) -> a -> b
$
    if Bool
breakspaces
       then Doc a
forall a. Doc a
DL.BreakingSpace
       else FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString (FilePath -> Doc a) -> FilePath -> Doc a
forall a b. (a -> b) -> a -> b
$ FilePath
nls FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
sps

pLit :: (TemplateTarget a, Monad m) => Parser m (Template a)
pLit :: Parser m (Template a)
pLit = do
  FilePath
cs <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
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'))
  Bool -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
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') FilePath
cs) (ParsecT Text PState m () -> ParsecT Text PState m ())
-> ParsecT Text PState m () -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ do
     SourcePos
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
     Bool -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SourcePos -> Int
P.sourceLine SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (ParsecT Text PState m () -> ParsecT Text PState m ())
-> ParsecT Text PState m () -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$
       (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ firstNonspace :: SourcePos
firstNonspace = SourcePos
pos }
  Bool
breakspaces <- PState -> Bool
breakingSpaces (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
  if Bool
breakspaces
     then Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Template a
forall a. TemplateTarget a => FilePath -> Template a
toBreakable FilePath
cs
     else Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser 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) -> Doc a -> Template a
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString FilePath
cs

toBreakable :: TemplateTarget a => String -> Template a
toBreakable :: 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 :: Int -> Parser m ()
backupSourcePos Int
n = do
  SourcePos
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  SourcePos -> Parser m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
P.setPosition (SourcePos -> Parser m ()) -> SourcePos -> Parser m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> Int -> SourcePos
P.incSourceColumn SourcePos
pos (- Int
n)

pEscape :: (TemplateTarget a, Monad m) => Parser m (Template a)
pEscape :: 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 -> Parser m (Template 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 (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 :: 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 (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 (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 (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 (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 (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 :: 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
  Parser m ()
closer <- Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpen
  ParsecT Text PState m Char -> Parser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m Char
forall (m :: * -> *). Monad m => Parser m Char
pSpaceOrTab
  a
result <- Parser m a
parser
  ParsecT Text PState m Char -> Parser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m Char
forall (m :: * -> *). Monad m => Parser m Char
pSpaceOrTab
  Parser m ()
closer
  a -> Parser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

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

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

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

pElse :: (TemplateTarget a, TemplateMonad m)
      => Bool -> Parser m (Template a)
pElse :: 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 :: Parser m (Template a)
pElseIf = do
  Variable
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 (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
  Bool
multiline <- Bool -> ParsecT Text PState m Bool -> ParsecT Text PState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Bool
False (Bool
True Bool -> ParsecT Text PState m () -> ParsecT Text PState m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline)
  Template a
ifContents <- Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate
  Template a
elseContents <- Template a -> Parser m (Template a) -> Parser m (Template a)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Template a
forall a. Monoid a => a
mempty (Bool -> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Bool -> Parser m (Template a)
pElse Bool
multiline Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template 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)
pElseIf)
  Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser 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
Conditional Variable
v Template a
ifContents Template a
elseContents

skipEndline :: Monad m => Parser m ()
skipEndline :: Parser m ()
skipEndline = do
  Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pEndline
  SourcePos
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 -> Parser 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 (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
  (PState -> PState) -> Parser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> Parser m ())
-> (PState -> PState) -> Parser m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ firstNonspace :: SourcePos
firstNonspace = SourcePos
pos }

pReflowToggle :: (Monoid a, Semigroup a, TemplateMonad m)
              => Parser m (Template a)
pReflowToggle :: 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 :: Bool
breakingSpaces = Bool -> Bool
not (PState -> Bool
breakingSpaces PState
st) }
  Template a -> Parser m (Template 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 :: Parser m (Template a)
pNested = do
  Int
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
  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
'^'
  Maybe Int
oldNested <- PState -> Maybe Int
nestedCol (PState -> Maybe Int)
-> ParsecT Text PState m PState
-> ParsecT Text PState m (Maybe Int)
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
  (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ nestedCol :: Maybe Int
nestedCol = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col }
  Template a
x <- Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate
  [Template a]
xs <- Parser 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.many (Parser m (Template a) -> ParsecT Text PState m [Template a])
-> Parser m (Template a) -> ParsecT Text PState m [Template a]
forall a b. (a -> b) -> a -> b
$ Parser m (Template a) -> Parser m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m (Template a) -> Parser m (Template a))
-> Parser m (Template a) -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ do
          Template a
y <- [Template a] -> Template a
forall a. Monoid a => [a] -> a
mconcat ([Template a] -> Template a)
-> ParsecT Text PState m [Template a] -> Parser m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m (Template a) -> ParsecT Text PState m [Template a]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pBlankLine
          Template a
z <- Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate
          Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a
y Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<> Template a
z)
  let contents :: Template a
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
  (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ nestedCol :: Maybe Int
nestedCol = Maybe Int
oldNested }
  Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ Template a -> Template a
forall a. Template a -> Template a
Nested Template a
contents

pForLoop :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pForLoop :: Parser m (Template a)
pForLoop = do
  Variable
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 (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
  Parser m (Template a) -> Parser m (Template a)
forall (m :: * -> *) a.
Monad m =>
Parser m (Template a) -> Parser m (Template a)
pInside (Parser m (Template a) -> Parser m (Template a))
-> Parser m (Template a) -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ do
    Bool
multiline <- Bool -> ParsecT Text PState m Bool -> ParsecT Text PState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Bool
False (ParsecT Text PState m Bool -> ParsecT Text PState m Bool)
-> ParsecT Text PState m Bool -> ParsecT Text PState m Bool
forall a b. (a -> b) -> a -> b
$ Parser m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline Parser m ()
-> ParsecT Text PState m Bool -> ParsecT Text PState m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text PState m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Template a
contents <- Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate
    Template a
sep <- Template a -> Parser m (Template a) -> Parser m (Template a)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Template a
forall a. Monoid a => a
mempty (Parser m (Template a) -> Parser m (Template a))
-> Parser m (Template a) -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$
             do ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"sep")
                Bool -> Parser m () -> Parser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
multiline (Parser m () -> Parser m ()) -> Parser m () -> Parser m ()
forall a b. (a -> b) -> a -> b
$ () -> Parser m () -> Parser m ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option () Parser m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline
                Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate
    ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"endfor")
    Bool -> Parser m () -> Parser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
multiline (Parser m () -> Parser m ()) -> Parser m () -> Parser m ()
forall a b. (a -> b) -> a -> b
$ () -> Parser m () -> Parser m ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option () Parser m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline
    Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser 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
v Template a
contents Template a
sep

pInterpolate :: (TemplateTarget a, TemplateMonad m)
             => Parser m (Template a)
pInterpolate :: Parser m (Template a)
pInterpolate = do
  SourcePos
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:
  (Parser m ()
closer, Variable
var) <- ParsecT Text PState m (Parser m (), Variable)
-> ParsecT Text PState m (Parser m (), Variable)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m (Parser m (), Variable)
 -> ParsecT Text PState m (Parser m (), Variable))
-> ParsecT Text PState m (Parser m (), Variable)
-> ParsecT Text PState m (Parser m (), Variable)
forall a b. (a -> b) -> a -> b
$ do
    Parser m ()
cl <- Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpen
    ParsecT Text PState m Char -> Parser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m Char
forall (m :: * -> *). Monad m => Parser m Char
pSpaceOrTab
    Variable
v <- Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
    ParsecT Text PState m Char -> Parser 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
'(') -- bare partial
    (Parser m (), Variable)
-> ParsecT Text PState m (Parser m (), Variable)
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser m ()
cl, Variable
v)
  Template a
res <- (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
-> Parser m (Template a) -> Parser m (Template a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser m FilePath
forall (m :: * -> *). TemplateMonad m => Parser m FilePath
pPartialName Parser m FilePath
-> (FilePath -> Parser m (Template a)) -> Parser m (Template a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Variable -> FilePath -> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Maybe Variable -> FilePath -> Parser m (Template a)
pPartial (Variable -> Maybe Variable
forall a. a -> Maybe a
Just Variable
var)))
      Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Variable -> Template a -> Template a -> Template a
forall a. Variable -> Template a -> Template a -> Template a
Iterate Variable
var (Variable -> Template a
forall a. Variable -> Template a
Interpolate ([Text] -> [Pipe] -> Variable
Variable [Text
"it"] [])) (Template a -> Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pSep
      Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Variable -> Template a
forall a. Variable -> Template a
Interpolate Variable
var)
  ParsecT Text PState m Char -> Parser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m Char
forall (m :: * -> *). Monad m => Parser m Char
pSpaceOrTab
  Parser m ()
closer
  Bool -> SourcePos -> Template a -> Parser m (Template a)
forall (m :: * -> *) a.
TemplateMonad m =>
Bool -> SourcePos -> Template a -> Parser m (Template a)
handleNesting Bool
False SourcePos
pos Template a
res

pLineEnding :: Monad m => Parser m String
pLineEnding :: Parser m FilePath
pLineEnding = FilePath -> Parser m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\n" Parser m FilePath -> Parser m FilePath -> Parser m FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m FilePath -> Parser m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> Parser m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\r\n") Parser m FilePath -> Parser m FilePath -> Parser m FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Parser 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 :: Parser m ()
pNewlineOrEof = () () -> ParsecT Text PState m FilePath -> Parser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding Parser m () -> Parser m () -> Parser m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser 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 :: Bool -> SourcePos -> Template a -> Parser m (Template a)
handleNesting Bool
eatEndline SourcePos
pos Template a
templ = do
  SourcePos
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 :: Bool
beginline = SourcePos
firstNonspacePos SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
pos
  Bool
endofline <- (Bool
True Bool -> ParsecT Text PState m () -> ParsecT Text PState m Bool
forall (f :: * -> *) a b. Functor 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) ParsecT Text PState m Bool
-> ParsecT Text PState m Bool -> ParsecT Text PState m Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ParsecT Text PState m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Bool -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
eatEndline Bool -> Bool -> Bool
&& Bool
beginline) (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 u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.optional ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline
  Maybe Int
mbNested <- PState -> Maybe Int
nestedCol (PState -> Maybe Int)
-> ParsecT Text PState m PState
-> ParsecT Text PState m (Maybe Int)
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 toNested :: Template a -> Template a
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
  Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ if Bool
beginline Bool -> Bool -> Bool
&& Bool
endofline
              then Template a -> Template a
forall a. Template a -> Template a
toNested Template a
templ
              else Template a
templ

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

pPartialName :: TemplateMonad m
             => Parser m FilePath
pPartialName :: Parser m FilePath
pPartialName = Parser m FilePath -> Parser m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m FilePath -> Parser m FilePath)
-> Parser m FilePath -> Parser m FilePath
forall a b. (a -> b) -> a -> b
$ do
  FilePath
fp <- ParsecT Text PState m Char -> Parser m FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
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 (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
'\\'])
  FilePath -> Parser m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"()"
  FilePath -> Parser m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp

pPartial :: (TemplateTarget a, TemplateMonad m)
         => Maybe Variable -> FilePath -> Parser m (Template a)
pPartial :: Maybe Variable -> FilePath -> Parser m (Template a)
pPartial Maybe Variable
mbvar FilePath
fp = do
  PState
oldst <- ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
  Template a
separ <- Template a -> Parser m (Template a) -> Parser m (Template a)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Template a
forall a. Monoid a => a
mempty Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pSep
  FilePath
tp <- PState -> FilePath
templatePath (PState -> FilePath)
-> ParsecT Text PState m PState -> ParsecT Text PState m FilePath
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 fp' :: FilePath
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
  Text
partial <- m Text -> ParsecT Text PState m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Text -> ParsecT Text PState m Text)
-> m Text -> ParsecT Text PState m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeFinalNewline (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m Text
forall (m :: * -> *). TemplateMonad m => FilePath -> m Text
getPartial FilePath
fp'
  Int
nesting <- PState -> Int
partialNesting (PState -> Int)
-> ParsecT Text PState m PState -> ParsecT Text PState m Int
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
  Template a
t <- if Int
nesting Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
50
          then Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ Doc a -> Template a
forall a. Doc a -> Template a
Literal Doc a
"(loop)"
          else do
            Text
oldInput <- ParsecT Text PState m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
P.getInput
            SourcePos
oldPos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
            SourcePos -> ParsecT Text PState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
P.setPosition (SourcePos -> ParsecT Text PState m ())
-> SourcePos -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> SourcePos
P.initialPos FilePath
fp'
            Text -> ParsecT Text PState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
P.setInput Text
partial
            (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ partialNesting :: Int
partialNesting = Int
nesting Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
            (PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ nestedCol :: Maybe Int
nestedCol = Maybe Int
forall a. Maybe a
Nothing }
            Template a
res' <- Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate Parser m (Template a)
-> ParsecT Text PState m () -> Parser m (Template 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 -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.updateState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ partialNesting :: Int
partialNesting = Int
nesting }
            Text -> ParsecT Text PState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
P.setInput Text
oldInput
            SourcePos -> ParsecT Text PState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
P.setPosition SourcePos
oldPos
            Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return Template a
res'
  PState -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
P.putState PState
oldst
  [Pipe]
fs <- ParsecT Text PState m Pipe -> ParsecT Text PState m [Pipe]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Text PState m Pipe
forall (m :: * -> *). Monad m => Parser m Pipe
pPipe
  case Maybe Variable
mbvar of
    Just Variable
var -> Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser 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 -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser 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 :: 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
'['
    FilePath
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
']'))
    Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
']'
    Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> Parser m (Template a))
-> Template a -> Parser m (Template a)
forall a b. (a -> b) -> a -> b
$ Doc a -> Template a
forall a. Doc a -> Template a
Literal (FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString FilePath
xs)

pSpaceOrTab :: Monad m => Parser m Char
pSpaceOrTab :: Parser m Char
pSpaceOrTab = (Char -> Bool) -> Parser 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 :: Parser m ()
pComment = do
  SourcePos
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
  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 Char -> Parser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ((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
'\n'))
  -- If the comment begins in the first column, the line ending
  -- will be consumed; otherwise not.
  Bool -> Parser m () -> Parser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SourcePos -> Int
P.sourceColumn SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Parser m () -> Parser m ()) -> Parser m () -> Parser m ()
forall a b. (a -> b) -> a -> b
$ () () -> Parser m () -> Parser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser m ()
forall (m :: * -> *). Monad m => Parser m ()
pNewlineOrEof

pOpenDollar :: Monad m => Parser m (Parser m ())
pOpenDollar :: Parser m (Parser m ())
pOpenDollar =
  Parser m ()
forall u. ParsecT Text u m ()
pCloseDollar Parser m () -> ParsecT Text PState m Char -> Parser m (Parser m ())
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
-> Parser m () -> ParsecT Text PState m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                   ParsecT Text PState m Char -> Parser 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 (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 (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 :: Parser m (Parser m ())
pOpenBraces =
  Parser m ()
forall u. ParsecT Text u m ()
pCloseBraces Parser m ()
-> ParsecT Text PState m FilePath -> Parser m (Parser m ())
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
-> Parser m () -> ParsecT Text PState m FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m Char -> Parser 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 (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 :: 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 (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 :: Parser m Variable
pVar = do
  Text
first <- Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIdentPart Parser m Text -> Parser m Text -> Parser m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIt
  [Text]
rest <- Parser m Text -> ParsecT Text PState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (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 -> Parser m Text -> Parser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIdentPart)
  [Pipe]
pipes <- ParsecT Text PState m Pipe -> ParsecT Text PState m [Pipe]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT Text PState m Pipe
forall (m :: * -> *). Monad m => Parser m Pipe
pPipe
  Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => a -> m a
return (Variable -> Parser m Variable) -> Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ [Text] -> [Pipe] -> Variable
Variable (Text
firstText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
rest) [Pipe]
pipes

pPipe :: Monad m => Parser m Pipe
pPipe :: 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
'/'
  FilePath
pipeName <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
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
  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 ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter
  case FilePath
pipeName of
    FilePath
"uppercase"  -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToUppercase
    FilePath
"lowercase"  -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLowercase
    FilePath
"pairs"      -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToPairs
    FilePath
"length"     -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLength
    FilePath
"alpha"      -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToAlpha
    FilePath
"roman"      -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToRoman
    FilePath
"reverse"    -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Reverse
    FilePath
"first"      -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
FirstItem
    FilePath
"rest"       -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Rest
    FilePath
"last"       -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
LastItem
    FilePath
"allbutlast" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
AllButLast
    FilePath
"chomp"      -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Chomp
    FilePath
"nowrap"     -> Pipe -> Parser m Pipe
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 -> Parser m Pipe
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 -> Parser m Pipe
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 -> Parser m Pipe
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 -> Parser m Pipe
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser m Pipe) -> FilePath -> Parser 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 :: Parser m Int
pBlockWidth = Parser m Int -> Parser m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (do
  FilePath
_ <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
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
  FilePath
ds <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
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.digit
  case Reader Int
forall a. Integral a => Reader a
T.decimal (FilePath -> Text
T.pack FilePath
ds) of
        Right (Int
n,Text
"") -> Int -> Parser m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
        Either FilePath (Int, Text)
_            -> FilePath -> Parser m Int
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expected integer parameter for pipe") Parser m Int -> FilePath -> Parser 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 :: 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
'"'
        FilePath
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 (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 (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)
        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 ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space
        Text -> ParsecT Text u m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Text u m Text) -> Text -> ParsecT Text u m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
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 -> Parser m Border
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 :: Parser m Text
pIt = FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (FilePath -> Text)
-> ParsecT Text PState m FilePath -> Parser 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 :: Parser m Text
pIdentPart = Parser m Text -> Parser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Text -> Parser m Text) -> Parser m Text -> Parser m Text
forall a b. (a -> b) -> a -> b
$ do
  Char
first <- ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter
  FilePath
rest <- 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
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 :: FilePath
part = Char
first Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
rest
  Bool -> ParsecT Text PState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState m ())
-> Bool -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ FilePath
part FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
reservedWords
  Text -> Parser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser m Text) -> Text -> Parser m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a. IsString a => FilePath -> a
fromString FilePath
part

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