Require SJW, generate blog config as a standalone file because it's always nice to have (if you want to expose its content as a read-only API) and handle hablo.js compilation with SJW

This commit is contained in:
Tissevert 2020-01-10 18:58:42 +01:00
parent add68897ad
commit fd714e93ff
2 changed files with 33 additions and 15 deletions

View file

@ -59,6 +59,7 @@ executable hablo
, template >= 0.2.0 && < 0.3
, text >= 1.2.3 && < 1.3
, time >= 1.8.0 && < 1.9
, SJW >= 0.1.2 && < 0.2
, unix >= 2.7.2 && < 2.8
ghc-options: -Wall -dynamic
hs-source-dirs: src

View file

@ -7,34 +7,51 @@ 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 (
ByteString, concat, intercalate, fromStrict, readFile, writeFile
)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Files (find)
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)
compile :: [ByteString] -> ByteString
compile sources = concat (header:sources ++ [footer])
object :: [ByteString] -> ByteString
object sources = concat [header, intercalate ",\n" sources, footer]
where
header = "(function() {\n"
footer = "})();"
header = "return {\n"
footer = "\n};"
var :: (String, ByteString) -> ByteString
var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"]
var (varName, content) = concat ["\t", pack varName, " : ", content]
generate :: ReaderT Blog IO ()
generate = do
destinationDir <- (</> "js") <$> (Blog.get $path.$root)
generateConfig :: FilePath -> ReaderT Blog IO ()
generateConfig destinationDir = do
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 )
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 <- (</> "js") <$> (Blog.get $path.$root)
liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
generateConfig destinationDir
liftIO $ generateMain destinationDir