{-# 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