    {-# 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)
    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 :: Splices s -> Either [String] (HashMap Text s)
    runHashMap ms :: 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 keys :: [Text]
    keys -> [String] -> Either [String] (HashMap Text s)
    forall a b. a -> Either a b
    Left ([String] -> Either [String] (HashMap Text s))
    -> [String] -> Either [String] (HashMap Text s)
    forall a b. (a -> b) -> a -> b
    $ (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> String
    T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    forall a. (Semigroup a, IsString a) => a -> a
    mkMsg) [Text]
    keys
          Right hm :: HashMap Text s
    hm -> HashMap Text s -> Either [String] (HashMap Text s)
    forall a b. b -> Either a b
    Right HashMap Text s
    hm
      where
        mkMsg :: a -> a
    mkMsg k :: a
    k = "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
    <>" more than once!"

    ------------------------------------------------------------------------------
    runMapNoErrors :: (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v
    runMapNoErrors :: 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' (\_ new :: v
    new _ -> 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 :: HeistState n
    -> (HeistState n -> HashMap Text v)
    -> MapSyntaxM Text v a
    -> HashMap Text v
    applySpliceMap hs :: HeistState n
    hs f :: HeistState n -> HashMap Text v
    f =  ((HashMap Text v -> HashMap Text v -> HashMap Text v)
    -> HashMap Text v -> HashMap Text v -> HashMap Text v
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip HashMap Text v -> HashMap Text v -> HashMap Text v
    forall k v.
    (Eq k, Hashable k) =>
    HashMap k v -> HashMap k v -> HashMap k v
    Map.union (HeistState n -> HashMap Text v
    f HeistState n
    hs)) (HashMap Text v -> HashMap Text v)
    -> (MapSyntaxM Text v a -> HashMap Text v)
    -> MapSyntaxM Text v a
    -> HashMap Text v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        MapSyntaxM Text v () -> HashMap Text v
    forall k v a. (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v
    runMapNoErrors (MapSyntaxM Text v () -> HashMap Text v)
    -> (MapSyntaxM Text v a -> MapSyntaxM Text v ())
    -> MapSyntaxM Text v a
    -> HashMap Text v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (Text -> Text) -> MapSyntaxM Text v a -> MapSyntaxM Text v ()
    forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
    mapK (Text -> Text -> Text
    forall a. Monoid a => a -> a -> a
    mappend Text
    pre)
      where
        pre :: Text
    pre = HeistState n -> Text
    forall (m :: * -> *). HeistState m -> Text
    _splicePrefix HeistState n
    hs

    ------------------------------------------------------------------------------
    -- | 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 :: HeistT n m b -> String -> HeistT n m b
    orError silent :: HeistT n m b
    silent msg :: String
    msg = do
        HeistState n
    hs <- HeistT n m (HeistState n)
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    HeistT n m (HeistState n)
    getHS
        if HeistState n -> Bool
    forall (m :: * -> *). HeistState m -> Bool
    _preprocessingMode HeistState n
    hs
          then do Text
    fullMsg <- Text -> HeistT n m Text
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    Text -> HeistT n m Text
    heistErrMsg (String -> Text
    T.pack String
    msg)
                  String -> HeistT n m b
    forall a. HasCallStack => String -> a
    error (String -> HeistT n m b) -> String -> HeistT n m b
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    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 :: Text -> HeistT n m Text
    heistErrMsg msg :: Text
    msg = do
        Maybe String
    tf <- (HeistState n -> Maybe String) -> HeistT n m (Maybe String)
    forall (m :: * -> *) (n :: * -> *) r.
    Monad m =>
    (HeistState n -> r) -> HeistT n m r
    getsHS HeistState n -> Maybe String
    forall (m :: * -> *). HeistState m -> Maybe String
    _curTemplateFile
        Text -> HeistT n m Text
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> HeistT n m Text) -> Text -> HeistT n m Text
    forall a b. (a -> b) -> a -> b
    $ (Text -> (String -> Text) -> Maybe String -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ((Text -> Text -> Text
    forall a. Monoid a => a -> a -> a
    `mappend` ": ") (Text -> Text) -> (String -> Text) -> String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack) Maybe String
    tf) Text -> Text -> Text
    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 :: Text -> HeistT n m ()
    tellSpliceError msg :: Text
    msg = do
        HeistState n
    hs <- HeistT n m (HeistState n)
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    HeistT n m (HeistState n)
    getHS
        Node
    node <- HeistT n m Node
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
    getParamNode
        let spliceError :: SpliceError
    spliceError = SpliceError :: [(TPath, Maybe String, Text)]
    -> Maybe String -> [Text] -> Node -> Text -> SpliceError
    SpliceError
                          { spliceHistory :: [(TPath, Maybe String, Text)]
    spliceHistory = HeistState n -> [(TPath, Maybe String, Text)]
    forall (m :: * -> *). HeistState m -> [(TPath, Maybe String, Text)]
    _splicePath HeistState n
    hs
                          , spliceTemplateFile :: Maybe String
    spliceTemplateFile = HeistState n -> Maybe String
    forall (m :: * -> *). HeistState m -> Maybe String
    _curTemplateFile HeistState n
    hs
                          , visibleSplices :: [Text]
    visibleSplices = HashMap Text (HeistT n IO (DList (Chunk n))) -> [Text]
    forall k v. HashMap k v -> [k]
    Map.keys (HashMap Text (HeistT n IO (DList (Chunk n))) -> [Text])
    -> HashMap Text (HeistT n IO (DList (Chunk n))) -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HeistState n -> HashMap Text (HeistT n IO (DList (Chunk n)))
    forall (m :: * -> *).
    HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
    _compiledSpliceMap HeistState n
    hs
                          , contextNode :: Node
    contextNode = Node
    node
                          , spliceMsg :: Text
    spliceMsg = Text
    msg
                          }
        (HeistState n -> HeistState n) -> HeistT n m ()
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    (HeistState n -> HeistState n) -> HeistT n m ()
    modifyHS (\hs' :: HeistState n
    hs' -> HeistState n
    hs { _spliceErrors :: [SpliceError]
    _spliceErrors = SpliceError
    spliceError SpliceError -> [SpliceError] -> [SpliceError]
    forall a. a -> [a] -> [a]
    : HeistState n -> [SpliceError]
    forall (m :: * -> *). HeistState m -> [SpliceError]
    _spliceErrors HeistState n
    hs' })

    ------------------------------------------------------------------------------
    -- | Function for showing a TPath.
    showTPath :: TPath -> String
    showTPath :: TPath -> String
    showTPath = ByteString -> String
    BC.unpack (ByteString -> String) -> (TPath -> ByteString) -> TPath -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> ByteString -> ByteString
    `BC.append` ".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 "/" (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 :: Maybe String -> HeistState n -> HeistState n
    setCurTemplateFile Nothing ts :: HeistState n
    ts = HeistState n
    ts
    setCurTemplateFile fp :: Maybe String
    fp ts :: HeistState n
    ts = HeistState n
    ts { _curTemplateFile :: Maybe String
    _curTemplateFile = Maybe String
    fp }

    ------------------------------------------------------------------------------
    setCurContext :: TPath -> HeistState n -> HeistState n
    setCurContext :: TPath -> HeistState n -> HeistState n
    setCurContext tp :: TPath
    tp ts :: HeistState n
    ts = HeistState n
    ts { _curContext :: TPath
    _curContext = TPath
    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 subDL :: [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 (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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (do
                                AttAST
    idp <- Parser Text AttAST
    identParser
                                [AttAST] -> c
    dl' <- ([Text] -> [Text]) -> Parser Text ([AttAST] -> c)
    forall (m :: * -> *) a.
    Monad m =>
    ([a] -> [Text]) -> m ([AttAST] -> c)
    finish [Text] -> [Text]
    subDL
                                ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
    loop (([AttAST] -> c) -> Parser Text ([AttAST] -> c))
    -> ([AttAST] -> c) -> Parser Text ([AttAST] -> c)
    forall a b. (a -> b) -> a -> b
    $! ([AttAST] -> c) -> AttAST -> [AttAST] -> c
    forall a c. ([a] -> c) -> a -> [a] -> c
    append [AttAST] -> c
    dl' AttAST
    idp)

        gobbleText :: Parser Text
    gobbleText = (Char -> Bool) -> Parser Text
    AP.takeWhile1 (String -> Char -> Bool
    AP.notInClass "$")

        identParser :: Parser Text AttAST
    identParser = Char -> Parser Char
    AP.char '$' Parser Char -> Parser Text AttAST -> Parser Text AttAST
    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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> AttAST -> Parser Text AttAST
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> AttAST
    Literal "$"))
        ident :: Parser Text AttAST
    ident = (Char -> Parser Char
    AP.char '{' Parser Char -> Parser Text AttAST -> Parser Text AttAST
    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
    /='}')) Parser Text AttAST -> Parser Text -> Parser Text AttAST
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Text -> Parser Text
    AP.string "}")

    ------------------------------------------------------------------------------
    -- | 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 s :: Char
    s p :: 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 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 '/'

    ------------------------------------------------------------------------------
    -- | Convenience function for looking up a template.
    lookupTemplate :: ByteString
                   -> HeistState n
                   -> (HeistState n -> HashMap TPath t)
                   -> Maybe (t, TPath)
    lookupTemplate :: ByteString
    -> HeistState n
    -> (HeistState n -> HashMap TPath t)
    -> Maybe (t, TPath)
    lookupTemplate nameStr :: ByteString
    nameStr ts :: HeistState n
    ts tm :: HeistState n -> HashMap TPath t
    tm = HashMap TPath t -> TPath -> ByteString -> Maybe (t, TPath)
    forall a t.
    (Eq a, 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
        (name :: ByteString
    name:p :: TPath
    p) = case ByteString -> TPath
    splitTemplatePath ByteString
    nameStr of
                       [] -> [""]
                       ps :: TPath
    ps -> TPath
    ps
        ctx :: TPath
    ctx = if ByteString -> ByteString -> Bool
    B.isPrefixOf "/" 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 -> 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 :: ByteString -> HeistState n -> Bool
    hasTemplate nameStr :: ByteString
    nameStr ts :: 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 :: HashMap [a] t -> [a] -> a -> Maybe (t, [a])
    singleLookup tm :: HashMap [a] t
    tm path :: [a]
    path name :: a
    name = (t -> (t, [a])) -> Maybe t -> Maybe (t, [a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\a :: 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 :: HashMap [a] t -> [a] -> a -> Maybe (t, [a])
    traversePath tm :: HashMap [a] t
    tm [] name :: a
    name = (t -> (t, [a])) -> Maybe t -> Maybe (t, [a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\a :: 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 tm :: HashMap [a] t
    tm path :: [a]
    path name :: 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 (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. [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 :: (a -> m b) -> [a] -> m b
    mapSplices f :: a -> m b
    f vs :: [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)
    mapM a -> m b
    f [a]
    vs
    {-# INLINE mapSplices #-}

    ------------------------------------------------------------------------------
    -- | Gets the current context
    getContext :: Monad m => HeistT n m TPath
    getContext :: 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 :: HeistT n m (Maybe String)
    getTemplateFilePath = (HeistState n -> Maybe String) -> HeistT n m (Maybe String)
    forall (m :: * -> *) (n :: * -> *) r.
    Monad m =>
    (HeistState n -> r) -> HeistT n m r
    getsHS HeistState n -> Maybe String
    forall (m :: * -> *). HeistState m -> Maybe String
    _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 :: String -> String -> IO [Either String (TPath, DocumentFile)]
    loadTemplate templateRoot :: String
    templateRoot fname :: String
    fname = do
        [Either String DocumentFile]
    c <- String -> IO [Either String DocumentFile]
    loadTemplate' String
    fname
        [Either String (TPath, DocumentFile)]
    -> IO [Either String (TPath, DocumentFile)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Either String (TPath, DocumentFile)]
     -> IO [Either String (TPath, DocumentFile)])
    -> [Either String (TPath, DocumentFile)]
    -> IO [Either String (TPath, DocumentFile)]
    forall a b. (a -> b) -> a -> b
    $ (Either String DocumentFile -> Either String (TPath, DocumentFile))
    -> [Either String DocumentFile]
    -> [Either String (TPath, DocumentFile)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((DocumentFile -> (TPath, DocumentFile))
    -> Either String DocumentFile
    -> Either String (TPath, DocumentFile)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\t :: DocumentFile
    t -> (ByteString -> TPath
    splitLocalPath (ByteString -> TPath) -> ByteString -> TPath
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BC.pack String
    tName, DocumentFile
    t))) [Either String DocumentFile]
    c
      where -- tName is path relative to the template root directory
        isHTMLTemplate :: Bool
    isHTMLTemplate = ".tpl"  String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    fname
        correction :: p
    correction = if String -> Char
    forall a. [a] -> a
    last String
    templateRoot Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/' then 0 else 1
        extLen :: p
    extLen     = if Bool
    isHTMLTemplate then 4 else 5
        tName :: String
    tName = Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop ((String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    templateRoot)Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    forall p. Num p => p
    correction) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                -- We're only dropping the template root, not the whole path
                Int -> String -> String
    forall a. Int -> [a] -> [a]
    take ((String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    fname) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    forall p. Num p => p
    extLen) String
    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' :: String -> IO [Either String DocumentFile]
    loadTemplate' fullDiskPath :: String
    fullDiskPath
        | Bool
    isHTMLTemplate = (Either String DocumentFile -> [Either String DocumentFile])
    -> IO (Either String DocumentFile)
    -> IO [Either String DocumentFile]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Either String DocumentFile
    -> [Either String DocumentFile] -> [Either String DocumentFile]
    forall a. a -> [a] -> [a]
    :[]) (IO (Either String DocumentFile)
     -> IO [Either String DocumentFile])
    -> IO (Either String DocumentFile)
    -> IO [Either String DocumentFile]
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Either String DocumentFile)
    getDoc String
    fullDiskPath
        | Bool
    isXMLTemplate = (Either String DocumentFile -> [Either String DocumentFile])
    -> IO (Either String DocumentFile)
    -> IO [Either String DocumentFile]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Either String DocumentFile
    -> [Either String DocumentFile] -> [Either String DocumentFile]
    forall a. a -> [a] -> [a]
    :[]) (IO (Either String DocumentFile)
     -> IO [Either String DocumentFile])
    -> IO (Either String DocumentFile)
    -> IO [Either String DocumentFile]
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Either String DocumentFile)
    getXMLDoc String
    fullDiskPath
        | Bool
    otherwise = [Either String DocumentFile] -> IO [Either String DocumentFile]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      where
        isHTMLTemplate :: Bool
    isHTMLTemplate = ".tpl"  String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    fullDiskPath
        isXMLTemplate :: Bool
    isXMLTemplate  = ".xtpl" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    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 -> String -> IO (Either String DocumentFile)
    getDocWith parser :: ParserFun
    parser f :: String
    f = do
        Either String ByteString
    bs <- IO (Either String ByteString)
    -> (SomeException -> IO (Either String ByteString))
    -> IO (Either String ByteString)
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    C.catch ((ByteString -> Either String ByteString)
    -> IO ByteString -> IO (Either String ByteString)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ByteString -> Either String ByteString
    forall a b. b -> Either a b
    Right (IO ByteString -> IO (Either String ByteString))
    -> IO ByteString -> IO (Either String ByteString)
    forall a b. (a -> b) -> a -> b
    $ String -> IO ByteString
    B.readFile String
    f)
                    (\(SomeException
    e::SomeException) -> Either String ByteString -> IO (Either String ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String ByteString -> IO (Either String ByteString))
    -> Either String ByteString -> IO (Either String ByteString)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String ByteString
    forall a b. a -> Either a b
    Left (String -> Either String ByteString)
    -> String -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)

        let eitherDoc :: Either String Document
    eitherDoc = (String -> Either String Document)
    -> (ByteString -> Either String Document)
    -> Either String ByteString
    -> Either String Document
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> Either String Document
    forall a b. a -> Either a b
    Left (ParserFun
    parser String
    f) Either String ByteString
    bs
        Either String DocumentFile -> IO (Either String DocumentFile)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String DocumentFile -> IO (Either String DocumentFile))
    -> Either String DocumentFile -> IO (Either String DocumentFile)
    forall a b. (a -> b) -> a -> b
    $ (String -> Either String DocumentFile)
    -> (Document -> Either String DocumentFile)
    -> Either String Document
    -> Either String DocumentFile
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (\s :: String
    s -> String -> Either String DocumentFile
    forall a b. a -> Either a b
    Left (String -> Either String DocumentFile)
    -> String -> Either String DocumentFile
    forall a b. (a -> b) -> a -> b
    $ String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s)
                        (\d :: Document
    d -> DocumentFile -> Either String DocumentFile
    forall a b. b -> Either a b
    Right (DocumentFile -> Either String DocumentFile)
    -> DocumentFile -> Either String DocumentFile
    forall a b. (a -> b) -> a -> b
    $ Document -> Maybe String -> DocumentFile
    DocumentFile Document
    d (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    f)) Either String Document
    eitherDoc

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

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

    ------------------------------------------------------------------------------
    -- | Sets the templateMap in a HeistState.
    setTemplates :: HashMap TPath DocumentFile -> HeistState n -> HeistState n
    setTemplates :: HashMap TPath DocumentFile -> HeistState n -> HeistState n
    setTemplates m :: HashMap TPath DocumentFile
    m ts :: 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 :: TPath -> DocumentFile -> HeistState n -> HeistState n
    insertTemplate p :: TPath
    p t :: DocumentFile
    t st :: 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 d :: Document
    d = case Document
    d of
        (X.HtmlDocument e :: Encoding
    e _ _) -> "text/html;charset=" ByteString -> ByteString -> ByteString
    `BC.append` Encoding -> ByteString
    forall p. IsString p => Encoding -> p
    enc Encoding
    e
        (X.XmlDocument  e :: Encoding
    e _ _) -> "text/xml;charset="  ByteString -> ByteString -> ByteString
    `BC.append` Encoding -> ByteString
    forall p. IsString p => Encoding -> p
    enc Encoding
    e
      where
        enc :: Encoding -> p
    enc X.UTF8    = "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 X.UTF16BE = "utf-16"
        enc X.UTF16LE = "utf-16"
        enc X.ISO_8859_1 = "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 :: Splices (AttrSplice n) -> HeistState n -> HeistState n
    bindAttributeSplices ss :: Splices (AttrSplice n)
    ss hs :: HeistState n
    hs =
        HeistState n
    hs { _attrSpliceMap :: HashMap Text (AttrSplice n)
    _attrSpliceMap = HeistState n
    -> (HeistState n -> HashMap Text (AttrSplice n))
    -> Splices (AttrSplice n)
    -> HashMap Text (AttrSplice n)
    forall (n :: * -> *) v a.
    HeistState n
    -> (HeistState n -> HashMap Text v)
    -> MapSyntaxM Text v a
    -> HashMap Text v
    applySpliceMap HeistState n
    hs HeistState n -> HashMap Text (AttrSplice n)
    forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
    _attrSpliceMap Splices (AttrSplice n)
    ss }

    ------------------------------------------------------------------------------
    -- | Mappends a doctype to the state.
    addDoctype :: Monad m => [X.DocType] -> HeistT n m ()
    addDoctype :: [DocType] -> HeistT n m ()
    addDoctype dt :: [DocType]
    dt = do
        (HeistState n -> HeistState n) -> HeistT n m ()
    forall (m :: * -> *) (n :: * -> *).
    Monad m =>
    (HeistState n -> HeistState n) -> HeistT n m ()
    modifyHS (\s :: HeistState n
    s -> HeistState n
    s { _doctypes :: [DocType]
    _doctypes = HeistState n -> [DocType]
    forall (m :: * -> *). HeistState m -> [DocType]
    _doctypes HeistState n
    s [DocType] -> [DocType] -> [DocType]
    forall a. Monoid a => a -> a -> a
    `mappend` [DocType]
    dt })