{-# 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

------------------------------------------------------------------------------
-- | If Heist is running in fail fast mode, then this function will throw an
-- exception with the second argument as the error message.  Otherwise, the
-- first argument will be executed to represent silent failure.
--
-- This behavior allows us to fail quickly if an error crops up during
-- load-time splice processing or degrade more gracefully if the error occurs
-- while a user request is being processed.
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


------------------------------------------------------------------------------
-- | Prepends the location of the template currently being processed to an
-- error message.
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


------------------------------------------------------------------------------
-- | Adds an error message to the list of splice processing errors.
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' })


------------------------------------------------------------------------------
-- | Function for showing a TPath.
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


------------------------------------------------------------------------------
-- | Convert a TPath into a ByteString path.
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


------------------------------------------------------------------------------
-- | Sets the current template file.
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 }


------------------------------------------------------------------------------
-- | Parser for attribute variable substitution.
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
"}")


------------------------------------------------------------------------------
-- | Converts a path into an array of the elements in reverse order.  If the
-- path is absolute, we need to remove the leading slash so the split doesn't
-- leave @\"\"@ as the last element of the TPath.
--
-- FIXME @\"..\"@ currently doesn't work in paths, the solution is non-trivial
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


------------------------------------------------------------------------------
-- | Converts a path into an array of the elements in reverse order using the
-- path separator of the local operating system. See 'splitPathWith' for more
-- details.
splitLocalPath :: ByteString -> TPath
splitLocalPath :: ByteString -> TPath
splitLocalPath = Char -> ByteString -> TPath
splitPathWith Char
pathSeparator


------------------------------------------------------------------------------
-- | Converts a path into an array of the elements in reverse order using a
-- forward slash (/) as the path separator. See 'splitPathWith' for more
-- details.
splitTemplatePath :: ByteString -> TPath
splitTemplatePath :: ByteString -> TPath
splitTemplatePath = Char -> ByteString -> TPath
splitPathWith Char
'/'


------------------------------------------------------------------------------
-- | Convenience function for looking up a template.
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


------------------------------------------------------------------------------
-- | Returns 'True' if the given template can be found in the heist state.
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


------------------------------------------------------------------------------
-- | Does a single template lookup without cascading up.
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


------------------------------------------------------------------------------
-- | Searches for a template by looking in the full path then backing up into
-- each of the parent directories until the template is found.
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


------------------------------------------------------------------------------
-- | Maps a splice generating function over a list and concatenates the
-- results.  This function now has a more general type signature so it works
-- with both compiled and interpreted splices.  The old type signature was
-- this:
--
-- > mapSplices :: (Monad n)
-- >         => (a -> Splice n n)
-- >         -> [a]
-- >         -> Splice n n
mapSplices :: (Monad m, Monoid b)
           => (a -> m b)
           -- ^ Splice generating function
           -> [a]
           -- ^ List of items to generate splices for
           -> m b
           -- ^ The result of all splices concatenated together.
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 #-}


------------------------------------------------------------------------------
-- | Gets the current context
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


------------------------------------------------------------------------------
-- | Gets the full path to the file holding the template currently being
-- processed.  Returns Nothing if the template is not associated with a file
-- on disk or if there is no template being processed.
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


------------------------------------------------------------------------------
-- | Loads a template with the specified path and filename.  The
-- template is only loaded if it has a ".tpl" or ".xtpl" extension.
loadTemplate :: String -- ^ path of the template root
             -> String -- ^ full file path (includes the template root)
             -> IO [Either String (TPath, DocumentFile)] --TemplateMap
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 -- tName is path relative to the template root directory
    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
$
            -- We're only dropping the template root, not the whole path
            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


------------------------------------------------------------------------------
-- | Loads a template at the specified path, choosing the appropriate parser
-- based on the file extension.  The template is only loaded if it has a
-- \".tpl\" or \".xtpl\" extension.  Returns an empty list if the extension
-- doesn't match.
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 synonym for parsers.
type ParserFun = String -> ByteString -> Either String X.Document


------------------------------------------------------------------------------
-- | Reads an HTML or XML template from disk.
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


------------------------------------------------------------------------------
-- | Reads an HTML template from disk.
getDoc :: String -> IO (Either String DocumentFile)
getDoc :: [Char] -> IO (Either [Char] DocumentFile)
getDoc = ParserFun -> [Char] -> IO (Either [Char] DocumentFile)
getDocWith ParserFun
X.parseHTML


------------------------------------------------------------------------------
-- | Reads an XML template from disk.
getXMLDoc :: String -> IO (Either String DocumentFile)
getXMLDoc :: [Char] -> IO (Either [Char] DocumentFile)
getXMLDoc = ParserFun -> [Char] -> IO (Either [Char] DocumentFile)
getDocWith ParserFun
X.parseXML


------------------------------------------------------------------------------
-- | Sets the templateMap in a HeistState.
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 }


------------------------------------------------------------------------------
-- | Adds a template to the heist state.
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


------------------------------------------------------------------------------
-- Gives the MIME type for a 'X.Document'
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"
    -- Should not include byte order designation for UTF-16 since
    -- rendering will include a byte order mark. (RFC 2781, Sec. 3.3)
    enc Encoding
X.UTF16BE = a
"utf-16"
    enc Encoding
X.UTF16LE = a
"utf-16"
    enc Encoding
X.ISO_8859_1 = a
"iso-8859-1"


------------------------------------------------------------------------------
-- | Binds a set of new splice declarations within a 'HeistState'.
bindAttributeSplices :: Splices (AttrSplice n) -- ^ splices to bind
                     -> HeistState n           -- ^ start state
                     -> 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 }

------------------------------------------------------------------------------
-- | Mappends a doctype to the state.
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 })