{-# LANGUAGE ViewPatterns #-}
module General.Template(runTemplate) where
import System.FilePath.Posix
import Control.Exception.Extra
import Data.Char
import Data.Time
import System.IO.Unsafe
import General.Paths
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Language.Javascript.DGTable as DGTable
import qualified Language.Javascript.Flot as Flot
import qualified Language.Javascript.JQuery as JQuery
libraries =
[("jquery.js", JQuery.file)
,("jquery.dgtable.js", DGTable.file)
,("jquery.flot.js", Flot.file Flot.Flot)
,("jquery.flot.stack.js", Flot.file Flot.FlotStack)
]
runTemplate :: (FilePath -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString
runTemplate ask = lbsMapLinesIO f
where
link = LBS.pack "<link href=\""
script = LBS.pack "<script src=\""
f x | Just file <- LBS.stripPrefix script y = do res <- grab file; pure $ LBS.pack "<script>\n" `LBS.append` res `LBS.append` LBS.pack "\n</script>"
| Just file <- LBS.stripPrefix link y = do res <- grab file; pure $ LBS.pack "<style type=\"text/css\">\n" `LBS.append` res `LBS.append` LBS.pack "\n</style>"
| otherwise = pure x
where
y = LBS.dropWhile isSpace x
grab = asker . takeWhile (/= '\"') . LBS.unpack
asker o@(splitFileName -> ("lib/",x)) = case lookup x libraries of
Just act -> LBS.readFile =<< act
Nothing -> errorIO $ "Template library, unknown library: " ++ o
asker "rattle.js" = readDataFileHTML "rattle.js"
asker "data/metadata.js" = do
time <- getCurrentTime
pure $ LBS.pack $
"var version = " ++ show rattleVersionString ++
"\nvar generated = " ++ show (formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) time)
asker x = ask x
lbsMapLinesIO :: (LBS.ByteString -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString
lbsMapLinesIO f = pure . LBS.unlines . map (unsafePerformIO . f) . LBS.lines