{-# LANGUAGE RelaxedPolyRec, DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK not-home #-}

module Text.StringTemplate.Base
    (StringTemplate(..), StringTemplateShows(..), ToSElem(..), STGroup,
     Stringable(..), stShowsToSE, inSGen,
     toString, toPPDoc, render, newSTMP, newAngleSTMP,
     getStringTemplate, getStringTemplate',
     setAttribute, setManyAttrib,
     setNativeAttribute, setManyNativeAttrib,
     withContext, optInsertTmpl, setEncoder,
     paddedTrans, SEnv(..), parseSTMP, dumpAttribs,
     checkTemplate, checkTemplateDeep,
     parseSTMPNames
    ) where
import Control.Arrow
import Control.Applicative hiding ((<|>),many,optional)
import Control.Monad
import Control.DeepSeq
import qualified Control.Exception as C
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Typeable
import System.IO.Unsafe

import Text.ParserCombinators.Parsec
import qualified Data.Map as M
import qualified Text.PrettyPrint.HughesPJ as PP

import Text.StringTemplate.Classes
import Text.StringTemplate.Instances()

{--------------------------------------------------------------------
  Generic Utilities
--------------------------------------------------------------------}

type TmplParser = GenParser Char ((Char, Char),[String],[String],[String])

(<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)
<$$> :: forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
(<$$>) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)
infixr 8 <$$>

(|.) :: (t1 -> t2) -> (t -> t1) -> t -> t2
|. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
(|.) t1 -> t2
f t -> t1
g = t1 -> t2
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t1
g
infixr 3 |.

(.>>) :: (Monad m) => m a -> m b -> m b
.>> :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(.>>) m a
f m b
g = m a
f forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
g
infixr 5 .>>

fromMany :: b -> ([a] -> b) -> [a] -> b
fromMany :: forall b a. b -> ([a] -> b) -> [a] -> b
fromMany b
e [a] -> b
_ [] = b
e
fromMany b
_ [a] -> b
f [a]
xs  = [a] -> b
f [a]
xs

swing :: (((a -> c1) -> c1) -> b -> c) -> b -> a -> c
swing :: forall a c1 b c. (((a -> c1) -> c1) -> b -> c) -> b -> a -> c
swing = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> a
id)

paddedTrans :: a -> [[a]] -> [[a]]
paddedTrans :: forall a. a -> [[a]] -> [[a]]
paddedTrans a
_ [] = []
paddedTrans a
n [[a]]
as = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [[a]]
as) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
trans forall a b. (a -> b) -> a -> b
$ [[a]]
as
    where trans :: [[a]] -> [[a]]
trans ([] : [[a]]
xss)  = (a
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
h [[a]]
xss) forall a. a -> [a] -> [a]
:  [[a]] -> [[a]]
trans ([a
n] forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
t [[a]]
xss)
          trans ((a
x : [a]
xs) : [[a]]
xss) = (a
x forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
h [[a]]
xss) forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
trans ([a] -> [a]
m [a]
xs forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
t [[a]]
xss)
          trans [[a]]
_ = [];
          h :: [a] -> a
h (a
x:[a]
_) = a
x; h [a]
_ = a
n; t :: [a] -> [a]
t (a
_:a
y:[a]
xs) = a
yforall a. a -> [a] -> [a]
:[a]
xs; t [a]
_ = [a
n];
          m :: [a] -> [a]
m (a
x:[a]
xs) = a
xforall a. a -> [a] -> [a]
:[a]
xs; m [a]
_ = [a
n];

{--------------------------------------------------------------------
  StringTemplate and the API
--------------------------------------------------------------------}

-- | A function that generates StringTemplates.
-- This is conceptually a query function into a \"group\" of StringTemplates.
type STGroup a = String -> (StFirst (StringTemplate a))

-- | A String with \"holes\" in it. StringTemplates may be composed of any
-- 'Stringable' type, which at the moment includes 'String's, 'ByteString's,
-- PrettyPrinter 'Doc's, and 'Endo' 'String's, which are actually of type
-- 'ShowS'. When a StringTemplate is composed of a type, its internals are
-- as well, so it is, so to speak \"turtles all the way down.\"
data StringTemplate a = STMP {forall a. StringTemplate a -> SEnv a
senv :: SEnv a,  forall a. StringTemplate a -> Either [Char] (SEnv a -> a)
runSTMP :: Either String (SEnv a -> a), forall a.
StringTemplate a
-> SEnv a -> (Maybe [Char], Maybe [[Char]], Maybe [[Char]])
chkSTMP :: SEnv a -> (Maybe String, Maybe [String], Maybe [String])}

-- | Renders a StringTemplate to a String.
toString :: StringTemplate String -> String
toString :: StringTemplate [Char] -> [Char]
toString = forall a. Stringable a => StringTemplate a -> a
render

-- | Renders a StringTemplate to a 'Text.PrettyPrint.HughesPJ.Doc'.
toPPDoc :: StringTemplate PP.Doc -> PP.Doc
toPPDoc :: StringTemplate Doc -> Doc
toPPDoc = forall a. Stringable a => StringTemplate a -> a
render

-- | Generic render function for a StringTemplate of any type.
render :: Stringable a => StringTemplate a -> a
render :: forall a. Stringable a => StringTemplate a -> a
render = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Stringable a => [Char] -> SEnv a -> a
showStr) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringTemplate a -> Either [Char] (SEnv a -> a)
runSTMP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. StringTemplate a -> SEnv a
senv

nullEnv :: SEnv a
nullEnv :: forall a. SEnv a
nullEnv = forall a.
SMap a
-> [([Char], SEnv a -> SElem a)] -> STGroup a -> (a -> a) -> SEnv a
SEnv forall k a. Map k a
M.empty [] forall a. Monoid a => a
mempty forall a. a -> a
id

-- | Returns a tuple of three Maybes. The first is set if there is a parse error in the template.
-- The next is set to a list of attributes that have not been set, or Nothing if all attributes are set.
-- The last is set to a list of invoked templates that cannot be looked up, or Nothing if all invoked templates can be found.
-- Note that this check is shallow -- i.e. missing attributes and templates are only caught in the top level template, not any invoked subtemplate.
checkTemplate :: Stringable a => StringTemplate a -> (Maybe String, Maybe [String], Maybe [String])
checkTemplate :: forall a.
Stringable a =>
StringTemplate a -> (Maybe [Char], Maybe [[Char]], Maybe [[Char]])
checkTemplate StringTemplate a
t = forall a.
StringTemplate a
-> SEnv a -> (Maybe [Char], Maybe [[Char]], Maybe [[Char]])
chkSTMP StringTemplate a
t (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
t)

-- | Parses a String to produce a StringTemplate, with \'$\'s as delimiters.
-- It is constructed with a stub group that cannot look up other templates.
newSTMP :: Stringable a => String -> StringTemplate a
newSTMP :: forall a. Stringable a => [Char] -> StringTemplate a
newSTMP [Char]
s = forall a.
SEnv a
-> Either [Char] (SEnv a -> a)
-> (SEnv a -> (Maybe [Char], Maybe [[Char]], Maybe [[Char]]))
-> StringTemplate a
STMP forall a. SEnv a
nullEnv (forall a.
Stringable a =>
(Char, Char) -> [Char] -> Either [Char] (SEnv a -> a)
parseSTMP (Char
'$',Char
'$') [Char]
s) (forall a.
Stringable a =>
(Char, Char)
-> [Char]
-> SEnv a
-> (Maybe [Char], Maybe [[Char]], Maybe [[Char]])
chkStmp (Char
'$',Char
'$') [Char]
s)

-- | Parses a String to produce a StringTemplate, delimited by angle brackets.
-- It is constructed with a stub group that cannot look up other templates.
newAngleSTMP :: Stringable a => String -> StringTemplate a
newAngleSTMP :: forall a. Stringable a => [Char] -> StringTemplate a
newAngleSTMP [Char]
s = forall a.
SEnv a
-> Either [Char] (SEnv a -> a)
-> (SEnv a -> (Maybe [Char], Maybe [[Char]], Maybe [[Char]]))
-> StringTemplate a
STMP forall a. SEnv a
nullEnv (forall a.
Stringable a =>
(Char, Char) -> [Char] -> Either [Char] (SEnv a -> a)
parseSTMP (Char
'<',Char
'>') [Char]
s) (forall a.
Stringable a =>
(Char, Char)
-> [Char]
-> SEnv a
-> (Maybe [Char], Maybe [[Char]], Maybe [[Char]])
chkStmp (Char
'<',Char
'>') [Char]
s)

