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
|
|
|
|
|
2020-12-13 20:09:23 +01:00
|
|
|
import Data.Aeson (encode)
|
|
|
|
|
2019-02-15 15:11:31 +01:00
|
|
|
import Blog (Blog(..), Path(..))
|
2019-02-05 11:31:42 +01:00
|
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
2020-05-08 15:51:25 +02:00
|
|
|
import Control.Monad.Reader (ReaderT, asks)
|
2020-01-10 18:58:42 +01:00
|
|
|
import Data.ByteString.Lazy (
|
|
|
|
ByteString, concat, intercalate, fromStrict, readFile, writeFile
|
|
|
|
)
|
2019-02-22 22:02:07 +01:00
|
|
|
import Data.ByteString.Lazy.Char8 (pack)
|
2020-01-10 18:58:42 +01:00
|
|
|
import Data.Text.Encoding (encodeUtf8)
|
2019-02-06 17:16:52 +01:00
|
|
|
import JSON (exportBlog)
|
|
|
|
import Paths_hablo (getDataDir)
|
2019-02-15 15:11:31 +01:00
|
|
|
import Pretty ((.$))
|
2023-08-02 23:40:33 +02:00
|
|
|
import SJW (compile, source)
|
2019-02-06 17:16:52 +01:00
|
|
|
import System.Directory (createDirectoryIfMissing)
|
2020-01-10 18:58:42 +01:00
|
|
|
import System.Exit (die)
|
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
|
|
|
|
2020-01-10 18:58:42 +01:00
|
|
|
object :: [ByteString] -> ByteString
|
|
|
|
object sources = concat [header, intercalate ",\n" sources, footer]
|
2019-02-06 17:16:52 +01:00
|
|
|
where
|
2020-01-10 18:58:42 +01:00
|
|
|
header = "return {\n"
|
|
|
|
footer = "\n};"
|
2019-02-06 17:16:52 +01:00
|
|
|
|
2019-02-22 22:02:07 +01:00
|
|
|
var :: (String, ByteString) -> ByteString
|
2020-01-10 18:58:42 +01:00
|
|
|
var (varName, content) = concat ["\t", pack varName, " : ", content]
|
2019-02-22 22:02:07 +01:00
|
|
|
|
2020-01-10 18:58:42 +01:00
|
|
|
generateConfig :: FilePath -> ReaderT Blog IO ()
|
|
|
|
generateConfig destinationDir = do
|
2020-12-13 20:09:23 +01:00
|
|
|
blogJSON <- asks (encode . exportBlog)
|
2020-05-08 15:51:25 +02:00
|
|
|
remarkablePath <- asks $path.$remarkableConfig
|
2019-02-06 17:16:52 +01:00
|
|
|
liftIO $ do
|
2019-02-22 22:02:07 +01:00
|
|
|
remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
|
2020-01-10 18:58:42 +01:00
|
|
|
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
|
2023-08-02 23:40:33 +02:00
|
|
|
compile (source [destinationDir, "unitJS", habloSources])
|
|
|
|
>>= either abort (output . fst)
|
2020-01-10 18:58:42 +01:00
|
|
|
where
|
|
|
|
output = writeFile (destinationDir </> "hablo.js") . fromStrict . encodeUtf8
|
2023-08-02 23:40:33 +02:00
|
|
|
abort = die . (<> "JS compilation failed\n")
|
2020-01-10 18:58:42 +01:00
|
|
|
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
|
|
generate = do
|
2020-05-09 16:29:26 +02:00
|
|
|
destinationDir <- asks $path.$root.$(</> "js")
|
2020-01-10 18:58:42 +01:00
|
|
|
liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
|
|
|
|
generateConfig destinationDir
|
|
|
|
liftIO $ generateMain destinationDir
|