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 , template >= 0.2.0 && < 0.3
, text >= 1.2.3 && < 1.3 , text >= 1.2.3 && < 1.3
, time >= 1.8.0 && < 1.9 , time >= 1.8.0 && < 1.9
, SJW >= 0.1.2 && < 0.2
, unix >= 2.7.2 && < 2.8 , unix >= 2.7.2 && < 2.8
ghc-options: -Wall -dynamic ghc-options: -Wall -dynamic
hs-source-dirs: src hs-source-dirs: src

View file

@ -7,34 +7,51 @@ import Blog (Blog(..), Path(..))
import qualified Blog (get) import qualified Blog (get)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT) 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 Data.ByteString.Lazy.Char8 (pack)
import qualified Files (find) import Data.Text.Encoding (encodeUtf8)
import JSON (exportBlog) import JSON (exportBlog)
import Paths_hablo (getDataDir) import Paths_hablo (getDataDir)
import Pretty ((.$)) import Pretty ((.$))
import SJW (compile, source, sourceCode)
import System.Directory (createDirectoryIfMissing) import System.Directory (createDirectoryIfMissing)
import System.Exit (die)
import System.FilePath ((</>)) import System.FilePath ((</>))
import Prelude hiding (concat, readFile, writeFile) import Prelude hiding (concat, readFile, writeFile)
compile :: [ByteString] -> ByteString object :: [ByteString] -> ByteString
compile sources = concat (header:sources ++ [footer]) object sources = concat [header, intercalate ",\n" sources, footer]
where where
header = "(function() {\n" header = "return {\n"
footer = "})();" footer = "\n};"
var :: (String, ByteString) -> ByteString 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 () generateConfig :: FilePath -> ReaderT Blog IO ()
generate = do generateConfig destinationDir = do
destinationDir <- (</> "js") <$> (Blog.get $path.$root)
blogJSON <- exportBlog blogJSON <- exportBlog
remarkablePath <- Blog.get $path.$remarkableConfig remarkablePath <- Blog.get $path.$remarkableConfig
liftIO $ do liftIO $ do
remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)] let jsVars = [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
jsFiles <- (</> "js") <$> getDataDir >>= Files.find writeFile configModule . object $ var <$> jsVars
jsCode <- mapM readFile jsFiles where
createDirectoryIfMissing False destinationDir configModule = destinationDir </> "Hablo" </> "Config.js"
writeFile (destinationDir </> "hablo.js") $ compile (jsVars ++ jsCode )
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