-- | Yields a StringTemplate with the appropriate attribute set.
-- If the attribute already exists, it is appended to a list.
setAttribute :: (ToSElem a, Stringable b) => String -> a -> StringTemplate b -> StringTemplate b
setAttribute :: forall a b.
(ToSElem a, Stringable b) =>
[Char] -> a -> StringTemplate b -> StringTemplate b
setAttribute [Char]
s a
x StringTemplate b
st = StringTemplate b
st {senv :: SEnv b
senv = forall a. Stringable a => [Char] -> SElem a -> SEnv a -> SEnv a
envInsApp [Char]
s (forall a b. (ToSElem a, Stringable b) => a -> SElem b
toSElem a
x) (forall a. StringTemplate a -> SEnv a
senv StringTemplate b
st)}

-- | Yields a StringTemplate with the appropriate attributes set.
-- If any attribute already exists, it is appended to a list.
setManyAttrib :: (ToSElem a, Stringable b) => [(String, a)] -> StringTemplate b -> StringTemplate b
setManyAttrib :: forall a b.
(ToSElem a, Stringable b) =>
[([Char], a)] -> StringTemplate b -> StringTemplate b
setManyAttrib = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b.
(ToSElem a, Stringable b) =>
[Char] -> a -> StringTemplate b -> StringTemplate b
setAttribute

-- | Yields a StringTemplate with the appropriate attribute set.
-- If the attribute already exists, it is appended to a list.
-- This will not translate the attribute through any intermediate
-- representation, so is more efficient when, e.g. setting
-- attributes that are large bytestrings in a bytestring template.
setNativeAttribute :: Stringable b => String -> b -> StringTemplate b -> StringTemplate b
setNativeAttribute :: forall b.
Stringable b =>
[Char] -> b -> StringTemplate b -> StringTemplate b
setNativeAttribute [Char]
s b
x StringTemplate b
st = StringTemplate b
st {senv :: SEnv b
senv = forall a. Stringable a => [Char] -> SElem a -> SEnv a -> SEnv a
envInsApp [Char]
s (forall a. a -> SElem a
SNAT b
x) (forall a. StringTemplate a -> SEnv a
senv StringTemplate b
st)}

-- | Yields a StringTemplate with the appropriate attributes set.
-- If any attribute already exists, it is appended to a list.
-- Attributes are added natively, which may provide
-- efficiency gains.
setManyNativeAttrib :: (Stringable b) => [(String, b)] -> StringTemplate b -> StringTemplate b
setManyNativeAttrib :: forall b.
Stringable b =>
[([Char], b)] -> StringTemplate b -> StringTemplate b
setManyNativeAttrib = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b.
Stringable b =>
[Char] -> b -> StringTemplate b -> StringTemplate b
setNativeAttribute

-- | Replaces the attributes of a StringTemplate with those
-- described in the second argument. If the argument does not yield
-- a set of named attributes but only a single one, that attribute
-- is named, as a default, \"it\".
withContext :: (ToSElem a, Stringable b) => StringTemplate b -> a -> StringTemplate b
withContext :: forall a b.
(ToSElem a, Stringable b) =>
StringTemplate b -> a -> StringTemplate b
withContext StringTemplate b
st a
x = case forall a b. (ToSElem a, Stringable b) => a -> SElem b
toSElem a
x of
                     SM SMap b
a -> StringTemplate b
st {senv :: SEnv b
senv = (forall a. StringTemplate a -> SEnv a
senv StringTemplate b
st) {smp :: SMap b
smp = SMap b
a}}
                     SElem b
b -> StringTemplate b
st {senv :: SEnv b
senv = (forall a. StringTemplate a -> SEnv a
senv StringTemplate b
st) {smp :: SMap b
smp = forall k a. k -> a -> Map k a
M.singleton [Char]
"it" SElem b
b}}

-- | Queries an String Template Group and returns Just the appropriate
-- StringTemplate if it exists, otherwise, Nothing.
getStringTemplate :: (Stringable a) => String -> STGroup a -> Maybe (StringTemplate a)
getStringTemplate :: forall a.
Stringable a =>
[Char] -> STGroup a -> Maybe (StringTemplate a)
getStringTemplate [Char]
s STGroup a
sg = forall a. StFirst a -> Maybe a
stGetFirst (STGroup a
sg [Char]
s)

-- | As with 'getStringTemplate' but never inlined, so appropriate for use
-- with volatile template groups.
{-# NOINLINE getStringTemplate' #-}
getStringTemplate' :: (Stringable a) => String -> STGroup a -> Maybe (StringTemplate a)
getStringTemplate' :: forall a.
Stringable a =>
[Char] -> STGroup a -> Maybe (StringTemplate a)
getStringTemplate' [Char]
s STGroup a
sg = forall a. StFirst a -> Maybe a
stGetFirst (STGroup a
sg [Char]
s)

-- | Adds a set of global options to a single template
optInsertTmpl :: [(String, String)] -> StringTemplate a -> StringTemplate a
optInsertTmpl :: forall a.
[([Char], [Char])] -> StringTemplate a -> StringTemplate a
optInsertTmpl [([Char], [Char])]
x StringTemplate a
st = StringTemplate a
st {senv :: SEnv a
senv = forall a. [([Char], SEnv a -> SElem a)] -> SEnv a -> SEnv a
optInsert (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b a. [Char] -> b -> SElem a
justSTR) [([Char], [Char])]
x) (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
st)}

-- | Sets an encoding function of a template that all values are
-- rendered with. For example one useful encoder would be 'Text.Html.stringToHtmlString'. All attributes will be encoded once and only once.
setEncoder :: (Stringable a) => (a -> a) -> StringTemplate a -> StringTemplate a
setEncoder :: forall a.
Stringable a =>
(a -> a) -> StringTemplate a -> StringTemplate a
setEncoder a -> a
x StringTemplate a
st = StringTemplate a
st {senv :: SEnv a
senv = (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
st) {senc :: a -> a
senc = a -> a
x} }

-- | A special template that simply dumps the values of all the attributes set in it.
-- This may be made available to any template as a function by adding it to its group.
-- I.e. @ myNewGroup = addSuperGroup myGroup $ groupStringTemplates [("dumpAttribs", dumpAttribs)] @
dumpAttribs :: Stringable a => StringTemplate a
dumpAttribs :: forall a. Stringable a => StringTemplate a
dumpAttribs = forall a.
SEnv a
-> Either [Char] (SEnv a -> a)
-> (SEnv a -> (Maybe [Char], Maybe [[Char]], Maybe [[Char]]))
-> StringTemplate a
STMP forall a. SEnv a
nullEnv (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \SEnv a
env -> forall a. Stringable a => SEnv a -> SElem a -> a
showVal SEnv a
env (forall a. SMap a -> SElem a
SM forall a b. (a -> b) -> a -> b
$ forall a. SEnv a -> SMap a
smp SEnv a
env)) (forall a b. a -> b -> a
const (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing))

{--------------------------------------------------------------------
  Internal API
--------------------------------------------------------------------}
--IMPLEMENT groups having stLookup return a Maybe for regions

data SEnv a = SEnv {forall a. SEnv a -> SMap a
smp :: SMap a, forall a. SEnv a -> [([Char], SEnv a -> SElem a)]
sopts :: [(String, (SEnv a -> SElem a))], forall a. SEnv a -> STGroup a
sgen :: STGroup a, forall a. SEnv a -> a -> a
senc :: a -> a}

inSGen :: (STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen :: forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen STGroup a -> STGroup a
f st :: StringTemplate a
st@STMP{senv :: forall a. StringTemplate a -> SEnv a
senv = SEnv a
env} = StringTemplate a
st {senv :: SEnv a
senv = SEnv a
env {sgen :: STGroup a
sgen = STGroup a -> STGroup a
f (forall a. SEnv a -> STGroup a
sgen SEnv a
env)} }

{-
envLookup :: String -> SEnv a -> Maybe (SElem a)
envLookup x = M.lookup x . smp
-}

envLookupEx :: String -> SEnv a -> SElem a
envLookupEx :: forall a. [Char] -> SEnv a -> SElem a
envLookupEx [Char]
x SEnv a
snv = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
x (forall a. SEnv a -> SMap a
smp SEnv a
snv) of
                      Just SElem a
a -> SElem a
a
                      Maybe (SElem a)
Nothing -> case forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"throwException" SEnv a
snv of
                                   Just SEnv a -> SElem a
_ -> forall a e. Exception e => e -> a
C.throw forall a b. (a -> b) -> a -> b
$ [Char] -> TmplException
NoAttrib [Char]
x
                                   Maybe (SEnv a -> SElem a)
Nothing -> forall a. SElem a
SNull

envInsert :: (String, SElem a) -> SEnv a -> SEnv a
envInsert :: forall a. ([Char], SElem a) -> SEnv a -> SEnv a
envInsert ([Char]
s, SElem a
x) SEnv a
y = SEnv a
y {smp :: SMap a
smp = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Char]
s SElem a
x (forall a. SEnv a -> SMap a
smp SEnv a
y)}
envInsApp :: Stringable a => String -> SElem a -> SEnv a -> SEnv a
envInsApp :: forall a. Stringable a => [Char] -> SElem a -> SEnv a -> SEnv a
envInsApp  [Char]
s  SElem a
x  SEnv a
y = SEnv a
y {smp :: SMap a
smp = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall {a}. SElem a -> SElem a -> SElem a
go [Char]
s SElem a
x (forall a. SEnv a -> SMap a
smp SEnv a
y)}
    where go :: SElem a -> SElem a -> SElem a
