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

    ------------------------------------------------------------------------------
    -- | 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
        hs <- HeistT n m (HeistState n)
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    HeistT n m (HeistState n)
    getHS
        if _preprocessingMode hs
          then do fullMsg <- heistErrMsg (T.pack msg)
                  error $ T.unpack fullMsg
          else 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
        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
        return $ (maybe "" ((`mappend` ": ") . T.pack) tf) `mappend` 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
        hs <- HeistT n m (HeistState n)
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    HeistT n m (HeistState n)
    getHS
        node <- getParamNode
        let 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
                          }
        modifyHS (\HeistState n
    hs' -> HeistState n
    hs { _spliceErrors = spliceError : _spliceErrors hs' })

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

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

    ------------------------------------------------------------------------------
    -- | 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 = 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 = tp }

    ------------------------------------------------------------------------------
    -- | Parser for attribute variable substitution.
    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
                                idp <- Parser Text AttAST
    identParser
                                dl' <- finish subDL
                                loop $! append dl' 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
    "}")

    ------------------------------------------------------------------------------
    -- | 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 (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

    ------------------------------------------------------------------------------
    -- | 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 = 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

    ------------------------------------------------------------------------------
    -- | 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 =
        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

    ------------------------------------------------------------------------------
    -- | 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 = (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

    ------------------------------------------------------------------------------
    -- | 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 = (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

    ------------------------------------------------------------------------------
    -- | 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 = ([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 #-}

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

    ------------------------------------------------------------------------------
    -- | 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 = (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

    ------------------------------------------------------------------------------
    -- | 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
        c <- [Char] -> IO [Either [Char] DocumentFile]
    loadTemplate' [Char]
    fname
        return $ map (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))) c
      where -- tName is path relative to the template root directory
        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
    $
                -- We're only dropping the template root, not the whole path
                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

    ------------------------------------------------------------------------------
    -- | 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 = (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 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
        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 = ([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
        return $ 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)) 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 = 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 =
        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

    ------------------------------------------------------------------------------
    -- 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` 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"
        -- 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 = applySpliceMap hs _attrSpliceMap 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
        (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 = _doctypes s `mappend` dt })