    {-# LANGUAGE PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}

    module General.Template(
        Template, templateFile, templateMarkup, templateApply, templateRender
        ) where

    import Data.Data
    import Data.Monoid
    import Text.Blaze
    import Text.Blaze.Renderer.Utf8
    import General.Str
    import Data.List.Extra
    import Control.Exception
    import Data.Generics.Uniplate.Data
    import Control.Applicative
    import System.IO.Unsafe
    import System.Directory
    import Control.Monad
    import Data.IORef
    import Prelude

    ---------------------------------------------------------------------
    -- TREE DATA TYPE

    data Tree = Lam FilePath -- #{foo} defines a lambda
              | Var BStr -- a real variable
              | App Tree [(BStr, Tree)] -- applies a foo string to the lambda
              | Lit BStr
              | List [Tree]
                deriving (Typeable,Typeable Tree
    Typeable Tree
    -> (forall (c :: * -> *).
        (forall d b. Data d => c (d -> b) -> d -> c b)
        -> (forall g. g -> c g) -> Tree -> c Tree)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c Tree)
    -> (Tree -> Constr)
    -> (Tree -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c Tree))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree))
    -> ((forall b. Data b => b -> b) -> Tree -> Tree)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r)
    -> (forall u. (forall d. Data d => d -> u) -> Tree -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> Tree -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> Tree -> m Tree)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Tree -> m Tree)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Tree -> m Tree)
    -> Data Tree
    Tree -> Constr
    Tree -> DataType
    (forall b. Data b => b -> b) -> Tree -> Tree
    forall a.
    Typeable a
    -> (forall (c :: * -> *).
        (forall d b. Data d => c (d -> b) -> d -> c b)
        -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> Tree -> u
    forall u. (forall d. Data d => d -> u) -> Tree -> [u]
    forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
    forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Tree
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Tree -> c Tree
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Tree)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Tree -> c Tree
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Tree -> c Tree
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Tree
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Tree
    $ctoConstr :: Tree -> Constr
    toConstr :: Tree -> Constr
    $cdataTypeOf :: Tree -> DataType
    dataTypeOf :: Tree -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Tree)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Tree)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree)
    $cgmapT :: (forall b. Data b => b -> b) -> Tree -> Tree
    gmapT :: (forall b. Data b => b -> b) -> Tree -> Tree
    $cgmapQl :: forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
    gmapQl :: forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
    gmapQr :: forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Tree -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> Tree -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Tree -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Tree -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree
    Data,Int -> Tree -> ShowS
    [Tree] -> ShowS
    Tree -> FilePath
    (Int -> Tree -> ShowS)
    -> (Tree -> FilePath) -> ([Tree] -> ShowS) -> Show Tree
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Tree -> ShowS
    showsPrec :: Int -> Tree -> ShowS
    $cshow :: Tree -> FilePath
    show :: Tree -> FilePath
    $cshowList :: [Tree] -> ShowS
    showList :: [Tree] -> ShowS
    Show)

    -- | Turn all Lam into Var/Lit
    treeRemoveLam :: Tree -> IO Tree
    treeRemoveLam :: Tree -> IO Tree
    treeRemoveLam = (Tree -> IO Tree) -> Tree -> IO Tree
    forall (m :: * -> *) on.
    (Monad m, Applicative m, Uniplate on) =>
    (on -> m on) -> on -> m on
    transformM Tree -> IO Tree
    f
        where
            f :: Tree -> IO Tree
    f (Lam FilePath
    file) = [Tree] -> Tree
    List ([Tree] -> Tree) -> (BStr -> [Tree]) -> BStr -> Tree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BStr -> [Tree]
    parse (BStr -> Tree) -> IO BStr -> IO Tree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO BStr
    bstrReadFile FilePath
    file
            f Tree
    x = Tree -> IO Tree
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    x

            parse :: BStr -> [Tree]
    parse BStr
    x | Just (BStr
    a,BStr
    b) <- BStr -> BStr -> Maybe (BStr, BStr)
    bstrSplitInfix (FilePath -> BStr
    bstrPack FilePath
    "#{") BStr
    x
                    , Just (BStr
    b,BStr
    c) <- BStr -> BStr -> Maybe (BStr, BStr)
    bstrSplitInfix (FilePath -> BStr
    bstrPack FilePath
    "}") BStr
    b
                    = BStr -> Tree
    Lit BStr
    a Tree -> [Tree] -> [Tree]
    forall a. a -> [a] -> [a]
    : BStr -> Tree
    Var BStr
    b Tree -> [Tree] -> [Tree]
    forall a. a -> [a] -> [a]
    : BStr -> [Tree]
    parse BStr
    c
            parse BStr
    x = [BStr -> Tree
    Lit BStr
    x]

    treeRemoveApp :: Tree -> Tree
    treeRemoveApp :: Tree -> Tree
    treeRemoveApp = [(BStr, Tree)] -> Tree -> Tree
    f []
        where
            f :: [(BStr, Tree)] -> Tree -> Tree
    f [(BStr, Tree)]
    seen (App Tree
    t [(BStr, Tree)]
    xs) = [(BStr, Tree)] -> Tree -> Tree
    f ([(BStr, Tree)]
    xs [(BStr, Tree)] -> [(BStr, Tree)] -> [(BStr, Tree)]
    forall a. [a] -> [a] -> [a]
    ++ [(BStr, Tree)]
    seen) Tree
    t
            f [(BStr, Tree)]
    seen (Var BStr
    x) | Just Tree
    t <- BStr -> [(BStr, Tree)] -> Maybe Tree
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup BStr
    x [(BStr, Tree)]
    seen = [(BStr, Tree)] -> Tree -> Tree
    f [(BStr, Tree)]
    seen Tree
    t
            f [(BStr, Tree)]
    seen Tree
    x = (Tree -> Tree) -> Tree -> Tree
    forall on. Uniplate on => (on -> on) -> on -> on
    descend ([(BStr, Tree)] -> Tree -> Tree
    f [(BStr, Tree)]
    seen) Tree
    x

    treeOptimise :: Tree -> Tree
    treeOptimise :: Tree -> Tree
    treeOptimise = (Tree -> Tree) -> Tree -> Tree
    forall on. Uniplate on => (on -> on) -> on -> on
    transform Tree -> Tree
    f (Tree -> Tree) -> (Tree -> Tree) -> Tree -> Tree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree -> Tree
    treeRemoveApp
        where
            fromList :: Tree -> [Tree]
    fromList (List [Tree]
    xs) = [Tree]
    xs; fromList Tree
    x = [Tree
    x]
            toList :: [Tree] -> Tree
    toList [Tree
    x] = Tree
    x; toList [Tree]
    xs = [Tree] -> Tree
    List [Tree]
    xs
            isLit :: Tree -> Bool
    isLit (Lit BStr
    x) = Bool
    True; isLit Tree
    _ = Bool
    False
            fromLit :: Tree -> BStr
    fromLit (Lit BStr
    x) = BStr
    x

            f :: Tree -> Tree
    f = [Tree] -> Tree
    toList ([Tree] -> Tree) -> (Tree -> [Tree]) -> Tree -> Tree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tree] -> [Tree]
    g ([Tree] -> [Tree]) -> (Tree -> [Tree]) -> Tree -> [Tree]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree -> [Tree]) -> [Tree] -> [Tree]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree -> [Tree]
    fromList ([Tree] -> [Tree]) -> (Tree -> [Tree]) -> Tree -> [Tree]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree -> [Tree]
    fromList

            g :: [Tree] -> [Tree]
    g [] = []
            g (Tree
    x:[Tree]
    xs) | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Tree -> Bool
    isLit Tree
    x = Tree
    x Tree -> [Tree] -> [Tree]
    forall a. a -> [a] -> [a]
    : [Tree] -> [Tree]
    g [Tree]
    xs
            g [Tree]
    xs = [BStr -> Tree
    Lit BStr
    x | let x :: BStr
    x = (Tree -> BStr) -> [Tree] -> BStr
    forall b a. Monoid b => (a -> b) -> [a] -> b
    mconcatMap Tree -> BStr
    fromLit [Tree]
    a, BStr
    x BStr -> BStr -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BStr
    forall a. Monoid a => a
    mempty] [Tree] -> [Tree] -> [Tree]
    forall a. [a] -> [a] -> [a]
    ++ [Tree] -> [Tree]
    g [Tree]
    b
                where ([Tree]
    a,[Tree]
    b) = (Tree -> Bool) -> [Tree] -> ([Tree], [Tree])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Tree -> Bool
    isLit [Tree]
    xs

    treeEval :: Tree -> [BStr]
    treeEval :: Tree -> [BStr]
    treeEval = Tree -> [BStr]
    f (Tree -> [BStr]) -> (Tree -> Tree) -> Tree -> [BStr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree -> Tree
    treeRemoveApp
        where f :: Tree -> [BStr]
    f (Lit BStr
    x) = [BStr
    x]
              f (List [Tree]
    xs) = (Tree -> [BStr]) -> [Tree] -> [BStr]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree -> [BStr]
    f [Tree]
    xs
              f Tree
    _ = []

    ---------------------------------------------------------------------
    -- TEMPLATE DATA TYPE

    -- a tree, and a pre-optimised tree you can create
    data Template = Template Tree (IO Tree)

    {-# NOINLINE treeCache #-}
    treeCache :: Tree -> IO Tree
    treeCache :: Tree -> IO Tree
    treeCache Tree
    t0 = IO (IO Tree) -> IO Tree
    forall a. IO a -> a
    unsafePerformIO (IO (IO Tree) -> IO Tree) -> IO (IO Tree) -> IO Tree
    forall a b. (a -> b) -> a -> b
    $ do
        let files :: [FilePath]
    files = [FilePath
    x | Lam FilePath
    x <- Tree -> [Tree]
    forall on. Uniplate on => on -> [on]
    universe Tree
    t0]
        IORef ([UTCTime], Tree)
    ref <- ([UTCTime], Tree) -> IO (IORef ([UTCTime], Tree))
    forall a. a -> IO (IORef a)
    newIORef ([], Tree -> Tree
    treeOptimise Tree
    t0)
        IO Tree -> IO (IO Tree)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IO Tree -> IO (IO Tree)) -> IO Tree -> IO (IO Tree)
    forall a b. (a -> b) -> a -> b
    $ do
            ([UTCTime]
    old,Tree
    t) <- IORef ([UTCTime], Tree) -> IO ([UTCTime], Tree)
    forall a. IORef a -> IO a
    readIORef IORef ([UTCTime], Tree)
    ref
            [UTCTime]
    new <- [FilePath] -> (FilePath -> IO UTCTime) -> IO [UTCTime]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [FilePath]
    files ((FilePath -> IO UTCTime) -> IO [UTCTime])
    -> (FilePath -> IO UTCTime) -> IO [UTCTime]
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    file ->
                -- the standard getModificationTime message on Windows doesn't say the file
                FilePath -> IO UTCTime
    getModificationTime FilePath
    file IO UTCTime -> (IOException -> IO UTCTime) -> IO UTCTime
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(IOException
    e :: IOException) ->
                    FilePath -> IO UTCTime
    forall a. FilePath -> IO a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> IO UTCTime) -> FilePath -> IO UTCTime
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Failed: getModificationTime on " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    file FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ", " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ IOException -> FilePath
    forall a. Show a => a -> FilePath
    show IOException
    e
            if [UTCTime]
    old [UTCTime] -> [UTCTime] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [UTCTime]
    new then Tree -> IO Tree
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    t else do
                Tree
    t <- Tree -> Tree
    treeOptimise (Tree -> Tree) -> IO Tree -> IO Tree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Tree -> IO Tree
    treeRemoveLam Tree
    t0
                IORef ([UTCTime], Tree) -> ([UTCTime], Tree) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef ([UTCTime], Tree)
    ref ([UTCTime]
    new,Tree
    t)
                Tree -> IO Tree
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    t

    templateTree :: Tree -> Template
    templateTree :: Tree -> Template
    templateTree Tree
    t = Tree -> IO Tree -> Template
    Template Tree
    t (IO Tree -> Template) -> IO Tree -> Template
    forall a b. (a -> b) -> a -> b
    $ Tree -> IO Tree
    treeCache Tree
    t

    templateFile :: FilePath -> Template
    templateFile :: FilePath -> Template
    templateFile = Tree -> Template
    templateTree (Tree -> Template) -> (FilePath -> Tree) -> FilePath -> Template
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Tree
    Lam

    templateMarkup :: Markup -> Template
    templateMarkup :: Markup -> Template
    templateMarkup = LBStr -> Template
    templateStr (LBStr -> Template) -> (Markup -> LBStr) -> Markup -> Template
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> LBStr
    renderMarkup

    templateStr :: LBStr -> Template
    templateStr :: LBStr -> Template
    templateStr = Tree -> Template
    templateTree (Tree -> Template) -> (LBStr -> Tree) -> LBStr -> Template
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tree] -> Tree
    List ([Tree] -> Tree) -> (LBStr -> [Tree]) -> LBStr -> Tree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BStr -> Tree) -> [BStr] -> [Tree]
    forall a b. (a -> b) -> [a] -> [b]
    map BStr -> Tree
    Lit ([BStr] -> [Tree]) -> (LBStr -> [BStr]) -> LBStr -> [Tree]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LBStr -> [BStr]
    lbstrToChunks

    templateApply :: Template -> [(String, Template)] -> Template
    templateApply :: Template -> [(FilePath, Template)] -> Template
    templateApply (Template Tree
    t IO Tree
    _) [(FilePath, Template)]
    args = Tree -> Template
    templateTree (Tree -> Template) -> Tree -> Template
    forall a b. (a -> b) -> a -> b
    $ Tree -> [(BStr, Tree)] -> Tree
    App Tree
    t [(FilePath -> BStr
    bstrPack FilePath
    a, Tree
    b) | (FilePath
    a,Template Tree
    b IO Tree
    _) <- [(FilePath, Template)]
    args]

    templateRender :: Template -> [(String, Template)] -> IO LBStr
    templateRender :: Template -> [(FilePath, Template)] -> IO LBStr
    templateRender (Template Tree
    _ IO Tree
    t) [(FilePath, Template)]
    args = do
        Tree
    t <- IO Tree
    t
        let Template Tree
    t2 IO Tree
    _ = Template -> [(FilePath, Template)] -> Template
    templateApply (Tree -> IO Tree -> Template
    Template Tree
    t (IO Tree -> Template) -> IO Tree -> Template
    forall a b. (a -> b) -> a -> b
    $ Tree -> IO Tree
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    t) [(FilePath, Template)]
    args
        [BStr] -> LBStr
    lbstrFromChunks ([BStr] -> LBStr) -> (Tree -> [BStr]) -> Tree -> LBStr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree -> [BStr]
    treeEval (Tree -> LBStr) -> IO Tree -> IO LBStr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Tree -> IO Tree
    treeRemoveLam Tree
    t2