go SElem a
a (LI [SElem a]
bs) = forall a. [SElem a] -> SElem a
LI (SElem a
aforall a. a -> [a] -> [a]
:[SElem a]
bs)
          go SElem a
a SElem a
b = forall a. [SElem a] -> SElem a
LI [SElem a
a,SElem a
b]

optLookup :: String -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup :: forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
x = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SEnv a -> [([Char], SEnv a -> SElem a)]
sopts
optInsert :: [(String, SEnv a -> SElem a)] -> SEnv a -> SEnv a
optInsert :: forall a. [([Char], SEnv a -> SElem a)] -> SEnv a -> SEnv a
optInsert [([Char], SEnv a -> SElem a)]
x SEnv a
env = SEnv a
env {sopts :: [([Char], SEnv a -> SElem a)]
sopts = [([Char], SEnv a -> SElem a)]
x forall a. [a] -> [a] -> [a]
++ forall a. SEnv a -> [([Char], SEnv a -> SElem a)]
sopts SEnv a
env}
nullOpt :: SEnv a -> SElem a
nullOpt :: forall a. SEnv a -> SElem a
nullOpt = forall a. a -> Maybe a -> a
fromMaybe (forall b a. [Char] -> b -> SElem a
justSTR [Char]
"") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"null"

stLookup :: (Stringable a) => String -> SEnv a -> StringTemplate a
stLookup :: forall a. Stringable a => [Char] -> SEnv a -> StringTemplate a
stLookup [Char]
x SEnv a
env = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Stringable a => [Char] -> StringTemplate a
newSTMP ([Char]
"No Template Found for: " forall a. [a] -> [a] -> [a]
++ [Char]
x))
                 (\StringTemplate a
st-> StringTemplate a
st {senv :: SEnv a
senv = forall a. SEnv a -> SEnv a -> SEnv a
mergeSEnvs SEnv a
env (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
st)}) forall a b. (a -> b) -> a -> b
$ forall a. StFirst a -> Maybe a
stGetFirst (forall a. SEnv a -> STGroup a
sgen SEnv a
env [Char]
x)

--merges values of former into latter, preserving encoder
--of latter, as well as non-overriden options. group of latter is overridden.
mergeSEnvs :: SEnv a -> SEnv a -> SEnv a
mergeSEnvs :: forall a. SEnv a -> SEnv a -> SEnv a
mergeSEnvs SEnv a
x SEnv a
y = SEnv {smp :: SMap a
smp = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (forall a. SEnv a -> SMap a
smp SEnv a
x) (forall a. SEnv a -> SMap a
smp SEnv a
y), sopts :: [([Char], SEnv a -> SElem a)]
sopts = (forall a. SEnv a -> [([Char], SEnv a -> SElem a)]
sopts SEnv a
y forall a. [a] -> [a] -> [a]
++ forall a. SEnv a -> [([Char], SEnv a -> SElem a)]
sopts SEnv a
x), sgen :: STGroup a
sgen = forall a. SEnv a -> STGroup a
sgen SEnv a
x, senc :: a -> a
senc = forall a. SEnv a -> a -> a
senc SEnv a
y}

parseSTMP :: (Stringable a) => (Char, Char) -> String -> Either String (SEnv a -> a)
parseSTMP :: forall a.
Stringable a =>
(Char, Char) -> [Char] -> Either [Char] (SEnv a -> a)
parseSTMP (Char, Char)
x = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser (forall a. Stringable a => Bool -> TmplParser (SEnv a -> a)
stmpl Bool
False) ((Char, Char)
x,[],[],[]) [Char]
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dropTrailingBr

dropTrailingBr :: String -> String
dropTrailingBr :: [Char] -> [Char]
dropTrailingBr (Char
'\r':Char
'\n':[]) = []
dropTrailingBr (Char
'\n':[]) = []
dropTrailingBr [] = []
dropTrailingBr (Char
x:[Char]
xs) = Char
x forall a. a -> [a] -> [a]
: [Char] -> [Char]
dropTrailingBr [Char]
xs

getSeps :: TmplParser (Char, Char)
getSeps :: TmplParser (Char, Char)
getSeps = (\((Char, Char)
x,[[Char]]
_,[[Char]]
_,[[Char]]
_) -> (Char, Char)
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

tellName :: String -> TmplParser ()
tellName :: [Char] -> TmplParser ()
tellName [Char]
x = forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \((Char, Char)
s,[[Char]]
q,[[Char]]
n,[[Char]]
t) -> forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ((Char, Char)
s,[[Char]]
q,[Char]
xforall a. a -> [a] -> [a]
:[[Char]]
n,[[Char]]
t)

tellQQ :: String -> TmplParser ()
tellQQ :: [Char] -> TmplParser ()
tellQQ [Char]
x = forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \((Char, Char)
s,[[Char]]
q,[[Char]]
n,[[Char]]
t) -> forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ((Char, Char)
s,[Char]
xforall a. a -> [a] -> [a]
:[[Char]]
q,[[Char]]
n,[[Char]]
t)

tellTmpl :: String -> TmplParser ()
tellTmpl :: [Char] -> TmplParser ()
tellTmpl [Char]
x = forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \((Char, Char)
s,[[Char]]
q,[[Char]]
n,[[Char]]
t) -> forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ((Char, Char)
s,[[Char]]
q,[[Char]]
n,[Char]
xforall a. a -> [a] -> [a]
:[[Char]]
t)

-- | Gets all quasiquoted names, normal names & templates used in a given template.
-- Must be passed a pair of chars denoting the delimeters to be used.
parseSTMPNames :: (Char, Char) -> String -> Either ParseError ([String],[String],[String])
parseSTMPNames :: (Char, Char)
-> [Char] -> Either ParseError ([[Char]], [[Char]], [[Char]])
parseSTMPNames (Char, Char)
cs [Char]
s = forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  ([[Char]], [[Char]], [[Char]])
getRefs ((Char, Char)
cs,[],[],[]) [Char]
"" [Char]
s
    where getRefs :: ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  ([[Char]], [[Char]], [[Char]])
getRefs = do
            SEnv [Char] -> [Char]
_ <- forall a. Stringable a => Bool -> TmplParser (SEnv a -> a)
stmpl Bool
False :: TmplParser (SEnv String -> String)
            ((Char, Char)
_,[[Char]]
qqnames,[[Char]]
regnames,[[Char]]
tmpls) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
            forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
qqnames, [[Char]]
regnames, [[Char]]
tmpls)

chkStmp :: Stringable a => (Char, Char) -> String -> SEnv a -> (Maybe String, Maybe [String], Maybe [String])
chkStmp :: forall a.
Stringable a =>
(Char, Char)
-> [Char]
-> SEnv a
-> (Maybe [Char], Maybe [[Char]], Maybe [[Char]])
chkStmp (Char, Char)
cs [Char]
s SEnv a
snv = case (Char, Char)
-> [Char] -> Either ParseError ([[Char]], [[Char]], [[Char]])
parseSTMPNames (Char, Char)
cs [Char]
s of
                     Left ParseError
err -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"Parse error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ParseError
err, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
                     Right ([[Char]]
_, [[Char]]
regnames, [[Char]]
tmpls) ->
                         let nonms :: [[Char]]
nonms   = forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
x -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
x (forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall a. SEnv a -> SMap a
smp SEnv a
snv)) [[Char]]
regnames
                             notmpls :: [[Char]]
notmpls = forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
x -> forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall a. StFirst a -> Maybe a
stGetFirst (forall a. SEnv a -> STGroup a
sgen SEnv a
snv [Char]
x)) [[Char]]
tmpls
                         in (forall a. Maybe a
Nothing, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
nonms then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [[Char]]
nonms,
                                      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
notmpls then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [[Char]]
notmpls)

