{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
#ifdef FILE_EMBED
{-# LANGUAGE TemplateHaskell #-}
#endif
module General.Template(runTemplate) where
import System.FilePath.Posix
import Control.Exception.Extra
import Data.Char
import Data.Time
import System.IO.Unsafe
import Development.Shake.Internal.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
#ifdef FILE_EMBED
import Data.FileEmbed
import Language.Haskell.TH.Syntax ( runIO )
#endif
#ifdef FILE_EMBED
#define FILE(x) (pure (LBS.fromStrict $(embedFile =<< runIO (x))))
#else
#define FILE(x) (LBS.readFile =<< (x))
#endif
libraries :: [(String, IO LBS.ByteString)]
libraries :: [(String, IO ByteString)]
libraries =
[(String
"jquery.js", FILE(JQuery.file))
,(String
"jquery.dgtable.js", FILE(DGTable.file))
,(String
"jquery.flot.js", FILE(Flot.file Flot.Flot))
,(String
"jquery.flot.stack.js", FILE(Flot.file Flot.FlotStack))
]
runTemplate :: (FilePath -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString
runTemplate :: (String -> IO ByteString) -> ByteString -> IO ByteString
runTemplate String -> IO ByteString
ask = (ByteString -> IO ByteString) -> ByteString -> IO ByteString
lbsMapLinesIO ByteString -> IO ByteString
f
where
link :: ByteString
link = String -> ByteString
LBS.pack String
"<link href=\""
script :: ByteString
script = String -> ByteString
LBS.pack String
"<script src=\""
f :: ByteString -> IO ByteString
f ByteString
x | Just ByteString
file <- ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix ByteString
script ByteString
y = do ByteString
res <- ByteString -> IO ByteString
grab ByteString
file; forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ByteString
LBS.pack String
"<script>\n" ByteString -> ByteString -> ByteString
`LBS.append` ByteString
res ByteString -> ByteString -> ByteString
`LBS.append` String -> ByteString
LBS.pack String
"\n</script>"
| Just ByteString
file <- ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix ByteString
link ByteString
y = do ByteString
res <- ByteString -> IO ByteString
grab ByteString
file; forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ByteString
LBS.pack String
"<style type=\"text/css\">\n" ByteString -> ByteString -> ByteString
`LBS.append` ByteString
res ByteString -> ByteString -> ByteString
`LBS.append` String -> ByteString
LBS.pack String
"\n</style>"
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x
where
y :: ByteString
y = (Char -> Bool) -> ByteString -> ByteString
LBS.dropWhile Char -> Bool
isSpace ByteString
x
grab :: ByteString -> IO ByteString
grab = String -> IO ByteString
asker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\"') forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
LBS.unpack
asker :: String -> IO ByteString
asker o :: String
o@(String -> (String, String)
splitFileName -> (String
"lib/",String
x)) =
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, IO ByteString)]
libraries of
Maybe (IO ByteString)
Nothing -> forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ String
"Template library, unknown library: " forall a. [a] -> [a] -> [a]
++ String
o
Just IO ByteString
act -> IO ByteString
act
asker String
"shake.js" = String -> IO ByteString
readDataFileHTML String
"shake.js"
asker String
"data/metadata.js" = do
UTCTime
time <- IO UTCTime
getCurrentTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ByteString
LBS.pack forall a b. (a -> b) -> a -> b
$
String
"var version = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
shakeVersionString forall a. [a] -> [a] -> [a]
++
String
"\nvar generated = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (Maybe String -> String
iso8601DateFormat (forall a. a -> Maybe a
Just String
"%H:%M:%S")) UTCTime
time)
asker String
x = String -> IO ByteString
ask String
x
lbsMapLinesIO :: (LBS.ByteString -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString
lbsMapLinesIO :: (ByteString -> IO ByteString) -> ByteString -> IO ByteString
lbsMapLinesIO ByteString -> IO ByteString
f = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.lines
lbsStripPrefix :: LBS.ByteString -> LBS.ByteString -> Maybe LBS.ByteString
lbsStripPrefix :: ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix ByteString
prefix ByteString
text = if ByteString
a forall a. Eq a => a -> a -> Bool
== ByteString
prefix then forall a. a -> Maybe a
Just ByteString
b else forall a. Maybe a
Nothing
where (ByteString
a,ByteString
b) = Int64 -> ByteString -> (ByteString, ByteString)
LBS.splitAt (ByteString -> Int64
LBS.length ByteString
prefix) ByteString
text