hablo-1.1.0.1: src/JS.hs

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

import Data.Aeson (encode)

import Blog (Blog(..), Path(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT, asks)
import Data.ByteString.Lazy (
    ByteString, concat, intercalate, fromStrict, readFile, writeFile
  )
import Data.ByteString.Lazy.Char8 (pack)
import Data.Text.Encoding (encodeUtf8)
import JSON (exportBlog)
import Paths_hablo (getDataDir)
import Pretty ((.$))
import SJW (compile, source, sourceCode)
import System.Directory (createDirectoryIfMissing)
import System.Exit (die)
import System.FilePath ((</>))
import Prelude hiding (concat, readFile, writeFile)

object :: [ByteString] -> ByteString
object sources = concat [header, intercalate ",\n" sources, footer]
  where
    header = "return {\n"
    footer = "\n};"

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

generateConfig :: FilePath -> ReaderT Blog IO ()
generateConfig destinationDir = do
  blogJSON <- asks (encode . exportBlog)
  remarkablePath <- asks $path.$remarkableConfig
  liftIO $ do
    remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
    let jsVars = [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
    writeFile configModule . object $ var <$> jsVars
  where
    configModule = destinationDir </> "Hablo" </> "Config.js"

generateMain :: FilePath -> IO ()
generateMain destinationDir = do
  habloSources <- (</> "js") <$> getDataDir
  result <- compile $ source [destinationDir, "unitJS", habloSources]
  maybe (die "JS compilation failed\n") output =<< sourceCode result
  where
    output = writeFile (destinationDir </> "hablo.js") . fromStrict . encodeUtf8

generate :: ReaderT Blog IO ()
generate = do
  destinationDir <- asks $path.$root.$(</> "js")
  liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
  generateConfig destinationDir
  liftIO $ generateMain destinationDir