    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ViewPatterns #-}

    -- Keep using iso8601DateFormat, since the alternative was introduced in time-1.9
    -- while GHC 8.6 still has time-1.8.
    -- Safe once we no longer support GHC 8.6.
    {-# 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

    {- HLINT ignore "Redundant bracket" -} -- a result of CPP expansion

    -- Very hard to abstract over TH, so we do it with CPP
    #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))
        ]

    -- | 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 :: (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; ByteString -> IO ByteString
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    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; ByteString -> IO ByteString
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    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 = ByteString -> IO ByteString
    forall a. a -> IO a
    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 (String -> IO ByteString)
    -> (ByteString -> String) -> ByteString -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\"') (String -> String)
    -> (ByteString -> String) -> ByteString -> String
    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 String -> [(String, IO ByteString)] -> Maybe (IO ByteString)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    x [(String, IO ByteString)]
    libraries of
                    Maybe (IO ByteString)
    Nothing -> String -> IO ByteString
    forall a. Partial => String -> IO a
    errorIO (String -> IO ByteString) -> String -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "Template library, unknown library: " String -> String -> String
    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
                ByteString -> IO ByteString
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    LBS.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                    String
    "var version = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    shakeVersionString String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                    String
    "\nvar generated = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale (Maybe String -> String
    iso8601DateFormat (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "%H:%M:%S")) UTCTime
    time)
            asker String
    x = String -> IO ByteString
    ask String
    x

    -- Perform a mapM on each line and put the result back together again
    lbsMapLinesIO :: (LBS.ByteString -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString
    -- If we do the obvious @fmap LBS.unlines . mapM f@ then all the monadic actions are run on all the lines
    -- before it starts producing the lazy result, killing streaming and having more stack usage.
    -- The real solution (albeit with too many dependencies for something small) is a streaming library,
    -- but a little bit of unsafePerformIO does the trick too.
    lbsMapLinesIO :: (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    lbsMapLinesIO ByteString -> IO ByteString
    f = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString -> IO ByteString)
    -> (ByteString -> ByteString) -> ByteString -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    LBS.unlines ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (IO ByteString -> ByteString
    forall a. IO a -> a
    unsafePerformIO (IO ByteString -> ByteString)
    -> (ByteString -> IO ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> IO ByteString
    f) ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    LBS.lines

    ---------------------------------------------------------------------
    -- 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 ByteString
    prefix 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 (ByteString
    a,ByteString
    b) = Int64 -> ByteString -> (ByteString, ByteString)
    LBS.splitAt (ByteString -> Int64
    LBS.length ByteString
    prefix) ByteString
    text