60 lines
1.9 KiB
Haskell
60 lines
1.9 KiB
Haskell
{-# 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)
|
|
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
|
|
compile (source [destinationDir, "unitJS", habloSources])
|
|
>>= either abort (output . fst)
|
|
where
|
|
output = writeFile (destinationDir </> "hablo.js") . fromStrict . encodeUtf8
|
|
abort = die . (<> "JS compilation failed\n")
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
generate = do
|
|
destinationDir <- asks $path.$root.$(</> "js")
|
|
liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
|
|
generateConfig destinationDir
|
|
liftIO $ generateMain destinationDir
|