{-# 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 forall map k v a.
Monoid map =>
(k -> map -> Maybe v)
-> (k -> v -> map -> map) -> MapSyntaxM k v a -> Either [k] map
runMapSyntax forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Splices s
ms of
Left [Text]
keys -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Semigroup a, IsString a) => a -> a
mkMsg) [Text]
keys
Right HashMap Text s
hm -> forall a b. b -> Either a b
Right HashMap Text s
hm
where
mkMsg :: a -> a
mkMsg a
k = a
"You tried to bind "forall a. Semigroup a => a -> a -> a
<>a
kforall 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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
_ -> forall a. a -> Maybe a
Just v
new) forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup 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 = (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k v a. (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v
runMapNoErrors forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK (forall a. Monoid a => a -> a -> a
mappend Text
pre)
where
pre :: Text
pre = 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 <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
if forall (m :: * -> *). HeistState m -> Bool
_preprocessingMode HeistState n
hs
then do Text
fullMsg <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Text
heistErrMsg ([Char] -> Text
T.pack [Char]
msg)
forall a. HasCallStack => [Char] -> a
error 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 <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((forall a. Monoid a => a -> a -> a
`mappend` Text
": ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Maybe [Char]
tf) 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 <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
Node
node <- forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
let spliceError :: SpliceError
spliceError = SpliceError
{ spliceHistory :: [(TPath, Maybe [Char], Text)]
spliceHistory = forall (m :: * -> *). HeistState m -> [(TPath, Maybe [Char], Text)]
_splicePath HeistState n
hs
, spliceTemplateFile :: Maybe [Char]
spliceTemplateFile = forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile HeistState n
hs
, visibleSplices :: [Text]
visibleSplices = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ 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
}
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
hs' -> HeistState n
hs { _spliceErrors :: [SpliceError]
_spliceErrors = SpliceError
spliceError forall a. a -> [a] -> [a]
: forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors HeistState n
hs' })
showTPath :: TPath -> String
showTPath :: TPath -> [Char]
showTPath = ByteString -> [Char]
BC.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
`BC.append` ByteString
".tpl") 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
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> b) -> a -> b
$! []) (forall {c}. ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
loop forall a. a -> a
id)
where
append :: ([a] -> c) -> a -> [a] -> c
append ![a] -> c
dl !a
x = [a] -> c
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:)
loop :: ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
loop ![AttAST] -> c
dl = ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
go forall a. a -> a
id
where
finish :: ([a] -> [Text]) -> m ([AttAST] -> c)
finish [a] -> [Text]
subDL = let !txt :: Text
txt = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$! [a] -> [Text]
subDL []
lit :: AttAST
lit = Text -> AttAST
Literal forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$! [a] -> [Text]
subDL []
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if Text -> Bool
T.null Text
txt
then [AttAST] -> c
dl
else 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {c}. ([a] -> c) -> a -> [a] -> c
append [Text] -> [Text]
subDL)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall t. Chunk t => Parser t ()
AP.endOfInput forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {m :: * -> *} {a}.
Monad m =>
([a] -> [Text]) -> m ([AttAST] -> c)
finish [Text] -> [Text]
subDL)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
AttAST
idp <- Parser Text AttAST
identParser
[AttAST] -> c
dl' <- forall {m :: * -> *} {a}.
Monad m =>
([a] -> [Text]) -> m ([AttAST] -> c)
finish [Text] -> [Text]
subDL
([AttAST] -> c) -> Parser Text ([AttAST] -> c)
loop forall a b. (a -> b) -> a -> b
$! 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
'$' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text AttAST
ident forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> AttAST
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
AP.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'}')) 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 (forall a. [a] -> [a]
reverse 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 forall a. Eq a => a -> a -> Bool
== Char
s then HasCallStack => 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 = 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 forall (m :: * -> *). HeistState m -> TPath
_curContext HeistState n
ts
path :: TPath
path = TPath
p 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 forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
singleLookup
else 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 =
forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
nameStr HeistState n
ts 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
a -> (t
a,[a]
path)) forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (a
nameforall 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
a -> (t
a,[])) (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 =
forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
singleLookup HashMap [a] t
tm [a]
path a
name forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall a t.
(Eq a, Hashable a) =>
HashMap [a] t -> [a] -> a -> Maybe (t, [a])
traversePath HashMap [a] t
tm (forall a. [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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 = forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS 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 = forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DocumentFile
t -> (ByteString -> TPath
splitLocalPath 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" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
fname
correction :: a
correction = if forall a. [a] -> a
last [Char]
templateRoot 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 = forall a. Int -> [a] -> [a]
drop ((forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
templateRoot)forall a. Num a => a -> a -> a
+forall {a}. Num a => a
correction) forall a b. (a -> b) -> a -> b
$
forall a. Int -> [a] -> [a]
take ((forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
fname) forall a. Num a => a -> a -> a
- 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Either [Char] DocumentFile)
getDoc [Char]
fullDiskPath
| Bool
isXMLTemplate = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Either [Char] DocumentFile)
getXMLDoc [Char]
fullDiskPath
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return []
where
isHTMLTemplate :: Bool
isHTMLTemplate = [Char]
".tpl" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
fullDiskPath
isXMLTemplate :: Bool
isXMLTemplate = [Char]
".xtpl" 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 <- forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
B.readFile [Char]
f)
(\(SomeException
e::SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show SomeException
e)
let eitherDoc :: Either [Char] Document
eitherDoc = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (ParserFun
parser [Char]
f) Either [Char] ByteString
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
s)
(\Document
d -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Document -> Maybe [Char] -> DocumentFile
DocumentFile Document
d (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 =
forall (n :: * -> *).
HashMap TPath DocumentFile -> HeistState n -> HeistState n
setTemplates (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert TPath
p DocumentFile
t (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` 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` 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 = forall (n :: * -> *) v a.
HeistState n
-> (HeistState n -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
applySpliceMap HeistState n
hs 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
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
s -> HeistState n
s { _doctypes :: [DocType]
_doctypes = forall (m :: * -> *). HeistState m -> [DocType]
_doctypes HeistState n
s forall a. Monoid a => a -> a -> a
`mappend` [DocType]
dt })