data TmplException = NoAttrib String | NoTmpl String | ParseError String String deriving (Int -> TmplException -> [Char] -> [Char]
[TmplException] -> [Char] -> [Char]
TmplException -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TmplException] -> [Char] -> [Char]
$cshowList :: [TmplException] -> [Char] -> [Char]
show :: TmplException -> [Char]
$cshow :: TmplException -> [Char]
showsPrec :: Int -> TmplException -> [Char] -> [Char]
$cshowsPrec :: Int -> TmplException -> [Char] -> [Char]
Show, Typeable)
instance C.Exception TmplException

-- | Generic render function for a StringTemplate of any type.
renderErr :: Stringable a => String -> StringTemplate a -> a
renderErr :: forall a. Stringable a => [Char] -> StringTemplate a -> a
renderErr [Char]
n StringTemplate a
t = case forall a. StringTemplate a -> Either [Char] (SEnv a -> a)
runSTMP StringTemplate a
t of
                Right SEnv a -> a
rt -> SEnv a -> a
rt (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
t)
                Left [Char]
err -> case forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"throwException" (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
t) of
                              Just SEnv a -> SElem a
_ -> forall a e. Exception e => e -> a
C.throw forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> TmplException
ParseError [Char]
n [Char]
err
                              Maybe (SEnv a -> SElem a)
Nothing -> forall a. Stringable a => [Char] -> SEnv a -> a
showStr [Char]
err (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
t)

-- | Returns a tuple of three lists. The first is of templates with parse errors, and their errors. The next is of missing attributes, and the last is of missing templates. If there are no errors, then all lists will be empty. This check is performed recursively.
checkTemplateDeep :: (Stringable a, NFData a) => StringTemplate a -> ([(String,String)], [String], [String])
checkTemplateDeep :: forall a.
(Stringable a, NFData a) =>
StringTemplate a -> ([([Char], [Char])], [[Char]], [[Char]])
checkTemplateDeep StringTemplate a
t = case forall a. StringTemplate a -> Either [Char] (SEnv a -> a)
runSTMP StringTemplate a
t of
                        Left [Char]
err -> ([([Char]
"Top Level Template", [Char]
err)], [],[])
                        Right SEnv a -> a
_ -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall {a}.
(NFData a, Stringable a) =>
([([Char], [Char])], [[Char]], [[Char]])
-> StringTemplate a -> IO ([([Char], [Char])], [[Char]], [[Char]])
go ([],[],[]) forall a b. (a -> b) -> a -> b
$ forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (forall a. Monoid a => a -> a -> a
`mappend` forall {a}. [Char] -> StFirst a
nullGroup) forall a b. (a -> b) -> a -> b
$ forall a.
[([Char], [Char])] -> StringTemplate a -> StringTemplate a
optInsertTmpl [([Char]
"throwException",[Char]
"true")] StringTemplate a
t
    where go :: ([([Char], [Char])], [[Char]], [[Char]])
-> StringTemplate a -> IO ([([Char], [Char])], [[Char]], [[Char]])
go ([([Char], [Char])]
e1,[[Char]]
e2,[[Char]]
e3) StringTemplate a
tmpl = (forall a. a -> IO a
C.evaluate (forall a. NFData a => a -> ()
rnf forall a b. (a -> b) -> a -> b
$ forall a. Stringable a => StringTemplate a -> a
render StringTemplate a
tmpl) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char], [Char])]
e1,[[Char]]
e2,[[Char]]
e3)) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch`
                                  \TmplException
e -> case TmplException
e of NoTmpl [Char]
x -> ([([Char], [Char])], [[Char]], [[Char]])
-> StringTemplate a -> IO ([([Char], [Char])], [[Char]], [[Char]])
go ([([Char], [Char])]
e1,[[Char]]
e2,[Char]
xforall a. a -> [a] -> [a]
:[[Char]]
e3) forall a b. (a -> b) -> a -> b
$ forall {a}.
Stringable a =>
[Char] -> StringTemplate a -> StringTemplate a
addSub [Char]
x StringTemplate a
tmpl
                                                  NoAttrib [Char]
x -> ([([Char], [Char])], [[Char]], [[Char]])
-> StringTemplate a -> IO ([([Char], [Char])], [[Char]], [[Char]])
go ([([Char], [Char])]
e1,[Char]
xforall a. a -> [a] -> [a]
:[[Char]]
e2, [[Char]]
e3) forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
[Char] -> a -> StringTemplate b -> StringTemplate b
setAttribute [Char]
x [Char]
"" StringTemplate a
tmpl
                                                  ParseError [Char]
n [Char]
x -> ([([Char], [Char])], [[Char]], [[Char]])
-> StringTemplate a -> IO ([([Char], [Char])], [[Char]], [[Char]])
go (([Char]
n,[Char]
x)forall a. a -> [a] -> [a]
:[([Char], [Char])]
e1,[[Char]]
e2,[[Char]]
e3) forall a b. (a -> b) -> a -> b
$ forall {a}.
Stringable a =>
[Char] -> StringTemplate a -> StringTemplate a
addSub [Char]
n StringTemplate a
tmpl
          addSub :: [Char] -> StringTemplate a -> StringTemplate a
addSub [Char]
x StringTemplate a
tmpl = forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$ forall {a} {a}.
(Eq a, Stringable a) =>
a -> a -> StFirst (StringTemplate a)
blankGroup [Char]
x) StringTemplate a
tmpl
          blankGroup :: a -> a -> StFirst (StringTemplate a)
blankGroup a
x a
s = forall a. Maybe a -> StFirst a
StFirst forall a b. (a -> b) -> a -> b
$ if a
x forall a. Eq a => a -> a -> Bool
== a
s then forall a. a -> Maybe a
Just (forall a. Stringable a => [Char] -> StringTemplate a
newSTMP [Char]
"") else forall a. Maybe a
Nothing
          nullGroup :: [Char] -> StFirst a
nullGroup [Char]
x = forall a. Maybe a -> StFirst a
StFirst forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a e. Exception e => e -> a
C.throw forall a b. (a -> b) -> a -> b
$ [Char] -> TmplException
NoTmpl [Char]
x)

{--------------------------------------------------------------------
  Internal API for polymorphic display of elements
--------------------------------------------------------------------}

mconcatMap' :: Stringable a => SEnv a -> [b] -> (b -> a) -> a
mconcatMap' :: forall a b. Stringable a => SEnv a -> [b] -> (b -> a) -> a
mconcatMap' SEnv a
snv [b]
xs b -> a
f = forall a. Stringable a => a -> [a] -> a
mintercalate a
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map b -> a
f forall a b. (a -> b) -> a -> b
$ [b]
xs
    where sep :: a
sep = forall a. Stringable a => SEnv a -> SElem a -> a
showVal SEnv a
snv forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall b a. [Char] -> b -> SElem a
justSTR [Char]
"") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"separator" forall a b. (a -> b) -> a -> b
$ SEnv a
snv

showVal :: Stringable a => SEnv a -> SElem a -> a
showVal :: forall a. Stringable a => SEnv a -> SElem a -> a
showVal SEnv a
snv SElem a
se = case SElem a
se of
                   STR [Char]
x  -> [Char] -> a
stEncode [Char]
x
                   BS  ByteString
x  -> ByteString -> a
stEncodeBS ByteString
x
                   TXT Text
x  -> Text -> a
stEncodeText Text
x
                   LI [SElem a]
xs  -> forall {b}. (SEnv a -> b -> a) -> [b] -> a
joinUpWith forall a. Stringable a => SEnv a -> SElem a -> a
showVal [SElem a]
xs
                   SM SMap a
sm  -> forall {b}. (SEnv a -> b -> a) -> [b] -> a
joinUpWith SEnv a -> ([Char], SElem a) -> a
showAssoc forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.assocs SMap a
sm
                   STSH STShow
x -> [Char] -> a
stEncode (STShow -> [Char]
format STShow
x)
                   SNAT a
x -> forall a. SEnv a -> a -> a
senc SEnv a
snv a
x
                   SBLE a
x -> a
x
                   SElem a
SNull  -> forall a. Stringable a => SEnv a -> SElem a -> a
showVal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. SEnv a -> SElem a
nullOpt forall a b. (a -> b) -> a -> b
$ SEnv a
snv
    where format :: STShow -> [Char]
format = forall b a. b -> (a -> b) -> Maybe a -> b
maybe STShow -> [Char]
stshow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Stringable a =>
SEnv a -> (SEnv a -> SElem a) -> STShow -> [Char]
stfshow forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"format" forall a b. (a -> b) -> a -> b
$ SEnv a
snv
          joinUpWith :: (SEnv a -> b -> a) -> [b] -> a
joinUpWith SEnv a -> b -> a
f [b]
xs = forall a b. Stringable a => SEnv a -> [b] -> (b -> a) -> a
mconcatMap' SEnv a
snv [b]
xs (SEnv a -> b -> a
f SEnv a
snv)
          showAssoc :: SEnv a -> ([Char], SElem a) -> a
showAssoc SEnv a
e ([Char]
k,SElem a
v) = [Char] -> a
stEncode ([Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
": ") forall a. Stringable a => a -> a -> a
`mlabel` forall a. Stringable a => SEnv a -> SElem a -> a
showVal SEnv a
e SElem a
v
          stEncode :: [Char] -> a
stEncode     = forall a. SEnv a -> a -> a
senc SEnv a
snv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => [Char] -> a
stFromString
          stEncodeBS :: ByteString -> a
stEncodeBS   = forall a. SEnv a -> a -> a
senc SEnv a
snv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => ByteString -> a
stFromByteString
          stEncodeText :: Text -> a
stEncodeText = forall a. SEnv a -> a -> a
senc SEnv a
snv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => Text -> a
stFromText

showStr :: Stringable a => String -> SEnv a -> a
showStr :: forall a. Stringable a => [Char] -> SEnv a -> a
showStr = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => [Char] -> a
stFromString

{--------------------------------------------------------------------
  Utility Combinators
--------------------------------------------------------------------}

justSTR :: String -> b -> SElem a
justSTR :: forall b a. [Char] -> b -> SElem a
justSTR = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> SElem a
STR
stshow :: STShow -> String
stshow :: STShow -> [Char]
stshow (STShow a
a) = forall a. StringTemplateShows a => a -> [Char]
stringTemplateShow a
a
stfshow :: Stringable a => SEnv a -> (SEnv a -> SElem a) -> STShow -> String
stfshow :: forall a.
Stringable a =>
SEnv a -> (SEnv a -> SElem a) -> STShow -> [Char]
stfshow SEnv a
snv SEnv a -> SElem a
fs (STShow a
a) = forall a. StringTemplateShows a => [Char] -> a -> [Char]
stringTemplateFormattedShow
                            (forall a. Stringable a => a -> [Char]
stToString forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> forall a. Stringable a => SEnv a -> SElem a -> a
showVal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SEnv a -> SElem a
fs forall a b. (a -> b) -> a -> b
$ SEnv a
snv) a
a

around :: Char -> GenParser Char st t -> Char -> GenParser Char st t
around :: forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
x GenParser Char st t
p Char
y = do {Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
x; t
v<-GenParser Char st t
p; Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
y; forall (m :: * -> *) a. Monad m => a -> m a
return t
v}
spaced :: GenParser Char st t -> GenParser Char st t
spaced :: forall st t. GenParser Char st t -> GenParser Char st t
spaced GenParser Char st t
p = do {forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces; t
v<-GenParser Char st t
p; forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces; forall (m :: * -> *) a. Monad m => a -> m a
return t
v}

identifierChar :: GenParser Char st Char
identifierChar :: forall st. GenParser Char st Char
identifierChar = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'

word :: GenParser Char st String
word :: forall st. GenParser Char st [Char]
word = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall st. GenParser Char st Char
identifierChar

comlist :: GenParser Char st a -> GenParser Char st [a]
comlist :: forall st a. GenParser Char st a -> GenParser Char st [a]
comlist GenParser Char st a
p = forall st t. GenParser Char st t -> GenParser Char st t
spaced (GenParser Char st a
p forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` forall st t. GenParser Char st t -> GenParser Char st t
spaced (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))

