hablo/src/JS.hs

{-# LANGUAGE OverloadedStrings #-}
module JS (
    generate
  ) where

import Blog (Blog(..), Path(..))
import qualified Blog (get)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT)
import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Files (find)
import JSON (exportBlog)
import Paths_hablo (getDataDir)
import Pretty ((.$))
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import Prelude hiding (concat, readFile, writeFile)

compile :: [ByteString] -> ByteString
compile sources = concat (header:sources ++ [footer])
  where
    header = "(function() {\n"
    footer = "})();"

var :: (String, ByteString) -> ByteString
var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"]

generate :: ReaderT Blog IO ()
generate = do
  destinationDir <- (</> "js") <$> (Blog.get $path.$root)
  blogJSON <- exportBlog
  remarkablePath <- Blog.get $path.$remarkableConfig
  liftIO $ do
    remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
    let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
    jsFiles <- (</> "js") <$> getDataDir >>= Files.find
    jsCode <- mapM readFile jsFiles
    createDirectoryIfMissing False destinationDir
    writeFile (destinationDir </> "hablo.js") $ compile (jsVars ++ jsCode )