{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
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 Data.List (isPrefixOf)
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
compileTemplate :: (TemplateMonad m, TemplateTarget a)
=> FilePath -> Text -> m (Either String (Template a))
compileTemplate :: FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate templPath :: FilePath
templPath template :: 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)
$WPState :: FilePath -> Int -> Bool -> SourcePos -> Maybe Int -> Bool -> PState
PState{ templatePath :: FilePath
templatePath = FilePath
templPath
, partialNesting :: Int
partialNesting = 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 e :: 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 x :: 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 col :: 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 ' ' 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 '\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
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 ' ' 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 '\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
$ \st :: 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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '$' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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
== 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
$ \st :: 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 xs :: 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
([], zs :: 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)
(ys :: 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)
(ys :: FilePath
ys, zs :: 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 ' ' = Bool
True
isSpacy '\n' = Bool
True
isSpacy '\r' = Bool
True
isSpacy '\t' = Bool
True
isSpacy _ = Bool
False
backupSourcePos :: Monad m => Int -> Parser m ()
backupSourcePos :: Int -> Parser m ()
backupSourcePos n :: 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 "$" 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 "$$" 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 1)
pDirective :: (TemplateTarget a, TemplateMonad m)
=> Parser m (Template a)
pDirective :: Parser m (Template a)
pDirective = do
Template a
res <- 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
Template a -> Parser m (Template a)
forall (m :: * -> *) a. Monad m => a -> m a
return Template a
res
pEnclosed :: Monad m => Parser m a -> Parser m a
pEnclosed :: Parser m a -> Parser m a
pEnclosed parser :: 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 :: 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 '('
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 ')'
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 :: 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
$ \st :: 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
$ \st :: 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 "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)
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 "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 multiline :: 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 "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 "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 ' ' 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 '\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
$ \st :: 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 '~'
(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
$ \st :: 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 '^'
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
$ \st :: 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
$ \st :: 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 -> Template a) -> Template a -> Template a
forall a b. (a -> b) -> a -> b
$ 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 "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
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 <- Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v (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 (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 "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
Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v (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 (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 "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
changeToIt :: (Semigroup a) => Variable -> Template a -> Template a
changeToIt :: Variable -> Template a -> Template a
changeToIt v :: Variable
v = Template a -> Template a
forall a. Semigroup a => Template a -> Template a
go
where
go :: Template a -> Template a
go (Interpolate w :: Variable
w) = Variable -> Template a
forall a. Variable -> Template a
Interpolate (Variable -> Variable -> Variable
reletter Variable
v Variable
w)
go (Conditional w :: Variable
w t1 :: Template a
t1 t2 :: Template a
t2) = Variable -> Template a -> Template a -> Template a
forall a. Variable -> Template a -> Template a -> Template a
Conditional (Variable -> Variable -> Variable
reletter Variable
v Variable
w)
(Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v Template a
t1) (Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v Template a
t2)
go (Iterate w :: Variable
w t1 :: Template a
t1 t2 :: Template a
t2) = Variable -> Template a -> Template a -> Template a
forall a. Variable -> Template a -> Template a -> Template a
Iterate (Variable -> Variable -> Variable
reletter Variable
v Variable
w)
(Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v Template a
t1) (Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v Template a
t2)
go (Concat t1 :: Template a
t1 t2 :: Template a
t2) = Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v Template a
t1 Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<> Variable -> Template a -> Template a
forall a. Semigroup a => Variable -> Template a -> Template a
changeToIt Variable
v Template a
t2
go (Partial fs :: [Pipe]
fs t :: Template a
t) = [Pipe] -> Template a -> Template a
forall a. [Pipe] -> Template a -> Template a
Partial [Pipe]
fs Template a
t
go (Nested t :: Template a
t) = Template a -> Template a
forall a. Template a -> Template a
Nested (Template a -> Template a
go Template a
t)
go x :: Template a
x = Template a
x
reletter :: Variable -> Variable -> Variable
reletter (Variable vs :: [Text]
vs _fs :: [Pipe]
_fs) (Variable ws :: [Text]
ws gs :: [Pipe]
gs) =
if [Text]
vs [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
ws
then [Text] -> [Pipe] -> Variable
Variable ("it" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
vs) [Text]
ws) [Pipe]
gs
else [Text] -> [Pipe] -> Variable
Variable [Text]
ws [Pipe]
gs
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
(closer :: Parser m ()
closer, var :: 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 '(')
(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 ':' 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 ["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 "\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 "\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 "\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 eatEndline :: Bool
eatEndline pos :: SourcePos
pos templ :: 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 t :: Template a
t = case SourcePos -> Int
P.sourceColumn SourcePos
pos of
1 -> Template a
t
n :: 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
(closer :: Parser m ()
closer, fp :: 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 ['_','-','.','/','\\'])
FilePath -> Parser m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string "()"
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 mbvar :: Maybe Variable
mbvar fp :: 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
replaceBaseName FilePath
tp FilePath
fp
_ -> 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
> 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 "(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
$ \st :: PState
st -> PState
st{ partialNesting :: Int
partialNesting = Int
nesting Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
$ \st :: 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
$ \st :: 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 var :: 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
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 t :: Text
t =
case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
Just (t' :: Text
t', '\n') -> Text
t'
_ -> 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 '['
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 -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t')
pComment :: Monad m => Parser m ()
= 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 "$--")
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
/='\n'))
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
== 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 '$' 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 '$' 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 '{'))
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 '$'
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 "${" 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 '}'))
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 '}')
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 '.' 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 '/'
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
"uppercase" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToUppercase
"lowercase" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLowercase
"pairs" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToPairs
"length" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLength
"alpha" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToAlpha
"roman" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToRoman
"reverse" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Reverse
"chomp" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Chomp
"nowrap" -> Pipe -> Parser m Pipe
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
NoWrap
"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
"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
"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 -> 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
$ "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 (n :: Int
n,"") -> Int -> Parser m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
_ -> FilePath -> Parser m Int
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "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.<?>
"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 '"'
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 ['"','\\']) 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 '\\' 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 '"'
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 "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 (\c :: Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'))
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 = ["if","else","endif","elseif","for","endfor","sep","it"]