props :: Stringable a => TmplParser [SEnv a -> SElem a]
props :: forall a. Stringable a => TmplParser [SEnv a -> SElem a]
props = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'(' forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn Char
')' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall b a. [Char] -> b -> SElem a
justSTR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. GenParser Char st [Char]
word)

escapedChar, escapedStr :: String -> GenParser Char st String
escapedChar :: forall st. [Char] -> GenParser Char st [Char]
escapedChar [Char]
chs =
    forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
chs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'\\' then forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
y -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
y] else forall (m :: * -> *) a. Monad m => a -> m a
return [Char
x]
escapedStr :: forall st. [Char] -> GenParser Char st [Char]
escapedStr [Char]
chs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall st. [Char] -> GenParser Char st [Char]
escapedChar [Char]
chs)

{-
escapedStr' chs = dropTrailingBr <$> escapedStr chs
-}

{--------------------------------------------------------------------
  The Grammar
--------------------------------------------------------------------}
myConcat :: Stringable a => [SEnv a -> a] -> (SEnv a -> a)
myConcat :: forall a. Stringable a => [SEnv a -> a] -> SEnv a -> a
myConcat [SEnv a -> a]
xs SEnv a
a = forall a b. Stringable a => [b] -> (b -> a) -> a
mconcatMap [SEnv a -> a]
xs (forall a b. (a -> b) -> a -> b
$ SEnv a
a)


-- | if p is true, stmpl can fail gracefully, false it dies hard.
-- Set to false at the top level, and true within if expressions.
stmpl :: Stringable a => Bool -> TmplParser (SEnv a -> a)
stmpl :: forall a. Stringable a => Bool -> TmplParser (SEnv a -> a)
stmpl Bool
p = do
  (Char
ca, Char
cb) <- TmplParser (Char, Char)
getSeps
  forall a. Stringable a => [SEnv a -> a] -> SEnv a -> a
myConcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall a. Stringable a => [Char] -> SEnv a -> a
showStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. [Char] -> GenParser Char st [Char]
escapedStr [Char
ca] forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
ca forall a. Stringable a => TmplParser (SEnv a -> a)
optExpr Char
cb)
                    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> a)
comment forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TmplParser (SEnv a -> a)
bl forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"template")
      where bl :: TmplParser (SEnv a -> a)
bl | Bool
p = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> a)
blank | Bool
otherwise = forall a. Stringable a => TmplParser (SEnv a -> a)
blank

subStmp :: Stringable a => TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
subStmp :: forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
subStmp = do
  (Char
ca, Char
cb) <- TmplParser (Char, Char)
getSeps
  ([SElem a], [SElem a]) -> SEnv a -> SEnv a
udEnv <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall {a}. [[Char]] -> ([SElem a], [SElem a]) -> SEnv a -> SEnv a
transform [[Char]
"it"]) (forall {a}. [[Char]] -> ([SElem a], [SElem a]) -> SEnv a -> SEnv a
transform forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall {u}. ParsecT [Char] u Identity [[Char]]
attribNames)
  SEnv a -> a
st <- forall a. Stringable a => [SEnv a -> a] -> SEnv a -> a
myConcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall a. Stringable a => [Char] -> SEnv a -> a
showStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. [Char] -> GenParser Char st [Char]
escapedStr (Char
caforall a. a -> [a] -> [a]
:[Char]
"}|")
                         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
ca forall a. Stringable a => TmplParser (SEnv a -> a)
optExpr Char
cb)
                         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> a)
comment forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Stringable a => TmplParser (SEnv a -> a)
blank  forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"subtemplate")
  forall (m :: * -> *) a. Monad m => a -> m a
return (SEnv a -> a
st forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> ([SElem a], [SElem a]) -> SEnv a -> SEnv a
udEnv)
      where transform :: [[Char]] -> ([SElem a], [SElem a]) -> SEnv a -> SEnv a
transform [[Char]]
an ([SElem a]
att,[SElem a]
is) =
                forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. ([Char], SElem a) -> SEnv a -> SEnv a
envInsert) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip ([Char]
"i"forall a. a -> [a] -> [a]
:[Char]
"i0"forall a. a -> [a] -> [a]
:[[Char]]
an) ([SElem a]
isforall a. [a] -> [a] -> [a]
++[SElem a]
att)
            attribNames :: ParsecT [Char] u Identity [[Char]]
attribNames = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall st a. GenParser Char st a -> GenParser Char st [a]
comlist (forall st t. GenParser Char st t -> GenParser Char st t
spaced forall st. GenParser Char st [Char]
word)

comment :: Stringable a => TmplParser (SEnv a -> a)
comment :: forall a. Stringable a => TmplParser (SEnv a -> a)
comment = do
  (Char
ca, Char
cb) <- TmplParser (Char, Char)
getSeps
  [Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char
ca,Char
'!'] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string forall a b. (a -> b) -> a -> b
$ [Char
'!',Char
cb])
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Stringable a => [Char] -> SEnv a -> a
showStr [Char]
"")

blank :: Stringable a => TmplParser (SEnv a -> a)
blank :: forall a. Stringable a => TmplParser (SEnv a -> a)
blank = do
  (Char
ca, Char
cb) <- TmplParser (Char, Char)
getSeps
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ca
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
cb
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Stringable a => [Char] -> SEnv a -> a
showStr [Char]
"")

