{-# 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,Data,Show)


-- | Turn all Lam into Var/Lit
treeRemoveLam :: Tree -> IO Tree
treeRemoveLam = transformM f
    where
        f (Lam file) = List . parse <$> bstrReadFile file
        f x = pure x

        parse x | Just (a,b) <- bstrSplitInfix (bstrPack "#{") x
                , Just (b,c) <- bstrSplitInfix (bstrPack "}") b
                = Lit a : Var b : parse c
        parse x = [Lit x]

treeRemoveApp :: Tree -> Tree
treeRemoveApp = f []
    where
        f seen (App t xs) = f (xs ++ seen) t
        f seen (Var x) | Just t <- lookup x seen = f seen t
        f seen x = descend (f seen) x

treeOptimise :: Tree -> Tree
treeOptimise = transform f . treeRemoveApp
    where
        fromList (List xs) = xs; fromList x = [x]
        toList [x] = x; toList xs = List xs
        isLit (Lit x) = True; isLit _ = False
        fromLit (Lit x) = x

        f = toList . g . concatMap fromList . fromList

        g [] = []
        g (x:xs) | not $ isLit x = x : g xs
        g xs = [Lit x | let x = mconcatMap fromLit a, x /= mempty] ++ g b
            where (a,b) = span isLit xs

treeEval :: Tree -> [BStr]
treeEval = f . treeRemoveApp
    where f (Lit x) = [x]
          f (List xs) = concatMap f xs
          f _ = []


---------------------------------------------------------------------
-- 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 t0 = unsafePerformIO $ do
    let files = [x | Lam x <- universe t0]
    ref <- newIORef ([], treeOptimise t0)
    pure $ do
        (old,t) <- readIORef ref
        new <- forM files $ \file ->
            -- the standard getModificationTime message on Windows doesn't say the file
            getModificationTime file `catch` \(e :: IOException) ->
                fail $ "Failed: getModificationTime on " ++ file ++ ", " ++ show e
        if old == new then pure t else do
            t <- treeOptimise <$> treeRemoveLam t0
            writeIORef ref (new,t)
            pure t

templateTree :: Tree -> Template
templateTree t = Template t $ treeCache t

templateFile :: FilePath -> Template
templateFile = templateTree . Lam

templateMarkup :: Markup -> Template
templateMarkup = templateStr . renderMarkup

templateStr :: LBStr -> Template
templateStr = templateTree . List . map Lit . lbstrToChunks

templateApply :: Template -> [(String, Template)] -> Template
templateApply (Template t _) args = templateTree $ App t [(bstrPack a, b) | (a,Template b _) <- args]

templateRender :: Template -> [(String, Template)] -> IO LBStr
templateRender (Template _ t) args = do
    t <- t
    let Template t2 _ = templateApply (Template t $ pure t) args
    lbstrFromChunks . treeEval <$> treeRemoveLam t2