{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Heist.Common where
import Control.Applicative (Alternative (..))
import Control.Exception (SomeException)
import qualified Control.Exception.Lifted as C
import Control.Monad (liftM, mplus)
import qualified Data.Attoparsec.Text as AP
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.List (isSuffixOf, sort)
import Data.Map.Syntax
import Data.Maybe (isJust)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Heist.Internal.Types.HeistState
import System.FilePath (pathSeparator)
import qualified Text.XmlHtml as X
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
import Data.Monoid (Monoid (..))
#endif
runHashMap
:: Splices s
-> Either [String] (HashMap T.Text s)
runHashMap :: forall s. Splices s -> Either [[Char]] (HashMap Text s)
runHashMap Splices s
ms =
case (Text -> HashMap Text s -> Maybe s)
-> (Text -> s -> HashMap Text s -> HashMap Text s)
-> Splices s
-> Either [Text] (HashMap Text s)
forall map k v a.
Monoid map =>
(k -> map -> Maybe v)
-> (k -> v -> map -> map) -> MapSyntaxM k v a -> Either [k] map
runMapSyntax Text -> HashMap Text s -> Maybe s
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text -> s -> HashMap Text s -> HashMap Text s
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Splices s
ms of
Left [Text]
keys -> [[Char]] -> Either [[Char]] (HashMap Text s)
forall a b. a -> Either a b
Left ([[Char]] -> Either [[Char]] (HashMap Text s))
-> [[Char]] -> Either [[Char]] (HashMap Text s)
forall a b. (a -> b) -> a -> b
$ (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
mkMsg) [Text]
keys
Right HashMap Text s
hm -> HashMap Text s -> Either [[Char]] (HashMap Text s)
forall a b. b -> Either a b
Right HashMap Text s
hm
where
mkMsg :: a -> a
mkMsg a
k = a
"You tried to bind "a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
ka -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
" more than once!"
runMapNoErrors :: (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v
runMapNoErrors :: forall k v a. (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v
runMapNoErrors = ([k] -> HashMap k v)
-> (HashMap k v -> HashMap k v)
-> Either [k] (HashMap k v)
-> HashMap k v
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HashMap k v -> [k] -> HashMap k v
forall a b. a -> b -> a
const HashMap k v
forall a. Monoid a => a
mempty) HashMap k v -> HashMap k v
forall a. a -> a
id (Either [k] (HashMap k v) -> HashMap k v)
-> (MapSyntaxM k v a -> Either [k] (HashMap k v))
-> MapSyntaxM k v a
-> HashMap k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(k -> v -> v -> Maybe v)
-> (k -> HashMap k v -> Maybe v)
-> (k -> v -> HashMap k v -> HashMap k v)
-> MapSyntaxM k v a
-> Either [k] (HashMap k v)
forall map k v a.
Monoid map =>
(k -> v -> v -> Maybe v)
-> (k -> map -> Maybe v)
-> (k -> v -> map -> map)
-> MapSyntaxM k v a
-> Either [k] map
runMapSyntax' (\k
_ v
new v
_ -> v -> Maybe v
forall a. a -> Maybe a
Just v
new) k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert
applySpliceMap :: HeistState n
-> (HeistState n -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
applySpliceMap :: forall (n :: * -> *) v a.
HeistState n
-> (HeistState n -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
applySpliceMap HeistState n
hs HeistState n -> HashMap Text v
f = ((HashMap Text v -> HashMap Text v -> HashMap Text v)
-> HashMap Text v -> HashMap Text v -> HashMap Text v
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap Text v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
Map.union (HeistState n -> HashMap Text v
f HeistState n
hs)) (HashMap Text v -> HashMap Text v)
-> (MapSyntaxM Text v a -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
MapSyntaxM Text v () -> HashMap Text v
forall k v a. (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v
runMapNoErrors (MapSyntaxM Text v () -> HashMap Text v)
-> (MapSyntaxM Text v a -> MapSyntaxM Text v ())
-> MapSyntaxM Text v a
-> HashMap Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Text -> Text) -> MapSyntaxM Text v a -> MapSyntaxM Text v ()
forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
pre)
where
pre :: Text
pre = HeistState n -> Text
forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
hs
orError :: Monad m => HeistT n m b -> String -> HeistT n m b
orError :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
HeistT n m b -> [Char] -> HeistT n m b
orError HeistT n m b
silent [Char]
msg = do
HeistState n
hs <- HeistT n m (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
if HeistState n -> Bool
forall (m :: * -> *). HeistState m -> Bool
_preprocessingMode HeistState n
hs
then do Text
fullMsg <- Text -> HeistT n m Text
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Text
heistErrMsg ([Char] -> Text
T.pack [Char]
msg)
[Char] -> HeistT n m b
forall a. HasCallStack => [Char] -> a
error ([Char] -> HeistT n m b) -> [Char] -> HeistT n m b
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
fullMsg
else HeistT n m b
silent
heistErrMsg :: Monad m => Text -> HeistT n m Text
heistErrMsg :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Text
heistErrMsg Text
msg = do
Maybe [Char]
tf <- (HeistState n -> Maybe [Char]) -> HeistT n m (Maybe [Char])
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> Maybe [Char]
forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile
Text -> HeistT n m Text
forall a. a -> HeistT n m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HeistT n m Text) -> Text -> HeistT n m Text
forall a b. (a -> b) -> a -> b
$ (Text -> ([Char] -> Text) -> Maybe [Char] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
": ") (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Maybe [Char]
tf) Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
msg
tellSpliceError :: Monad m => Text -> HeistT n m ()
tellSpliceError :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m ()
tellSpliceError Text
msg = do
HeistState n
hs <- HeistT n m (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
Node
node <- HeistT n m Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
let spliceError :: SpliceError
spliceError = SpliceError
{ spliceHistory :: [(TPath, Maybe [Char], Text)]
spliceHistory = HeistState n -> [(TPath, Maybe [Char], Text)]
forall (m :: * -> *). HeistState m -> [(TPath, Maybe [Char], Text)]
_splicePath HeistState n
hs
, spliceTemplateFile :: Maybe [Char]
spliceTemplateFile = HeistState n -> Maybe [Char]
forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile HeistState n
hs
, visibleSplices :: [Text]
visibleSplices = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HashMap Text (HeistT n IO (DList (Chunk n))) -> [Text]
forall k v. HashMap k v -> [k]
Map.keys (HashMap Text (HeistT n IO (DList (Chunk n))) -> [Text])
-> HashMap Text (HeistT n IO (DList (Chunk n))) -> [Text]
forall a b. (a -> b) -> a -> b
$ HeistState n -> HashMap Text (HeistT n IO (DList (Chunk n)))
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap HeistState n
hs
, contextNode :: Node
contextNode = Node
node
, spliceMsg :: Text
spliceMsg = Text
msg
}
(HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
hs' -> HeistState n
hs { _spliceErrors :: [SpliceError]
_spliceErrors = SpliceError
spliceError SpliceError -> [SpliceError] -> [SpliceError]
forall a. a -> [a] -> [a]
: HeistState n -> [SpliceError]
forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors HeistState n
hs' })
showTPath :: TPath -> String
showTPath :: TPath -> [Char]
showTPath = ByteString -> [Char]
BC.unpack (ByteString -> [Char]) -> (TPath -> ByteString) -> TPath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
`BC.append` ByteString
".tpl") (ByteString -> ByteString)
-> (TPath -> ByteString) -> TPath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPath -> ByteString
tpathName
tpathName :: TPath -> ByteString
tpathName :: TPath -> ByteString
tpathName = ByteString -> TPath -> ByteString
BC.intercalate ByteString
"/" (TPath -> ByteString) -> (TPath -> TPath) -> TPath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPath -> TPath
forall a. [a] -> [a]
reverse
setCurTemplateFile :: Maybe FilePath -> HeistState n -> HeistState n
setCurTemplateFile :: forall (n :: * -> *). Maybe [Char] -> HeistState n -> HeistState n
setCurTemplateFile Maybe [Char]
Nothing HeistState n
ts = HeistState n
ts
setCurTemplateFile Maybe [Char]
fp HeistState n
ts = HeistState n
ts { _curTemplateFile :: Maybe [Char]
_curTemplateFile = Maybe [Char]
fp }
setCurContext :: TPath -> HeistState n -> HeistState n
setCurContext :: forall (n :: * -> *). TPath -> HeistState n -> HeistState n
setCurContext TPath
tp HeistState n
ts = HeistState n
ts { _curContext :: TPath
_curContext = TPath
tp }
attParser :: AP.Parser [AttAST]
attParser :: Parser [AttAST]
attParser = (([AttAST] -> [AttAST]) -> [AttAST])
-> Parser Text ([AttAST] -> [AttAST]) -> Parser [AttAST]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([AttAST] -> [AttAST]) -> [AttAST] -> [AttAST]
forall a b. (a -> b) -> a -> b
$! []) (([AttAST] -> [AttAST]) -> Parser Text ([AttAST] -> [AttAST])
forall {c}. ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
loop [AttAST] -> [AttAST]
forall a. a -> a
id)
where
append :: ([a] -> c) -> a -> [a] -> c
append ![a] -> c
dl !a
x = [a] -> c
dl ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
loop :: ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
loop ![AttAST] -> c
dl = ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
go [Text] -> [Text]
forall a. a -> a
id
where
finish :: ([a] -> [Text]) -> m ([AttAST] -> c)
finish [a] -> [Text]
subDL = let !txt :: Text
txt = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$! [a] -> [Text]
subDL []
lit :: AttAST
lit = Text -> AttAST
Literal (Text -> AttAST) -> Text -> AttAST
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$! [a] -> [Text]
subDL []
in ([AttAST] -> c) -> m ([AttAST] -> c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (([AttAST] -> c) -> m ([AttAST] -> c))
-> ([AttAST] -> c) -> m ([AttAST] -> c)
forall a b. (a -> b) -> a -> b
$! if Text -> Bool
T.null Text
txt
then [AttAST] -> c
dl
else ([AttAST] -> c) -> AttAST -> [AttAST] -> c
forall {a} {c}. ([a] -> c) -> a -> [a] -> c
append [AttAST] -> c
dl AttAST
lit
go :: ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
go ![Text] -> [Text]
subDL = (Parser Text
gobbleText Parser Text
-> (Text -> Parser Text ([AttAST] -> c))
-> Parser Text ([AttAST] -> c)
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
go (([Text] -> [Text]) -> Parser Text ([AttAST] -> c))
-> (Text -> [Text] -> [Text])
-> Text
-> Parser Text ([AttAST] -> c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text]) -> Text -> [Text] -> [Text]
forall {a} {c}. ([a] -> c) -> a -> [a] -> c
append [Text] -> [Text]
subDL)
Parser Text ([AttAST] -> c)
-> Parser Text ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text ()
forall t. Chunk t => Parser t ()
AP.endOfInput Parser Text ()
-> Parser Text ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
forall {m :: * -> *} {a}.
Monad m =>
([a] -> [Text]) -> m ([AttAST] -> c)
finish [Text] -> [Text]
subDL)
Parser Text ([AttAST] -> c)
-> Parser Text ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
AttAST
idp <- Parser Text AttAST
identParser
[AttAST] -> c
dl' <- ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
forall {m :: * -> *} {a}.
Monad m =>
([a] -> [Text]) -> m ([AttAST] -> c)
finish [Text] -> [Text]
subDL
([AttAST] -> c) -> Parser Text ([AttAST] -> c)
loop (([AttAST] -> c) -> Parser Text ([AttAST] -> c))
-> ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
forall a b. (a -> b) -> a -> b
$! ([AttAST] -> c) -> AttAST -> [AttAST] -> c
forall {a} {c}. ([a] -> c) -> a -> [a] -> c
append [AttAST] -> c
dl' AttAST
idp)
gobbleText :: Parser Text
gobbleText = (Char -> Bool) -> Parser Text
AP.takeWhile1 ([Char] -> Char -> Bool
AP.notInClass [Char]
"$")
identParser :: Parser Text AttAST
identParser = Char -> Parser Char
AP.char Char
'$' Parser Char -> Parser Text AttAST -> Parser Text AttAST
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text AttAST
ident Parser Text AttAST -> Parser Text AttAST -> Parser Text AttAST
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AttAST -> Parser Text AttAST
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AttAST
Literal Text
"$"))
ident :: Parser Text AttAST
ident = (Char -> Parser Char
AP.char Char
'{' Parser Char -> Parser Text AttAST -> Parser Text AttAST
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> AttAST
Ident (Text -> AttAST) -> Parser Text -> Parser Text AttAST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
AP.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}')) Parser Text AttAST -> Parser Text -> Parser Text AttAST
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
AP.string Text
"}")
splitPathWith :: Char -> ByteString -> TPath
splitPathWith :: Char -> ByteString -> TPath
splitPathWith Char
s ByteString
p = if ByteString -> Bool
BC.null ByteString
p then [] else (TPath -> TPath
forall a. [a] -> [a]
reverse (TPath -> TPath) -> TPath -> TPath
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> TPath
BC.split Char
s ByteString
path)
where
path :: ByteString
path = if ByteString -> Char
BC.head ByteString
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
s then HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BC.tail ByteString
p else ByteString
p
splitLocalPath :: ByteString -> TPath
splitLocalPath :: ByteString -> TPath
splitLocalPath = Char -> ByteString -> TPath
splitPathWith Char
pathSeparator
splitTemplatePath :: ByteString -> TPath
splitTemplatePath :: ByteString -> TPath
splitTemplatePath = Char -> ByteString -> TPath
splitPathWith Char
'/'
lookupTemplate :: ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate :: forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
nameStr HeistState n
ts HeistState n -> HashMap TPath t
tm = HashMap TPath t -> TPath -> ByteString -> Maybe (t, TPath)
forall {a} {t}.
Hashable a =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
f (HeistState n -> HashMap TPath t
tm HeistState n
ts) TPath
path ByteString
name
where
(ByteString
name, TPath
p) = case ByteString -> TPath
splitTemplatePath ByteString
nameStr of
[] -> (ByteString
"", [])
ByteString
x:TPath
xs -> (ByteString
x, TPath
xs)
ctx :: TPath
ctx = if ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
"/" ByteString
nameStr then [] else HeistState n -> TPath
forall (m :: * -> *). HeistState m -> TPath
_curContext HeistState n
ts
path :: TPath
path = TPath
p TPath -> TPath -> TPath
forall a. [a] -> [a] -> [a]
++ TPath
ctx
f :: HashMap [a] t -> [a] -> a -> Maybe (t, [a])
f = if Char
'/' Char -> ByteString -> Bool
`BC.elem` ByteString
nameStr
then HashMap [a] t -> [a] -> a -> Maybe (t, [a])
forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
singleLookup
else HashMap [a] t -> [a] -> a -> Maybe (t, [a])
forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
traversePath
hasTemplate :: ByteString -> HeistState n -> Bool
hasTemplate :: forall (n :: * -> *). ByteString -> HeistState n -> Bool
hasTemplate ByteString
nameStr HeistState n
ts =
Maybe (DocumentFile, TPath) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (DocumentFile, TPath) -> Bool)
-> Maybe (DocumentFile, TPath) -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath DocumentFile)
-> Maybe (DocumentFile, TPath)
forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
nameStr HeistState n
ts HeistState n -> HashMap TPath DocumentFile
forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap
singleLookup :: (Eq a, Hashable a)
=> HashMap [a] t -> [a] -> a -> Maybe (t, [a])
singleLookup :: forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
singleLookup HashMap [a] t
tm [a]
path a
name = (t -> (t, [a])) -> Maybe t -> Maybe (t, [a])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
a -> (t
a,[a]
path)) (Maybe t -> Maybe (t, [a])) -> Maybe t -> Maybe (t, [a])
forall a b. (a -> b) -> a -> b
$ [a] -> HashMap [a] t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (a
namea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
path) HashMap [a] t
tm
traversePath :: (Eq a, Hashable a)
=> HashMap [a] t -> [a] -> a -> Maybe (t, [a])
traversePath :: forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
traversePath HashMap [a] t
tm [] a
name = (t -> (t, [a])) -> Maybe t -> Maybe (t, [a])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
a -> (t
a,[])) ([a] -> HashMap [a] t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup [a
name] HashMap [a] t
tm)
traversePath HashMap [a] t
tm [a]
path a
name =
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
singleLookup HashMap [a] t
tm [a]
path a
name Maybe (t, [a]) -> Maybe (t, [a]) -> Maybe (t, [a])
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
traversePath HashMap [a] t
tm ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
path) a
name
mapSplices :: (Monad m, Monoid b)
=> (a -> m b)
-> [a]
-> m b
mapSplices :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mapSplices a -> m b
f [a]
vs = ([b] -> b) -> m [b] -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [b] -> b
forall a. Monoid a => [a] -> a
mconcat (m [b] -> m b) -> m [b] -> m b
forall a b. (a -> b) -> a -> b
$ (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m b
f [a]
vs
{-# INLINE mapSplices #-}
getContext :: Monad m => HeistT n m TPath
getContext :: forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m TPath
getContext = (HeistState n -> TPath) -> HeistT n m TPath
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> TPath
forall (m :: * -> *). HeistState m -> TPath
_curContext
getTemplateFilePath :: Monad m => HeistT n m (Maybe FilePath)
getTemplateFilePath :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (Maybe [Char])
getTemplateFilePath = (HeistState n -> Maybe [Char]) -> HeistT n m (Maybe [Char])
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> Maybe [Char]
forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile
loadTemplate :: String
-> String
-> IO [Either String (TPath, DocumentFile)]
loadTemplate :: [Char] -> [Char] -> IO [Either [Char] (TPath, DocumentFile)]
loadTemplate [Char]
templateRoot [Char]
fname = do
[Either [Char] DocumentFile]
c <- [Char] -> IO [Either [Char] DocumentFile]
loadTemplate' [Char]
fname
[Either [Char] (TPath, DocumentFile)]
-> IO [Either [Char] (TPath, DocumentFile)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either [Char] (TPath, DocumentFile)]
-> IO [Either [Char] (TPath, DocumentFile)])
-> [Either [Char] (TPath, DocumentFile)]
-> IO [Either [Char] (TPath, DocumentFile)]
forall a b. (a -> b) -> a -> b
$ (Either [Char] DocumentFile -> Either [Char] (TPath, DocumentFile))
-> [Either [Char] DocumentFile]
-> [Either [Char] (TPath, DocumentFile)]
forall a b. (a -> b) -> [a] -> [b]
map ((DocumentFile -> (TPath, DocumentFile))
-> Either [Char] DocumentFile
-> Either [Char] (TPath, DocumentFile)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DocumentFile
t -> (ByteString -> TPath
splitLocalPath (ByteString -> TPath) -> ByteString -> TPath
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BC.pack [Char]
tName, DocumentFile
t))) [Either [Char] DocumentFile]
c
where
isHTMLTemplate :: Bool
isHTMLTemplate = [Char]
".tpl" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
fname
correction :: a
correction = if [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
templateRoot Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' then a
0 else a
1
extLen :: a
extLen = if Bool
isHTMLTemplate then a
4 else a
5
tName :: [Char]
tName = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
templateRoot)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
forall {a}. Num a => a
correction) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
fname) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
forall {a}. Num a => a
extLen) [Char]
fname
loadTemplate' :: String -> IO [Either String DocumentFile]
loadTemplate' :: [Char] -> IO [Either [Char] DocumentFile]
loadTemplate' [Char]
fullDiskPath
| Bool
isHTMLTemplate = (Either [Char] DocumentFile -> [Either [Char] DocumentFile])
-> IO (Either [Char] DocumentFile)
-> IO [Either [Char] DocumentFile]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either [Char] DocumentFile
-> [Either [Char] DocumentFile] -> [Either [Char] DocumentFile]
forall a. a -> [a] -> [a]
:[]) (IO (Either [Char] DocumentFile)
-> IO [Either [Char] DocumentFile])
-> IO (Either [Char] DocumentFile)
-> IO [Either [Char] DocumentFile]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Either [Char] DocumentFile)
getDoc [Char]
fullDiskPath
| Bool
isXMLTemplate = (Either [Char] DocumentFile -> [Either [Char] DocumentFile])
-> IO (Either [Char] DocumentFile)
-> IO [Either [Char] DocumentFile]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either [Char] DocumentFile
-> [Either [Char] DocumentFile] -> [Either [Char] DocumentFile]
forall a. a -> [a] -> [a]
:[]) (IO (Either [Char] DocumentFile)
-> IO [Either [Char] DocumentFile])
-> IO (Either [Char] DocumentFile)
-> IO [Either [Char] DocumentFile]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Either [Char] DocumentFile)
getXMLDoc [Char]
fullDiskPath
| Bool
otherwise = [Either [Char] DocumentFile] -> IO [Either [Char] DocumentFile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
isHTMLTemplate :: Bool
isHTMLTemplate = [Char]
".tpl" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
fullDiskPath
isXMLTemplate :: Bool
isXMLTemplate = [Char]
".xtpl" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
fullDiskPath
type ParserFun = String -> ByteString -> Either String X.Document
getDocWith :: ParserFun -> String -> IO (Either String DocumentFile)
getDocWith :: ParserFun -> [Char] -> IO (Either [Char] DocumentFile)
getDocWith ParserFun
parser [Char]
f = do
Either [Char] ByteString
bs <- IO (Either [Char] ByteString)
-> (SomeException -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch ((ByteString -> Either [Char] ByteString)
-> IO ByteString -> IO (Either [Char] ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (IO ByteString -> IO (Either [Char] ByteString))
-> IO ByteString -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
B.readFile [Char]
f)
(\(SomeException
e::SomeException) -> Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ByteString)
-> [Char] -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)
let eitherDoc :: Either [Char] Document
eitherDoc = ([Char] -> Either [Char] Document)
-> (ByteString -> Either [Char] Document)
-> Either [Char] ByteString
-> Either [Char] Document
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Either [Char] Document
forall a b. a -> Either a b
Left (ParserFun
parser [Char]
f) Either [Char] ByteString
bs
Either [Char] DocumentFile -> IO (Either [Char] DocumentFile)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] DocumentFile -> IO (Either [Char] DocumentFile))
-> Either [Char] DocumentFile -> IO (Either [Char] DocumentFile)
forall a b. (a -> b) -> a -> b
$ ([Char] -> Either [Char] DocumentFile)
-> (Document -> Either [Char] DocumentFile)
-> Either [Char] Document
-> Either [Char] DocumentFile
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
s -> [Char] -> Either [Char] DocumentFile
forall a b. a -> Either a b
Left ([Char] -> Either [Char] DocumentFile)
-> [Char] -> Either [Char] DocumentFile
forall a b. (a -> b) -> a -> b
$ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
(\Document
d -> DocumentFile -> Either [Char] DocumentFile
forall a b. b -> Either a b
Right (DocumentFile -> Either [Char] DocumentFile)
-> DocumentFile -> Either [Char] DocumentFile
forall a b. (a -> b) -> a -> b
$ Document -> Maybe [Char] -> DocumentFile
DocumentFile Document
d ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f)) Either [Char] Document
eitherDoc
getDoc :: String -> IO (Either String DocumentFile)
getDoc :: [Char] -> IO (Either [Char] DocumentFile)
getDoc = ParserFun -> [Char] -> IO (Either [Char] DocumentFile)
getDocWith ParserFun
X.parseHTML
getXMLDoc :: String -> IO (Either String DocumentFile)
getXMLDoc :: [Char] -> IO (Either [Char] DocumentFile)
getXMLDoc = ParserFun -> [Char] -> IO (Either [Char] DocumentFile)
getDocWith ParserFun
X.parseXML
setTemplates :: HashMap TPath DocumentFile -> HeistState n -> HeistState n
setTemplates :: forall (n :: * -> *).
HashMap TPath DocumentFile -> HeistState n -> HeistState n
setTemplates HashMap TPath DocumentFile
m HeistState n
ts = HeistState n
ts { _templateMap :: HashMap TPath DocumentFile
_templateMap = HashMap TPath DocumentFile
m }
insertTemplate :: TPath
-> DocumentFile
-> HeistState n
-> HeistState n
insertTemplate :: forall (n :: * -> *).
TPath -> DocumentFile -> HeistState n -> HeistState n
insertTemplate TPath
p DocumentFile
t HeistState n
st =
HashMap TPath DocumentFile -> HeistState n -> HeistState n
forall (n :: * -> *).
HashMap TPath DocumentFile -> HeistState n -> HeistState n
setTemplates (TPath
-> DocumentFile
-> HashMap TPath DocumentFile
-> HashMap TPath DocumentFile
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert TPath
p DocumentFile
t (HeistState n -> HashMap TPath DocumentFile
forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap HeistState n
st)) HeistState n
st
mimeType :: X.Document -> MIMEType
mimeType :: Document -> ByteString
mimeType Document
d = case Document
d of
(X.HtmlDocument Encoding
e Maybe DocType
_ [Node]
_) -> ByteString
"text/html;charset=" ByteString -> ByteString -> ByteString
`BC.append` Encoding -> ByteString
forall {a}. IsString a => Encoding -> a
enc Encoding
e
(X.XmlDocument Encoding
e Maybe DocType
_ [Node]
_) -> ByteString
"text/xml;charset=" ByteString -> ByteString -> ByteString
`BC.append` Encoding -> ByteString
forall {a}. IsString a => Encoding -> a
enc Encoding
e
where
enc :: Encoding -> a
enc Encoding
X.UTF8 = a
"utf-8"
enc Encoding
X.UTF16BE = a
"utf-16"
enc Encoding
X.UTF16LE = a
"utf-16"
enc Encoding
X.ISO_8859_1 = a
"iso-8859-1"
bindAttributeSplices :: Splices (AttrSplice n)
-> HeistState n
-> HeistState n
bindAttributeSplices :: forall (n :: * -> *).
Splices (AttrSplice n) -> HeistState n -> HeistState n
bindAttributeSplices Splices (AttrSplice n)
ss HeistState n
hs =
HeistState n
hs { _attrSpliceMap :: HashMap Text (AttrSplice n)
_attrSpliceMap = HeistState n
-> (HeistState n -> HashMap Text (AttrSplice n))
-> Splices (AttrSplice n)
-> HashMap Text (AttrSplice n)
forall (n :: * -> *) v a.
HeistState n
-> (HeistState n -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
applySpliceMap HeistState n
hs HeistState n -> HashMap Text (AttrSplice n)
forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap Splices (AttrSplice n)
ss }
addDoctype :: Monad m => [X.DocType] -> HeistT n m ()
addDoctype :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
[DocType] -> HeistT n m ()
addDoctype [DocType]
dt = do
(HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
s -> HeistState n
s { _doctypes :: [DocType]
_doctypes = HeistState n -> [DocType]
forall (m :: * -> *). HeistState m -> [DocType]
_doctypes HeistState n
s [DocType] -> [DocType] -> [DocType]
forall a. Monoid a => a -> a -> a
`mappend` [DocType]
dt })