optExpr :: Stringable a => TmplParser (SEnv a -> a)
optExpr :: forall a. Stringable a => TmplParser (SEnv a -> a)
optExpr = do
  (Char
_, Char
cb) <- TmplParser (Char, Char)
getSeps
  (forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ([Char]
"else"forall a. [a] -> [a] -> [a]
++[Char
cb])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"elseif(") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"endif")) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
.>> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Malformed If Statement." forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  SEnv a -> a
expr <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> a)
ifstat forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall st t. GenParser Char st t -> GenParser Char st t
spaced forall a. Stringable a => TmplParser (SEnv a -> a)
exprn
  [([Char], SEnv a -> SElem a)]
opts <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  [([Char], SEnv a -> SElem a)]
optList) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SEnv a -> a
expr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [([Char], SEnv a -> SElem a)] -> SEnv a -> SEnv a
optInsert [([Char], SEnv a -> SElem a)]
opts
      where -- opt = around ';' (spaced word) '=' >>= (<$> spaced subexprn) . (,)
            optList :: ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  [([Char], SEnv a -> SElem a)]
optList = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  ([Char], SEnv a -> SElem a)
oneOpt (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
            oneOpt :: ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  ([Char], SEnv a -> SElem a)
oneOpt = do
              [Char]
o <- forall st t. GenParser Char st t -> GenParser Char st t
spaced forall st. GenParser Char st [Char]
word
              Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
              SEnv a -> SElem a
v <- forall st t. GenParser Char st t -> GenParser Char st t
spaced forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn
              forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
o,SEnv a -> SElem a
v)

{--------------------------------------------------------------------
  Statements
--------------------------------------------------------------------}

optLine :: TmplParser ()
optLine :: TmplParser ()
optLine = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\r') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')

--if env then do stuff
getProp :: Stringable a => [SEnv a -> SElem a] -> SElem a -> SEnv a -> SElem a
getProp :: forall a.
Stringable a =>
[SEnv a -> SElem a] -> SElem a -> SEnv a -> SElem a
getProp (SEnv a -> SElem a
p:[SEnv a -> SElem a]
ps) (SM SMap a
mp) SEnv a
env =
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. Stringable a => a -> [Char]
stToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => SEnv a -> SElem a -> a
showVal SEnv a
env forall a b. (a -> b) -> a -> b
$ SEnv a -> SElem a
p SEnv a
env) SMap a
mp of
    Just SElem a
prop -> forall a.
Stringable a =>
[SEnv a -> SElem a] -> SElem a -> SEnv a -> SElem a
getProp [SEnv a -> SElem a]
ps SElem a
prop SEnv a
env
    Maybe (SElem a)
Nothing -> case forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"throwException" SEnv a
env of
                 Just SEnv a -> SElem a
_ -> forall a e. Exception e => e -> a
C.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TmplException
NoAttrib forall a b. (a -> b) -> a -> b
$ [Char]
"yeek" --intercalate "." . map showIt $ (p:ps)
                 Maybe (SEnv a -> SElem a)
Nothing -> forall a. SElem a
SNull
  --where showIt x = stToString . showVal env $ x env
getProp (SEnv a -> SElem a
_:[SEnv a -> SElem a]
_) SElem a
_ SEnv a
_ = forall a. SElem a
SNull
getProp [SEnv a -> SElem a]
_ SElem a
se SEnv a
_ = SElem a
se

ifIsSet :: t -> t -> Bool -> SElem a -> t
ifIsSet :: forall t a. t -> t -> Bool -> SElem a -> t
ifIsSet t
t t
e Bool
n SElem a
SNull = if Bool
n then t
e else t
t
ifIsSet t
t t
e Bool
n SElem a
_ = if Bool
n then t
t else t
e

ifstat ::Stringable a => TmplParser (SEnv a -> a)
ifstat :: forall a. Stringable a => TmplParser (SEnv a -> a)
ifstat = do
  (Char
_, Char
cb) <- TmplParser (Char, Char)
getSeps
  [Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"if("
  Bool
n <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
True (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
  SEnv a -> SElem a
e <- forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn
  [SEnv a -> SElem a]
p <- forall a. Stringable a => TmplParser [SEnv a -> SElem a]
props
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
cb forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TmplParser ()
optLine
  SEnv a -> a
act <- forall a. Stringable a => Bool -> TmplParser (SEnv a -> a)
stmpl Bool
True
  SEnv a -> a
cont <- (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> a)
elseifstat forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> a)
elsestat forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Stringable a => TmplParser (SEnv a -> a)
endifstat)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall t a. t -> t -> Bool -> SElem a -> t
ifIsSet SEnv a -> a
act SEnv a -> a
cont Bool
n forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
Stringable a =>
[SEnv a -> SElem a] -> SElem a -> SEnv a -> SElem a
getProp [SEnv a -> SElem a]
p forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEnv a -> SElem a
e)

elseifstat ::Stringable a => TmplParser (SEnv a -> a)
elseifstat :: forall a. Stringable a => TmplParser (SEnv a -> a)
elseifstat = TmplParser (Char, Char)
getSeps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"else" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Stringable a => TmplParser (SEnv a -> a)
ifstat

elsestat ::Stringable a => TmplParser (SEnv a -> a)
elsestat :: forall a. Stringable a => TmplParser (SEnv a -> a)
elsestat = do
  (Char
ca, Char
cb) <- TmplParser (Char, Char)
getSeps
  [Char]
_ <- forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
ca (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"else") Char
cb
  TmplParser ()
optLine
  SEnv a -> a
act <- forall a. Stringable a => Bool -> TmplParser (SEnv a -> a)
stmpl Bool
True
  [Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ca forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"endif"
  forall (m :: * -> *) a. Monad m => a -> m a
return SEnv a -> a
act

endifstat ::Stringable a => TmplParser (SEnv a -> a)
endifstat :: forall a. Stringable a => TmplParser (SEnv a -> a)
endifstat = TmplParser (Char, Char)
getSeps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"endif" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Stringable a => [Char] -> SEnv a -> a
showStr [Char]
"")

{--------------------------------------------------------------------
  Expressions
--------------------------------------------------------------------}

exprn :: Stringable a => TmplParser (SEnv a -> a)
exprn :: forall a. Stringable a => TmplParser (SEnv a -> a)
exprn = do
  [SEnv a -> SElem a]
exprs <- forall st a. GenParser Char st a -> GenParser Char st [a]
comlist ( (forall a. a -> SElem a
SBLE forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'(' forall a. Stringable a => TmplParser (SEnv a -> a)
exprn Char
')')
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn)
             forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"expression"
  [[SElem a] -> SEnv a -> [a]]
