{-# LANGUAGE ViewPatterns #-}

module General.Template(runTemplate) where

import System.FilePath.Posix
import Control.Exception.Extra
import Control.Monad.IO.Class
import Data.Char
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Language.Javascript.Flot as Flot
import qualified Language.Javascript.JQuery as JQuery


libraries :: [([Char], IO [Char])]
libraries =
    [("jquery.js", IO [Char]
JQuery.file)
    ,("jquery.flot.js", Flot -> IO [Char]
Flot.file Flot
Flot.Flot)
    ,("jquery.flot.stack.js", Flot -> IO [Char]
Flot.file Flot
Flot.FlotStack)
    ]

-- | Template Engine. Perform the following replacements on a line basis:
--
-- * <script src="foo"></script> ==> <script>[[foo]]</script>
--
-- * <link href="foo" rel="stylesheet" type="text/css" /> ==> <style type="text/css">[[foo]]</style>
runTemplate :: (Functor m, MonadIO m) => (FilePath -> m LBS.ByteString) -> LBS.ByteString -> m LBS.ByteString
-- Functor constraint is required for GHC 7.8 and before
runTemplate :: ([Char] -> m ByteString) -> ByteString -> m ByteString
runTemplate ask :: [Char] -> m ByteString
ask = ([ByteString] -> ByteString) -> m [ByteString] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
LBS.unlines (m [ByteString] -> m ByteString)
-> (ByteString -> m [ByteString]) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> m ByteString) -> [ByteString] -> m [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> m ByteString
f ([ByteString] -> m [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.lines
    where
        link :: ByteString
link = [Char] -> ByteString
LBS.pack "<link href=\""
        script :: ByteString
script = [Char] -> ByteString
LBS.pack "<script src=\""

        f :: ByteString -> m ByteString
f x :: ByteString
x | Just file :: ByteString
file <- ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix ByteString
script ByteString
y = do ByteString
res <- ByteString -> m ByteString
grab ByteString
file; ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
LBS.pack "<script>\n" ByteString -> ByteString -> ByteString
`LBS.append` ByteString
res ByteString -> ByteString -> ByteString
`LBS.append` [Char] -> ByteString
LBS.pack "\n</script>"
            | Just file :: ByteString
file <- ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix ByteString
link ByteString
y = do ByteString
res <- ByteString -> m ByteString
grab ByteString
file; ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
LBS.pack "<style type=\"text/css\">\n" ByteString -> ByteString -> ByteString
`LBS.append` ByteString
res ByteString -> ByteString -> ByteString
`LBS.append` [Char] -> ByteString
LBS.pack "\n</style>"
            | Bool
otherwise = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
            where
                y :: ByteString
y = (Char -> Bool) -> ByteString -> ByteString
LBS.dropWhile Char -> Bool
isSpace ByteString
x
                grab :: ByteString -> m ByteString
grab = [Char] -> m ByteString
asker ([Char] -> m ByteString)
-> (ByteString -> [Char]) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\"') ([Char] -> [Char])
-> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
LBS.unpack

        asker :: [Char] -> m ByteString
asker o :: [Char]
o@([Char] -> ([Char], [Char])
splitFileName -> ("lib/",x :: [Char]
x)) = case [Char] -> [([Char], IO [Char])] -> Maybe (IO [Char])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
x [([Char], IO [Char])]
libraries of
            Just act :: IO [Char]
act -> IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
LBS.readFile ([Char] -> IO ByteString) -> IO [Char] -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Char]
act
            Nothing -> IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
forall a. Partial => [Char] -> IO a
errorIO ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ "Template library, unknown library: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
o
        asker x :: [Char]
x = [Char] -> m ByteString
ask [Char]
x


---------------------------------------------------------------------
-- COMPATIBILITY

-- available in bytestring-0.10.8.0, GHC 8.0 and above
-- alternative implementation below
lbsStripPrefix :: LBS.ByteString -> LBS.ByteString -> Maybe LBS.ByteString
lbsStripPrefix :: ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix prefix :: ByteString
prefix text :: ByteString
text = if ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
prefix then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b else Maybe ByteString
forall a. Maybe a
Nothing
    where (a :: ByteString
a,b :: ByteString
b) = Int64 -> ByteString -> (ByteString, ByteString)
LBS.splitAt (ByteString -> Int64
LBS.length ByteString
prefix) ByteString
text