{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
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
compileTemplate :: (TemplateMonad m, TemplateTarget a)
=> FilePath -> Text -> m (Either String (Template a))
compileTemplate :: forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
templPath Text
template = do
res <- ParsecT Text PState m (Template a)
-> PState -> FilePath -> Text -> m (Either ParseError (Template a))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
P.runParserT (ParsecT Text PState m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate ParsecT Text PState m (Template a)
-> ParsecT Text PState m () -> ParsecT Text PState m (Template a)
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof)
PState{ templatePath :: FilePath
templatePath = FilePath
templPath
, partialNesting :: Int
partialNesting = Int
1
, breakingSpaces :: Bool
breakingSpaces = Bool
False
, firstNonspace :: SourcePos
firstNonspace = FilePath -> SourcePos
P.initialPos FilePath
templPath
, nestedCol :: Maybe Int
nestedCol = Maybe Int
forall a. Maybe a
Nothing
, insideDirective :: Bool
insideDirective = Bool
False
} FilePath
templPath Text
template
case res of
Left ParseError
e -> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Template a) -> m (Either FilePath (Template a)))
-> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (Template a)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Template a))
-> FilePath -> Either FilePath (Template a)
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
e
Right Template a
x -> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (Template a) -> m (Either FilePath (Template a)))
-> Either FilePath (Template a) -> m (Either FilePath (Template a))
forall a b. (a -> b) -> a -> b
$ Template a -> Either FilePath (Template a)
forall a b. b -> Either a b
Right Template a
x
data PState =
PState { PState -> FilePath
templatePath :: FilePath
, PState -> Int
partialNesting :: !Int
, PState -> Bool
breakingSpaces :: !Bool
, PState -> SourcePos
firstNonspace :: P.SourcePos
, PState -> Maybe Int
nestedCol :: Maybe Int
, PState -> Bool
insideDirective :: Bool
}
type Parser = P.ParsecT Text PState
pTemplate :: (TemplateMonad m, TemplateTarget a) => Parser m (Template a)
pTemplate :: forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate = do
ParsecT Text PState m () -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
pComment
[Template a] -> Template a
forall a. Monoid a => [a] -> a
mconcat ([Template a] -> Template a)
-> ParsecT Text PState m [Template a]
-> ParsecT Text PState m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m (Template a)
-> ParsecT Text PState m [Template a]
forall a. ParsecT Text PState m a -> ParsecT Text PState m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
((ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pLit ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pNewline ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pDirective ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ParsecT Text PState m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pEscape) ParsecT Text PState m (Template a)
-> ParsecT Text PState m () -> ParsecT Text PState m (Template a)
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m () -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
pComment)
pEndline :: Monad m => Parser m String
pEndline :: forall (m :: * -> *). Monad m => Parser m FilePath
pEndline = ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath)
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a b. (a -> b) -> a -> b
$ do
nls <- ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding
mbNested <- nestedCol <$> P.getState
inside <- insideDirective <$> P.getState
case mbNested of
Just Int
col -> do
ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany (ParsecT Text PState m Char -> ParsecT Text PState m ())
-> ParsecT Text PState m Char -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ do
ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition ParsecT Text PState m SourcePos
-> (SourcePos -> ParsecT Text PState m ())
-> ParsecT Text PState m ()
forall a b.
ParsecT Text PState m a
-> (a -> ParsecT Text PState m b) -> ParsecT Text PState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT Text PState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState m ())
-> (SourcePos -> Bool) -> SourcePos -> ParsecT Text PState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
col) (Int -> Bool) -> (SourcePos -> Int) -> SourcePos -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
P.sourceColumn
Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
' ' ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\t'
curcol <- SourcePos -> Int
P.sourceColumn (SourcePos -> Int)
-> ParsecT Text PState m SourcePos -> ParsecT Text PState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
guard $ inside || curcol >= col
Maybe Int
Nothing -> () -> ParsecT Text PState m ()
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
return nls
pBlankLine :: (TemplateTarget a, Monad m) => Parser m (Template a)
pBlankLine :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pBlankLine =
ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a))
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ Doc a -> Template a
forall a. Doc a -> Template a
Literal (Doc a -> Template a)
-> (FilePath -> Doc a) -> FilePath -> Template a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString (FilePath -> Template a)
-> ParsecT Text PState m FilePath
-> ParsecT Text PState m (Template a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding ParsecT Text PState m (Template a)
-> ParsecT Text PState m () -> ParsecT Text PState m (Template a)
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m () -> ParsecT Text PState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
pNewlineOrEof
pNewline :: (TemplateTarget a, Monad m) => Parser m (Template a)
pNewline :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pNewline = ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a))
-> ParsecT Text PState m (Template a)
-> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ do
nls <- Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pEndline
sps <- P.many (P.char ' ' <|> P.char '\t')
breakspaces <- breakingSpaces <$> P.getState
pos <- P.getPosition
P.updateState $ \PState
st -> PState
st{ firstNonspace = pos }
return $ Literal $
if breakspaces
then DL.BreakingSpace
else fromString $ nls <> sps
pLit :: (TemplateTarget a, Monad m) => Parser m (Template a)
pLit :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pLit = do
cs <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ((Char -> Bool) -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'))
when (all (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') cs) $ do
pos <- P.getPosition
when (P.sourceLine pos == 1) $
P.updateState $ \PState
st -> PState
st{ firstNonspace = pos }
breakspaces <- breakingSpaces <$> P.getState
if breakspaces
then return $ toBreakable cs
else return $ Literal $ fromString cs
toBreakable :: TemplateTarget a => String -> Template a
toBreakable :: forall a. TemplateTarget a => FilePath -> Template a
toBreakable [] = Template a
forall a. Template a
Empty
toBreakable FilePath
xs =
case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpacy FilePath
xs of
([], []) -> Template a
forall a. Template a
Empty
([], FilePath
zs) -> Doc a -> Template a
forall a. Doc a -> Template a
Literal Doc a
forall a. Doc a
DL.BreakingSpace Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Template a
forall a. TemplateTarget a => FilePath -> Template a
toBreakable ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpacy FilePath
zs)
(FilePath
ys, []) -> Doc a -> Template a
forall a. Doc a -> Template a
Literal (FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString FilePath
ys)
(FilePath
ys, FilePath
zs) -> Doc a -> Template a
forall a. Doc a -> Template a
Literal (FilePath -> Doc a
forall a. IsString a => FilePath -> a
fromString FilePath
ys) Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Template a
forall a. TemplateTarget a => FilePath -> Template a
toBreakable FilePath
zs
isSpacy :: Char -> Bool
isSpacy :: Char -> Bool
isSpacy Char
' ' = Bool
True
isSpacy Char
'\n' = Bool
True
isSpacy Char
'\r' = Bool
True
isSpacy Char
'\t' = Bool
True
isSpacy Char
_ = Bool
False
backupSourcePos :: Monad m => Int -> Parser m ()
backupSourcePos :: forall (m :: * -> *). Monad m => Int -> Parser m ()
backupSourcePos Int
n = do
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
P.setPosition $ P.incSourceColumn pos (- n)
pEscape :: (TemplateTarget a, Monad m) => Parser m (Template a)
pEscape :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pEscape = Doc a -> Template a
forall a. Doc a -> Template a
Literal Doc a
"$" Template a
-> ParsecT Text PState m FilePath
-> ParsecT Text PState m (Template a)
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"$$" ParsecT Text PState m FilePath
-> ParsecT Text PState m () -> ParsecT Text PState m FilePath
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Int -> Parser m ()
backupSourcePos Int
1)
pDirective :: (TemplateTarget a, TemplateMonad m)
=> Parser m (Template a)
pDirective :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pDirective =
Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pConditional Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pForLoop Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(Monoid a, Semigroup a, TemplateMonad m) =>
Parser m (Template a)
pReflowToggle Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pNested Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pInterpolate Parser m (Template a)
-> Parser m (Template a) -> Parser m (Template a)
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Template a)
forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pBarePartial
pEnclosed :: Monad m => Parser m a -> Parser m a
pEnclosed :: forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed Parser m a
parser = Parser m a -> Parser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m a -> Parser m a) -> Parser m a -> Parser m a
forall a b. (a -> b) -> a -> b
$ do
closer <- Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpen
P.skipMany pSpaceOrTab
result <- parser
P.skipMany pSpaceOrTab
closer
return result
pParens :: Monad m => Parser m a -> Parser m a
pParens :: forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m a
parser = do
Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'('
result <- Parser m a
parser
P.char ')'
return result
pInside :: Monad m
=> Parser m (Template a)
-> Parser m (Template a)
pInside :: forall (m :: * -> *) a.
Monad m =>
Parser m (Template a) -> Parser m (Template a)
pInside Parser m (Template a)
parser = do
oldInside <- PState -> Bool
insideDirective (PState -> Bool)
-> ParsecT Text PState m PState -> ParsecT Text PState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
P.updateState $ \PState
st -> PState
st{ insideDirective = True }
res <- parser
P.updateState $ \PState
st -> PState
st{ insideDirective = oldInside }
return res
pConditional :: (TemplateTarget a, TemplateMonad m)
=> Parser m (Template a)
pConditional :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pConditional = do
v <- Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ Parser m Variable -> Parser m Variable
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"if" ParsecT Text PState m FilePath
-> Parser m Variable -> Parser m Variable
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
pInside $ do
multiline <- P.option False (True <$ skipEndline)
ifContents <- pTemplate
elseContents <- P.option mempty (pElse multiline <|> pElseIf)
pEnclosed (P.string "endif")
when multiline $ P.option () skipEndline
return $ Conditional v ifContents elseContents
pElse :: (TemplateTarget a, TemplateMonad m)
=> Bool -> Parser m (Template a)
pElse :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Bool -> Parser m (Template a)
pElse Bool
multiline = do
Parser m FilePath -> Parser m FilePath
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (FilePath -> Parser m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"else")
Bool -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
multiline (ParsecT Text PState m () -> ParsecT Text PState m ())
-> ParsecT Text PState m () -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ () -> ParsecT Text PState m () -> ParsecT Text PState m ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option () ParsecT Text PState m ()
forall (m :: * -> *). Monad m => Parser m ()
skipEndline
Parser m (Template a)
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
Parser m (Template a)
pTemplate
pElseIf :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pElseIf :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pElseIf = do
v <- Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ Parser m Variable -> Parser m Variable
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"elseif" ParsecT Text PState m FilePath
-> Parser m Variable -> Parser m Variable
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
multiline <- P.option False (True <$ skipEndline)
ifContents <- pTemplate
elseContents <- P.option mempty (pElse multiline <|> pElseIf)
return $ Conditional v ifContents elseContents
skipEndline :: Monad m => Parser m ()
skipEndline :: forall (m :: * -> *). Monad m => Parser m ()
skipEndline = do
Parser m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pEndline
pos <- ParsecT Text PState m SourcePos -> ParsecT Text PState m SourcePos
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (ParsecT Text PState m SourcePos
-> ParsecT Text PState m SourcePos)
-> ParsecT Text PState m SourcePos
-> ParsecT Text PState m SourcePos
forall a b. (a -> b) -> a -> b
$ do
ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
' ' ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\t')
ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
P.updateState $ \PState
st -> PState
st{ firstNonspace = pos }
pReflowToggle :: (Monoid a, Semigroup a, TemplateMonad m)
=> Parser m (Template a)
pReflowToggle :: forall a (m :: * -> *).
(Monoid a, Semigroup a, TemplateMonad m) =>
Parser m (Template a)
pReflowToggle = do
Parser m Char -> Parser m Char
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Char -> Parser m Char) -> Parser m Char -> Parser m Char
forall a b. (a -> b) -> a -> b
$ Char -> Parser m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'~'
(PState -> PState) -> ParsecT Text PState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.modifyState ((PState -> PState) -> ParsecT Text PState m ())
-> (PState -> PState) -> ParsecT Text PState m ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ breakingSpaces = not (breakingSpaces st) }
Template a -> ParsecT Text PState m (Template a)
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Template a
forall a. Monoid a => a
mempty
pNested :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pNested :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pNested = do
col <- SourcePos -> Int
P.sourceColumn (SourcePos -> Int)
-> ParsecT Text PState m SourcePos -> ParsecT Text PState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
pEnclosed $ P.char '^'
oldNested <- nestedCol <$> P.getState
P.updateState $ \PState
st -> PState
st{ nestedCol = Just col }
x <- pTemplate
xs <- P.many $ P.try $ do
y <- mconcat <$> P.many1 pBlankLine
z <- pTemplate
return (y <> z)
let contents = Template a
x Template a -> Template a -> Template a
forall a. Semigroup a => a -> a -> a
<> [Template a] -> Template a
forall a. Monoid a => [a] -> a
mconcat [Template a]
xs
P.updateState $ \PState
st -> PState
st{ nestedCol = oldNested }
return $ Nested contents
pForLoop :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a)
pForLoop :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pForLoop = do
v <- Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pEnclosed (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ Parser m Variable -> Parser m Variable
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Parser m Variable -> Parser m Variable)
-> Parser m Variable -> Parser m Variable
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"for" ParsecT Text PState m FilePath
-> Parser m Variable -> Parser m Variable
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser m Variable -> Parser m Variable
forall (m :: * -> *) a. Monad m => Parser m a -> Parser m a
pParens Parser m Variable
forall (m :: * -> *). Monad m => Parser m Variable
pVar
pInside $ do
multiline <- P.option False $ skipEndline >> return True
contents <- pTemplate
sep <- P.option mempty $
do pEnclosed (P.string "sep")
when multiline $ P.option () skipEndline
pTemplate
pEnclosed (P.string "endfor")
when multiline $ P.option () skipEndline
return $ Iterate v contents sep
pInterpolate :: (TemplateTarget a, TemplateMonad m)
=> Parser m (Template a)
pInterpolate :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pInterpolate = do
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
(closer, var) <- P.try $ do
cl <- pOpen
P.skipMany pSpaceOrTab
v <- pVar
P.notFollowedBy (P.char '(')
return (cl, v)
res <- (P.char ':' *> (pPartialName >>= pPartial (Just var)))
<|> Iterate var (Interpolate (Variable ["it"] [])) <$> pSep
<|> return (Interpolate var)
P.skipMany pSpaceOrTab
closer
handleNesting False pos res
pLineEnding :: Monad m => Parser m String
pLineEnding :: forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding = FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\n" ParsecT Text PState m FilePath
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\r\n") ParsecT Text PState m FilePath
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"\r"
pNewlineOrEof :: Monad m => Parser m ()
pNewlineOrEof :: forall (m :: * -> *). Monad m => Parser m ()
pNewlineOrEof = () () -> ParsecT Text PState m FilePath -> ParsecT Text PState m ()
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath
forall (m :: * -> *). Monad m => Parser m FilePath
pLineEnding ParsecT Text PState m ()
-> ParsecT Text PState m () -> ParsecT Text PState m ()
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text PState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof
handleNesting :: TemplateMonad m
=> Bool -> P.SourcePos -> Template a -> Parser m (Template a)
handleNesting :: forall (m :: * -> *) a.
TemplateMonad m =>
Bool -> SourcePos -> Template a -> Parser m (Template a)
handleNesting Bool
eatEndline SourcePos
pos Template a
templ = do
firstNonspacePos <- PState -> SourcePos
firstNonspace (PState -> SourcePos)
-> ParsecT Text PState m PState -> ParsecT Text PState m SourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
let beginline = SourcePos
firstNonspacePos SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
pos
endofline <- (True <$ P.lookAhead pNewlineOrEof) <|> pure False
when (eatEndline && beginline) $ P.optional skipEndline
mbNested <- nestedCol <$> P.getState
let toNested t :: Template a
t@(Nested{}) = Template a
t
toNested Template a
t = case SourcePos -> Int
P.sourceColumn SourcePos
pos of
Int
1 -> Template a
t
Int
n | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
mbNested -> Template a
t
| Bool
otherwise -> Template a -> Template a
forall a. Template a -> Template a
Nested Template a
t
return $ if beginline && endofline
then toNested templ
else templ
pBarePartial :: (TemplateTarget a, TemplateMonad m)
=> Parser m (Template a)
pBarePartial :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Parser m (Template a)
pBarePartial = do
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
(closer, fp) <- P.try $ do
closer <- pOpen
P.skipMany pSpaceOrTab
fp <- pPartialName
return (closer, fp)
res <- pPartial Nothing fp
P.skipMany pSpaceOrTab
closer
handleNesting True pos res
pPartialName :: TemplateMonad m
=> Parser m FilePath
pPartialName :: forall (m :: * -> *). TemplateMonad m => Parser m FilePath
pPartialName = ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath)
-> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall a b. (a -> b) -> a -> b
$ do
fp <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 (ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
P.oneOf [Char
'_',Char
'-',Char
'.',Char
'/',Char
'\\'])
P.string "()"
return fp
pPartial :: (TemplateTarget a, TemplateMonad m)
=> Maybe Variable -> FilePath -> Parser m (Template a)
pPartial :: forall a (m :: * -> *).
(TemplateTarget a, TemplateMonad m) =>
Maybe Variable -> FilePath -> Parser m (Template a)
pPartial Maybe Variable
mbvar FilePath
fp = do
oldst <- ParsecT Text PState m PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState
separ <- P.option mempty pSep
tp <- templatePath <$> P.getState
let fp' = case FilePath -> FilePath
takeExtension FilePath
fp of
FilePath
"" -> FilePath -> FilePath -> FilePath
replaceBaseName FilePath
tp FilePath
fp
FilePath
_ -> FilePath -> FilePath -> FilePath
replaceFileName FilePath
tp FilePath
fp
partial <- lift $ removeFinalNewline <$> getPartial fp'
nesting <- partialNesting <$> P.getState
t <- if nesting > 50
then return $ Literal "(loop)"
else do
oldInput <- P.getInput
oldPos <- P.getPosition
P.setPosition $ P.initialPos fp'
P.setInput partial
P.updateState $ \PState
st -> PState
st{ partialNesting = nesting + 1 }
P.updateState $ \PState
st -> PState
st{ nestedCol = Nothing }
res' <- pTemplate <* P.eof
P.updateState $ \PState
st -> PState
st{ partialNesting = nesting }
P.setInput oldInput
P.setPosition oldPos
return res'
P.putState oldst
fs <- many pPipe
case mbvar of
Just Variable
var -> Template a -> ParsecT Text PState m (Template a)
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> ParsecT Text PState m (Template a))
-> Template a -> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ Variable -> Template a -> Template a -> Template a
forall a. Variable -> Template a -> Template a -> Template a
Iterate Variable
var ([Pipe] -> Template a -> Template a
forall a. [Pipe] -> Template a -> Template a
Partial [Pipe]
fs Template a
t) Template a
separ
Maybe Variable
Nothing -> Template a -> ParsecT Text PState m (Template a)
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template a -> ParsecT Text PState m (Template a))
-> Template a -> ParsecT Text PState m (Template a)
forall a b. (a -> b) -> a -> b
$ [Pipe] -> Template a -> Template a
forall a. [Pipe] -> Template a -> Template a
Partial [Pipe]
fs Template a
t
removeFinalNewline :: Text -> Text
removeFinalNewline :: Text -> Text
removeFinalNewline Text
t =
case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
Just (Text
t', Char
'\n') -> Text
t'
Maybe (Text, Char)
_ -> Text
t
pSep :: (TemplateTarget a, Monad m) => Parser m (Template a)
pSep :: forall a (m :: * -> *).
(TemplateTarget a, Monad m) =>
Parser m (Template a)
pSep = do
Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'['
xs <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ((Char -> Bool) -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']'))
P.char ']'
return $ Literal (fromString xs)
pSpaceOrTab :: Monad m => Parser m Char
pSpaceOrTab :: forall (m :: * -> *). Monad m => Parser m Char
pSpaceOrTab = (Char -> Bool) -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
pComment :: Monad m => Parser m ()
= do
pos <- ParsecT Text PState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition
P.try (P.string "$--")
P.skipMany (P.satisfy (/='\n'))
when (P.sourceColumn pos == 1) $ () <$ pNewlineOrEof
pOpenDollar :: Monad m => Parser m (Parser m ())
pOpenDollar :: forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenDollar =
ParsecT Text PState m ()
forall {u}. ParsecT Text u m ()
pCloseDollar ParsecT Text PState m ()
-> ParsecT Text PState m Char
-> ParsecT Text PState m (ParsecT Text PState m ())
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m Char -> ParsecT Text PState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$' ParsecT Text PState m Char
-> ParsecT Text PState m () -> ParsecT Text PState m Char
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$' ParsecT Text PState m Char
-> ParsecT Text PState m Char -> ParsecT Text PState m Char
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'{'))
where
pCloseDollar :: ParsecT Text u m ()
pCloseDollar = () () -> ParsecT Text u m Char -> ParsecT Text u m ()
forall a b. a -> ParsecT Text u m b -> ParsecT Text u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$'
pOpenBraces :: Monad m => Parser m (Parser m ())
pOpenBraces :: forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenBraces =
ParsecT Text PState m ()
forall {u}. ParsecT Text u m ()
pCloseBraces ParsecT Text PState m ()
-> ParsecT Text PState m FilePath
-> ParsecT Text PState m (ParsecT Text PState m ())
forall a b. a -> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"${" ParsecT Text PState m FilePath
-> ParsecT Text PState m () -> ParsecT Text PState m FilePath
forall a b.
ParsecT Text PState m a
-> ParsecT Text PState m b -> ParsecT Text PState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'}'))
where
pCloseBraces :: ParsecT Text u m ()
pCloseBraces = () () -> ParsecT Text u m Char -> ParsecT Text u m ()
forall a b. a -> ParsecT Text u m b -> ParsecT Text u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text u m Char -> ParsecT Text u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'}')
pOpen :: Monad m => Parser m (Parser m ())
pOpen :: forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpen = Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenDollar Parser m (Parser m ())
-> Parser m (Parser m ()) -> Parser m (Parser m ())
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m (Parser m ())
forall (m :: * -> *). Monad m => Parser m (Parser m ())
pOpenBraces
pVar :: Monad m => Parser m Variable
pVar :: forall (m :: * -> *). Monad m => Parser m Variable
pVar = do
first <- Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIdentPart Parser m Text -> Parser m Text -> Parser m Text
forall a.
ParsecT Text PState m a
-> ParsecT Text PState m a -> ParsecT Text PState m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m Text
forall (m :: * -> *). Monad m => Parser m Text
pIt
rest <- P.many (P.char '.' *> pIdentPart)
pipes <- P.many pPipe
return $ Variable (first:rest) pipes
pPipe :: Monad m => Parser m Pipe
pPipe :: forall (m :: * -> *). Monad m => Parser m Pipe
pPipe = do
Char -> ParsecT Text PState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'/'
pipeName <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter
P.notFollowedBy P.letter
case pipeName of
FilePath
"uppercase" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToUppercase
FilePath
"lowercase" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLowercase
FilePath
"pairs" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToPairs
FilePath
"length" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToLength
FilePath
"alpha" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToAlpha
FilePath
"roman" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
ToRoman
FilePath
"reverse" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Reverse
FilePath
"first" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
FirstItem
FilePath
"rest" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Rest
FilePath
"last" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
LastItem
FilePath
"allbutlast" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
AllButLast
FilePath
"chomp" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
Chomp
FilePath
"nowrap" -> Pipe -> ParsecT Text PState m Pipe
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pipe
NoWrap
FilePath
"left" -> Alignment -> Int -> Border -> Pipe
Block Alignment
LeftAligned (Int -> Border -> Pipe)
-> ParsecT Text PState m Int
-> ParsecT Text PState m (Border -> Pipe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m Int
forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth ParsecT Text PState m (Border -> Pipe)
-> ParsecT Text PState m Border -> ParsecT Text PState m Pipe
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState m Border
forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders
FilePath
"right" -> Alignment -> Int -> Border -> Pipe
Block Alignment
RightAligned (Int -> Border -> Pipe)
-> ParsecT Text PState m Int
-> ParsecT Text PState m (Border -> Pipe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m Int
forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth ParsecT Text PState m (Border -> Pipe)
-> ParsecT Text PState m Border -> ParsecT Text PState m Pipe
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState m Border
forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders
FilePath
"center" -> Alignment -> Int -> Border -> Pipe
Block Alignment
Centered (Int -> Border -> Pipe)
-> ParsecT Text PState m Int
-> ParsecT Text PState m (Border -> Pipe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m Int
forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth ParsecT Text PState m (Border -> Pipe)
-> ParsecT Text PState m Border -> ParsecT Text PState m Pipe
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState m Border
forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders
FilePath
_ -> FilePath -> ParsecT Text PState m Pipe
forall a. FilePath -> ParsecT Text PState m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT Text PState m Pipe)
-> FilePath -> ParsecT Text PState m Pipe
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown pipe " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pipeName
pBlockWidth :: Monad m => Parser m Int
pBlockWidth :: forall (m :: * -> *). Monad m => Parser m Int
pBlockWidth = ParsecT Text PState m Int -> ParsecT Text PState m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (do
_ <- ParsecT Text PState m Char -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space
ds <- P.many1 P.digit
case T.decimal (T.pack ds) of
Right (Int
n,Text
"") -> Int -> ParsecT Text PState m Int
forall a. a -> ParsecT Text PState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
Either FilePath (Int, Text)
_ -> FilePath -> ParsecT Text PState m Int
forall a. FilePath -> ParsecT Text PState m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expected integer parameter for pipe") ParsecT Text PState m Int -> FilePath -> ParsecT Text PState m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
P.<?>
FilePath
"integer parameter for pipe"
pBlockBorders :: Monad m => Parser m Border
pBlockBorders :: forall (m :: * -> *). Monad m => Parser m Border
pBlockBorders = do
ParsecT Text PState m Char -> ParsecT Text PState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space
let pBorder :: ParsecT Text u m Text
pBorder = do
Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"'
cs <- ParsecT Text u m Char -> ParsecT Text u m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (ParsecT Text u m Char -> ParsecT Text u m FilePath)
-> ParsecT Text u m Char -> ParsecT Text u m FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
P.noneOf [Char
'"',Char
'\\']) ParsecT Text u m Char
-> ParsecT Text u m Char -> ParsecT Text u m Char
forall a.
ParsecT Text u m a -> ParsecT Text u m a -> ParsecT Text u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\\' ParsecT Text u m Char
-> ParsecT Text u m Char -> ParsecT Text u m Char
forall a b.
ParsecT Text u m a -> ParsecT Text u m b -> ParsecT Text u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar)
P.char '"'
P.skipMany P.space
return $ T.pack cs
Text -> Text -> Border
Border (Text -> Text -> Border)
-> ParsecT Text PState m Text
-> ParsecT Text PState m (Text -> Border)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Text PState m Text -> ParsecT Text PState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Text
forall a. Monoid a => a
mempty ParsecT Text PState m Text
forall {u}. ParsecT Text u m Text
pBorder ParsecT Text PState m (Text -> Border)
-> ParsecT Text PState m Text -> ParsecT Text PState m Border
forall a b.
ParsecT Text PState m (a -> b)
-> ParsecT Text PState m a -> ParsecT Text PState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ParsecT Text PState m Text -> ParsecT Text PState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Text
forall a. Monoid a => a
mempty ParsecT Text PState m Text
forall {u}. ParsecT Text u m Text
pBorder
pIt :: Monad m => Parser m Text
pIt :: forall (m :: * -> *). Monad m => Parser m Text
pIt = FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (FilePath -> Text)
-> ParsecT Text PState m FilePath -> ParsecT Text PState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState m FilePath -> ParsecT Text PState m FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (FilePath -> ParsecT Text PState m FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
P.string FilePath
"it")
pIdentPart :: Monad m => Parser m Text
pIdentPart :: forall (m :: * -> *). Monad m => Parser m Text
pIdentPart = ParsecT Text PState m Text -> ParsecT Text PState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT Text PState m Text -> ParsecT Text PState m Text)
-> ParsecT Text PState m Text -> ParsecT Text PState m Text
forall a b. (a -> b) -> a -> b
$ do
first <- ParsecT Text PState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter
rest <- P.many (P.satisfy (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'))
let part = Char
first Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
rest
guard $ part `notElem` reservedWords
return $ fromString part
reservedWords :: [String]
reservedWords :: [FilePath]
reservedWords = [FilePath
"if",FilePath
"else",FilePath
"endif",FilePath
"elseif",FilePath
"for",FilePath
"endfor",FilePath
"sep",FilePath
"it"]