templ <- ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  [[SElem a] -> SEnv a -> [a]]
tmplChain
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> ([a] -> b) -> [a] -> b
fromMany (forall a. Stringable a => SEnv a -> SElem a -> a
showVal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> a
head [SEnv a -> SElem a]
exprs)
             ((forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [SEnv a -> SElem a]
exprs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Stringable a =>
[[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> a
seqTmpls') [[SElem a] -> SEnv a -> [a]]
templ
      where tmplChain :: ParsecT
  [Char]
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  Identity
  [[SElem a] -> SEnv a -> [a]]
tmplChain = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a.
Stringable a =>
[([SElem a], [SElem a]) -> SEnv a -> a]
-> [SElem a] -> SEnv a -> [a]
iterApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st a. GenParser Char st a -> GenParser Char st [a]
comlist (forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
anonTmpl forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
regTemplate)) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"template call"

seqTmpls' :: Stringable a => [[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> a
seqTmpls' :: forall a.
Stringable a =>
[[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> a
seqTmpls' [[SElem a] -> SEnv a -> [a]]
tmpls [SElem a]
elems SEnv a
snv = forall a. Stringable a => a -> [a] -> a
mintercalate a
sep forall a b. (a -> b) -> a -> b
$ forall a.
Stringable a =>
[[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> [a]
seqTmpls [[SElem a] -> SEnv a -> [a]]
tmpls [SElem a]
elems SEnv a
snv
    where sep :: a
sep = forall a. Stringable a => SEnv a -> SElem a -> a
showVal SEnv a
snv forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall b a. [Char] -> b -> SElem a
justSTR [Char]
"") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [Char] -> SEnv a -> Maybe (SEnv a -> SElem a)
optLookup [Char]
"separator" forall a b. (a -> b) -> a -> b
$ SEnv a
snv

seqTmpls :: Stringable a => [[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> [a]
seqTmpls :: forall a.
Stringable a =>
[[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> [a]
seqTmpls [[SElem a] -> SEnv a -> [a]
f]    [SElem a]
y SEnv a
snv = [SElem a] -> SEnv a -> [a]
f [SElem a]
y SEnv a
snv
seqTmpls ([SElem a] -> SEnv a -> [a]
f:[[SElem a] -> SEnv a -> [a]]
fs) [SElem a]
y SEnv a
snv = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[SElem a]
x -> forall a.
Stringable a =>
[[SElem a] -> SEnv a -> [a]] -> [SElem a] -> SEnv a -> [a]
seqTmpls [[SElem a] -> SEnv a -> [a]]
fs [SElem a]
x SEnv a
snv) (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> SElem a
SBLE) forall a b. (a -> b) -> a -> b
$ [SElem a] -> SEnv a -> [a]
f [SElem a]
y SEnv a
snv)
seqTmpls  [[SElem a] -> SEnv a -> [a]]
_ [SElem a]
_ SEnv a
_   = [forall a. Stringable a => [Char] -> a
stFromString [Char]
""]

subexprn :: Stringable a => TmplParser (SEnv a -> SElem a)
subexprn :: forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn = forall {t1}.
Stringable t1 =>
[SEnv t1 -> SElem t1] -> SEnv t1 -> SElem t1
cct forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st t. GenParser Char st t -> GenParser Char st t
spaced
            (forall a. Stringable a => TmplParser (SEnv a -> SElem a)
braceConcat
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. a -> SElem a
SBLE forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> (forall a b. (a -> b) -> a -> b
$ ([forall a. SElem a
SNull],forall a. [SElem a]
ix0)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
regTemplate
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Stringable a => TmplParser (SEnv a -> SElem a)
attrib
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. a -> SElem a
SBLE forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> (forall a b. (a -> b) -> a -> b
$ ([forall a. SElem a
SNull],forall a. [SElem a]
ix0)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
anonTmpl
             forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"expression")
           forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` forall st t. GenParser Char st t -> GenParser Char st t
spaced (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')
    where cct :: [SEnv t1 -> SElem t1] -> SEnv t1 -> SElem t1
cct xs :: [SEnv t1 -> SElem t1]
xs@(SEnv t1 -> SElem t1
_:SEnv t1 -> SElem t1
_:[SEnv t1 -> SElem t1]
_) = forall a. a -> SElem a
SBLE forall b c a. (b -> c) -> (a -> b) -> a -> c
|.
                           forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Stringable a => [b] -> (b -> a) -> a
mconcatMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Stringable a => SEnv a -> SElem a -> a
showVal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [SEnv t1 -> SElem t1]
xs
          cct [SEnv t1 -> SElem t1
x] = SEnv t1 -> SElem t1
x
          cct  [SEnv t1 -> SElem t1]
_  = forall a b. a -> b -> a
const forall a. SElem a
SNull

braceConcat :: Stringable a => TmplParser (SEnv a -> SElem a)
braceConcat :: forall a. Stringable a => TmplParser (SEnv a -> SElem a)
braceConcat = forall a. [SElem a] -> SElem a
LI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. SElem a -> [SElem a] -> [SElem a]
go [] forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'['(forall st a. GenParser Char st a -> GenParser Char st [a]
comlist forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn)Char
']'
    where go :: SElem a -> [SElem a] -> [SElem a]
go (LI [SElem a]
x) [SElem a]
lst = [SElem a]
xforall a. [a] -> [a] -> [a]
++[SElem a]
lst; go SElem a
x [SElem a]
lst = SElem a
xforall a. a -> [a] -> [a]
:[SElem a]
lst

literal :: GenParser Char st (b -> SElem a)
literal :: forall st b a. GenParser Char st (b -> SElem a)
literal = forall b a. [Char] -> b -> SElem a
justSTR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'"' (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall st. [Char] -> GenParser Char st [Char]
escapedChar [Char]
"\"")) Char
'"'
                   forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'\'' (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall st. [Char] -> GenParser Char st [Char]
escapedChar [Char]
"'")) Char
'\'')

attrib :: Stringable a => TmplParser (SEnv a -> SElem a)
attrib :: forall a. Stringable a => TmplParser (SEnv a -> SElem a)
attrib = do
  SEnv a -> SElem a
a <-     forall st b a. GenParser Char st (b -> SElem a)
literal
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Stringable a => TmplParser (SEnv a -> SElem a)
functn
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. [Char] -> SEnv a -> SElem a
envLookupEx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  [Char] ((Char, Char), [[Char]], [[Char]], [[Char]]) Identity [Char]
regWord
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. [Char] -> SEnv a -> SElem a
envLookupEx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  [Char] ((Char, Char), [[Char]], [[Char]], [[Char]]) Identity [Char]
qqWord
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'(' forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn Char
')'
          forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"attribute"
  [SEnv a -> SElem a]
proprs <- forall a. Stringable a => TmplParser [SEnv a -> SElem a]
props
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> ([a] -> b) -> [a] -> b
fromMany SEnv a -> SElem a
a ((SEnv a -> SElem a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Stringable a =>
[SEnv a -> SElem a] -> SElem a -> SEnv a -> SElem a
getProp) [SEnv a -> SElem a]
proprs
      where qqWord :: ParsecT
  [Char] ((Char, Char), [[Char]], [[Char]], [[Char]]) Identity [Char]
qqWord = do
              [Char]
w <- forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'`' forall st. GenParser Char st [Char]
word Char
'`'
              [Char] -> TmplParser ()
tellQQ [Char]
w
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'`' forall a. a -> [a] -> [a]
: [Char]
w forall a. [a] -> [a] -> [a]
++ [Char]
"`"
            regWord :: ParsecT
  [Char] ((Char, Char), [[Char]], [[Char]], [[Char]]) Identity [Char]
regWord = do
              [Char]
w <- forall st. GenParser Char st [Char]
word
              [Char] -> TmplParser ()
tellName [Char]
w
              forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
w

--add null func
functn :: Stringable a => TmplParser (SEnv a -> SElem a)
functn :: forall a. Stringable a => TmplParser (SEnv a -> SElem a)
functn = do
  [Char]
f <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"first" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"rest") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"reverse"
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"strip"
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"length") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"last" forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"function"
  (forall {a}. [Char] -> SElem a -> SElem a
fApply [Char]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'(' forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn Char
')'
      where fApply :: [Char] -> SElem a -> SElem a
fApply [Char]
str (LI [SElem a]
xs)
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"first"  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SElem a]
xs then forall a. SElem a
SNull else forall a. [a] -> a
head [SElem a]
xs
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"last"   = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SElem a]
xs then forall a. SElem a
SNull else forall a. [a] -> a
last [SElem a]
xs
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"rest"   = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SElem a]
xs then forall a. SElem a
SNull else (forall a. [SElem a] -> SElem a
LI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) [SElem a]
xs
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" = forall a. [SElem a] -> SElem a
LI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [SElem a]
xs
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"strip"  = forall a. [SElem a] -> SElem a
LI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. SElem a -> Bool
liNil) forall a b. (a -> b) -> a -> b
$ [SElem a]
xs
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"length" = forall a. [Char] -> SElem a
STR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [SElem a]
xs
            fApply [Char]
str SElem a
x
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"rest"   = forall a. [SElem a] -> SElem a
LI []
                | [Char]
str forall a. Eq a => a -> a -> Bool
== [Char]
"length" = forall a. [Char] -> SElem a
STR [Char]
"1"
                | Bool
otherwise       = SElem a
x
            liNil :: SElem a -> Bool
liNil (LI [SElem a]
x) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SElem a]
x
            liNil SElem a
_      = Bool
False

{--------------------------------------------------------------------
  Templates
--------------------------------------------------------------------}
--change makeTmpl to do notation for clarity?



mkIndex :: (Num b, Show b) => [b] -> [[SElem a]]
mkIndex :: forall b a. (Num b, Show b) => [b] -> [[SElem a]]
mkIndex = forall a b. (a -> b) -> [a] -> [b]
map ((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> SElem a
STR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b
1forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> SElem a
STR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show)
ix0 :: [SElem a]
ix0 :: forall a. [SElem a]
ix0 = [forall a. [Char] -> SElem a
STR [Char]
"1",forall a. [Char] -> SElem a
STR [Char]
"0"]

cycleApp :: (Stringable a) => [([SElem a], [SElem a]) -> SEnv a -> a] -> [([SElem a], [SElem a])]  -> SEnv a -> [a]
cycleApp :: forall a.
Stringable a =>
[([SElem a], [SElem a]) -> SEnv a -> a]
-> [([SElem a], [SElem a])] -> SEnv a -> [a]
cycleApp [([SElem a], [SElem a]) -> SEnv a -> a]
x [([SElem a], [SElem a])]
y SEnv a
snv = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ SEnv a
snv) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. (a -> b) -> a -> b
($) (forall a. [a] -> [a]
cycle [([SElem a], [SElem a]) -> SEnv a -> a]
x) [([SElem a], [SElem a])]
y)

pluslen :: [a] -> [([a], [SElem b])]
pluslen :: forall a b. [a] -> [([a], [SElem b])]
pluslen [a]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [a]
xs) forall a b. (a -> b) -> a -> b
$ forall b a. (Num b, Show b) => [b] -> [[SElem a]]
mkIndex [Int
0..(forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)]

liTrans :: [SElem a] -> [([SElem a], [SElem a])]
liTrans :: forall a. [SElem a] -> [([SElem a], [SElem a])]
liTrans = forall {a} {a}. [a] -> [(a, [SElem a])]
pluslen' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [[a]] -> [[a]]
paddedTrans forall a. SElem a
SNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. SElem a -> [SElem a]
u
    where u :: SElem a -> [SElem a]
u (LI [SElem a]
x) = [SElem a]
x; u SElem a
x = [SElem a
x]
          pluslen' :: [a] -> [(a, [SElem a])]
pluslen' [a]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs forall a b. (a -> b) -> a -> b
$ forall b a. (Num b, Show b) => [b] -> [[SElem a]]
mkIndex [Int
0..(forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)]

--map repeatedly, then finally concat
iterApp :: Stringable a => [([SElem a], [SElem a]) -> SEnv a -> a] -> [SElem a] -> SEnv a -> [a]
iterApp :: forall a.
Stringable a =>
[([SElem a], [SElem a]) -> SEnv a -> a]
-> [SElem a] -> SEnv a -> [a]
iterApp [([SElem a], [SElem a]) -> SEnv a -> a
f] (LI [SElem a]
xs:[])    SEnv a
snv = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip ([SElem a], [SElem a]) -> SEnv a -> a
f SEnv a
snv) (forall a b. [a] -> [([a], [SElem b])]
pluslen [SElem a]
xs)
iterApp [([SElem a], [SElem a]) -> SEnv a -> a
f] vars :: [SElem a]
vars@(LI [SElem a]
_:[SElem a]
_) SEnv a
snv = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip ([SElem a], [SElem a]) -> SEnv a -> a
f SEnv a
snv) (forall a. [SElem a] -> [([SElem a], [SElem a])]
liTrans [SElem a]
vars)
iterApp [([SElem a], [SElem a]) -> SEnv a -> a
f] [SElem a]
v             SEnv a
snv = [([SElem a], [SElem a]) -> SEnv a -> a
f ([SElem a]
v,forall a. [SElem a]
ix0) SEnv a
snv]
iterApp [([SElem a], [SElem a]) -> SEnv a -> a]
fs (LI [SElem a]
xs:[])     SEnv a
snv = forall a.
Stringable a =>
[([SElem a], [SElem a]) -> SEnv a -> a]
-> [([SElem a], [SElem a])] -> SEnv a -> [a]
cycleApp [([SElem a], [SElem a]) -> SEnv a -> a]
fs (forall a b. [a] -> [([a], [SElem b])]
pluslen [SElem a]
xs) SEnv a
snv
iterApp [([SElem a], [SElem a]) -> SEnv a -> a]
fs vars :: [SElem a]
vars@(LI [SElem a]
_:[SElem a]
_)  SEnv a
snv = forall a.
Stringable a =>
[([SElem a], [SElem a]) -> SEnv a -> a]
-> [([SElem a], [SElem a])] -> SEnv a -> [a]
cycleApp [([SElem a], [SElem a]) -> SEnv a -> a]
fs (forall a. [SElem a] -> [([SElem a], [SElem a])]
liTrans [SElem a]
vars) SEnv a
snv
iterApp [([SElem a], [SElem a]) -> SEnv a -> a]
fs [SElem a]
xs             SEnv a
snv = forall a.
Stringable a =>
[([SElem a], [SElem a]) -> SEnv a -> a]
-> [([SElem a], [SElem a])] -> SEnv a -> [a]
cycleApp [([SElem a], [SElem a]) -> SEnv a -> a]
fs (forall a b. [a] -> [([a], [SElem b])]
pluslen [SElem a]
xs) SEnv a
snv

