2019-02-06 17:16:52 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2019-02-05 11:31:42 +01:00
|
|
|
module JS (
|
2019-02-06 17:16:52 +01:00
|
|
|
generate
|
2019-02-05 11:31:42 +01:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Blog (Blog(..))
|
|
|
|
import qualified Blog (get)
|
|
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
|
|
import Control.Monad.Reader (ReaderT)
|
2019-02-06 17:16:52 +01:00
|
|
|
import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
|
|
|
|
import qualified Files (find)
|
|
|
|
import JSON (exportBlog)
|
|
|
|
import Paths_hablo (getDataDir)
|
|
|
|
import System.Directory (createDirectoryIfMissing)
|
2019-02-05 11:31:42 +01:00
|
|
|
import System.FilePath ((</>))
|
2019-02-06 17:16:52 +01:00
|
|
|
import Prelude hiding (concat, readFile, writeFile)
|
2019-02-05 11:31:42 +01:00
|
|
|
|
2019-02-06 17:16:52 +01:00
|
|
|
compile :: [ByteString] -> ByteString
|
|
|
|
compile sources = concat (header:sources ++ [footer])
|
|
|
|
where
|
|
|
|
header = "(function() {\n"
|
|
|
|
footer = "})();"
|
|
|
|
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
|
|
generate = do
|
2019-02-05 11:31:42 +01:00
|
|
|
destinationDir <- (</> "js") <$> Blog.get root
|
2019-02-06 17:16:52 +01:00
|
|
|
blogJSON <- exportBlog
|
|
|
|
liftIO $ do
|
|
|
|
jsFiles <- (</> "js") <$> getDataDir >>= Files.find
|
|
|
|
jsCode <- mapM readFile jsFiles
|
|
|
|
createDirectoryIfMissing False destinationDir
|
|
|
|
writeFile (destinationDir </> "hablo.js") $ compile ("var blog = ":blogJSON:";":jsCode )
|