Compile several JS files into a single one, including the JSON blog DB as well

src/Blog.hs

@@ -16,7 +16,8 @@ import Data.Map (Map)
 import qualified Data.Map as Map (fromList, member)
 import Data.Set (Set)
 import qualified Data.Set as Set (empty, null, singleton, union)
-import System.Directory (doesFileExist, listDirectory, withCurrentDirectory)
+import qualified Files (find)
+import System.Directory (doesFileExist, withCurrentDirectory)
 import System.FilePath ((</>), dropTrailingPathSeparator, splitFileName, takeExtension, takeFileName)
 import System.Posix.Types (FileID)
 import System.Posix.Files (getFileStatus, fileID)
@@ -37,13 +38,9 @@ data Blog = Blog {
 get :: MonadReader Blog m => (Blog -> a) -> m a
 get = (<$> ask)
 
-find :: FilePath -> IO [FilePath]
-find path = 
-  fmap (path </>) <$> listDirectory path
-
 findArticles :: Int -> FilePath -> IO (Map FileID Article)
 findArticles linesCount =
-  find
+  Files.find
   >=> filterM isMarkDownFile
   >=> mapM (Article.at linesCount)
   >=> return . Map.fromList
@@ -54,7 +51,7 @@ findArticles linesCount =
 
 tagged :: Collection -> FilePath -> IO (String, Set FileID)
 tagged collection path = do
-  links <- find path
+  links <- Files.find path
   fileIDs <- forM links $ \link -> do
     fileExists <- doesFileExist link
     if fileExists
@@ -70,7 +67,7 @@ build arguments = withCurrentDirectory root $ do
   let previewLinesCount = Arguments.previewLinesCount arguments
   articles <- findArticles previewLinesCount articlesPath
   tags <- Map.fromList . filter (not . Set.null . snd)
-    <$> (find (articlesPath </> "tags") >>= mapM (articles `tagged`))
+    <$> (Files.find (articlesPath </> "tags") >>= mapM (articles `tagged`))
   customBanner <- mapM readFile $ bannerPath arguments
   customHead <- mapM readFile $ headPath arguments
   return $ Blog {

src/Dom.hs

@@ -85,7 +85,7 @@ page aPage =
           title_ . toHtml =<< Blog.get name
           script_ [src_ "/UnitJS/async.js"] empty
           script_ [src_ "/UnitJS/dom.js"] empty
-          script_ [src_ "/js/main.js"] empty
+          script_ [src_ "/js/hablo.js"] empty
           card aPage
           maybe (toHtml empty) toHtmlRaw =<< Blog.get customHead
         )

src/Files.hs

@@ -0,0 +1,10 @@
+module Files (
+    find
+  ) where
+
+import System.FilePath ((</>))
+import System.Directory (listDirectory)
+
+find :: FilePath -> IO [FilePath]
+find path =
+  fmap (path </>) <$> listDirectory path

src/JS.hs

@@ -1,18 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
 module JS (
-    install
+    generate
   ) where
 
 import Blog (Blog(..))
 import qualified Blog (get)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (ReaderT)
-import Paths_hablo (getDataFileName)
-import System.Directory (copyFile, createDirectoryIfMissing)
+import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
+import qualified Files (find)
+import JSON (exportBlog)
+import Paths_hablo (getDataDir)
+import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>))
+import Prelude hiding (concat, readFile, writeFile)
 
-install :: ReaderT Blog IO ()
-install = do
-  source <- liftIO $ getDataFileName "js/main.js"
+compile :: [ByteString] -> ByteString
+compile sources = concat (header:sources ++ [footer])
+  where
+    header = "(function() {\n"
+    footer = "})();"
+
+generate :: ReaderT Blog IO ()
+generate = do
   destinationDir <- (</> "js") <$> Blog.get root
-  liftIO $ createDirectoryIfMissing False destinationDir
-  liftIO $ copyFile source (destinationDir </> "main.js")
+  blogJSON <- exportBlog
+  liftIO $ do
+    jsFiles <- (</> "js") <$> getDataDir >>= Files.find
+    jsCode <- mapM readFile jsFiles
+    createDirectoryIfMissing False destinationDir
+    writeFile (destinationDir </> "hablo.js") $ compile ("var blog = ":blogJSON:";":jsCode )

src/JSON.hs

@@ -1,24 +1,22 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}
 module JSON (
-    generate
+    exportBlog
   ) where
 
 import Article (Article)
 import qualified Article (Article(..))
 import Blog (Blog)
-import qualified Blog (Blog(..), get)
-import Control.Monad.IO.Class (MonadIO(..))
+import qualified Blog (Blog(..))
 import Control.Monad.Reader (ReaderT, ask)
 import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
-import Data.ByteString.Lazy (writeFile)
+import Data.ByteString.Lazy (ByteString)
 import Data.Map (Map, (!), foldlWithKey, mapKeys, mapWithKey)
 import qualified Data.Map as Map (empty, filter, insert, keys)
 import qualified Data.Set as Set (elems, member)
 import System.FilePath.Posix ((</>), (<.>))
 import System.Posix.Files (modificationTime)
 import System.Posix.Types (EpochTime, FileID)
-import Prelude hiding (writeFile)
 import GHC.Generics
 
 type ArticleID = Int
@@ -53,17 +51,11 @@ export blog fileID article = ArticleExport {
     , tagged = Map.keys . Map.filter (Set.member fileID) $ Blog.tags blog
   }
 
-exportBlog :: ReaderT Blog IO BlogDB
+exportBlog :: ReaderT Blog IO ByteString
 exportBlog = do
   blog <- ask
   let reindex = remap $ Blog.articles blog
-  return $ BlogDB {
+  return . encode $ BlogDB {
         articles = mapKeys (reindex !) $ mapWithKey (export blog) (Blog.articles blog)
       , tags = fmap (reindex !) . Set.elems <$> Blog.tags blog
     }
-
-generate :: ReaderT Blog IO ()
-generate = do
-  path <- Blog.get Blog.root
-  jsonContent <- exportBlog
-  liftIO $ writeFile (path </> "articles.json") (encode jsonContent)

src/Main.hs

@@ -3,8 +3,7 @@ module Main where
 import qualified Arguments (get)
 import qualified Blog (build)
 import qualified HTML (generate)
-import qualified JS (install)
-import qualified JSON (generate)
+import qualified JS (generate)
 import Control.Monad.Reader (runReaderT)
 
 main :: IO ()
@@ -13,6 +12,5 @@ main = do
   >>= Blog.build
   >>= runReaderT (do
     HTML.generate
-    JSON.generate
-    JS.install
+    JS.generate
   )