anonTmpl :: Stringable a => TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
anonTmpl :: forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
anonTmpl = forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'{' forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
subStmp Char
'}'

regTemplate :: Stringable a => TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
regTemplate :: forall a.
Stringable a =>
TmplParser (([SElem a], [SElem a]) -> SEnv a -> a)
regTemplate = do
  forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. Stringable a => TmplParser (SEnv a -> SElem a)
functn::TmplParser (SEnv String -> SElem String)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
.>> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  SEnv a -> SElem a
name <- forall b a. [Char] -> b -> SElem a
justSTR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall st. GenParser Char st Char
identifierChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/')
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'(' forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn Char
')'
  forall {a}. SElem a -> TmplParser ()
tryTellTmpl (SEnv a -> SElem a
name forall a. SEnv a
nullEnv)
  [([Char], SEnv a -> SElem a)]
vals <- forall st t.
Char -> GenParser Char st t -> Char -> GenParser Char st t
around Char
'(' (forall st t. GenParser Char st t -> GenParser Char st t
spaced forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser
  Char
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  [([Char], SEnv a -> SElem a)]
assgn forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser
  Char
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  [([Char], SEnv a -> SElem a)]
anonassgn forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []) Char
')'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEnv a -> SElem a
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t2} {a}.
Stringable t2 =>
[([Char], SEnv t2 -> SElem t2)]
-> ([SElem t2], [SElem t2]) -> SElem a -> SEnv t2 -> t2
makeTmpl [([Char], SEnv a -> SElem a)]
vals
      where makeTmpl :: [([Char], SEnv t2 -> SElem t2)]
-> ([SElem t2], [SElem t2]) -> SElem a -> SEnv t2 -> t2
makeTmpl [([Char], SEnv t2 -> SElem t2)]
v ((SElem t2
se:[SElem t2]
_),[SElem t2]
is) (STR [Char]
x)  =
                forall a. Stringable a => [Char] -> StringTemplate a -> a
renderErr [Char]
x forall b c a. (b -> c) -> (a -> b) -> a -> c
|. forall {t :: * -> *} {a}.
Foldable t =>
t ([Char], SElem a) -> StringTemplate a -> StringTemplate a
stBind forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]
"it",[Char]
"i",[Char]
"i0"] (SElem t2
seforall a. a -> [a] -> [a]
:[SElem t2]
is) forall a. [a] -> [a] -> [a]
++)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c1 b c. (((a -> c1) -> c1) -> b -> c) -> b -> a -> c
swing (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second) [([Char], SEnv t2 -> SElem t2)]
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Stringable a => [Char] -> SEnv a -> StringTemplate a
stLookup [Char]
x
            makeTmpl [([Char], SEnv t2 -> SElem t2)]
_ ([SElem t2], [SElem t2])
_ SElem a
_ = forall a. Stringable a => [Char] -> SEnv a -> a
showStr [Char]
"Invalid Template Specified"
            stBind :: t ([Char], SElem a) -> StringTemplate a -> StringTemplate a
stBind t ([Char], SElem a)
v StringTemplate a
st = StringTemplate a
st {senv :: SEnv a
senv = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. ([Char], SElem a) -> SEnv a -> SEnv a
envInsert (forall a. StringTemplate a -> SEnv a
senv StringTemplate a
st) t ([Char], SElem a)
v}
            anonassgn :: GenParser
  Char
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  [([Char], SEnv a -> SElem a)]
anonassgn = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [Char]
"it" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn
            assgn :: GenParser
  Char
  ((Char, Char), [[Char]], [[Char]], [[Char]])
  [([Char], SEnv a -> SElem a)]
assgn = (forall st t. GenParser Char st t -> GenParser Char st t
spaced forall st. GenParser Char st [Char]
word forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
.>> forall st t. GenParser Char st t -> GenParser Char st t
spaced forall a. Stringable a => TmplParser (SEnv a -> SElem a)
subexprn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))
                    forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy1` forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
            tryTellTmpl :: SElem a -> TmplParser ()
tryTellTmpl (STR [Char]
x) = [Char] -> TmplParser ()
tellTmpl [Char]
x
            tryTellTmpl SElem a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

--DEBUG

{-pTrace s = pt <|> return ()
    where pt = try $
               do
                 x <- try $ many1 anyChar
                 trace (s++": " ++x) $ try $ char 'z'
                 fail x
-}