From 7e875efc57211959acc14420a7efe25b9fff6738 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Wed, 6 Feb 2019 17:16:52 +0100 Subject: [PATCH] Compile several JS files into a single one, including the JSON blog DB as well --- src/Blog.hs | 13 +++++-------- src/Dom.hs | 2 +- src/Files.hs | 10 ++++++++++ src/JS.hs | 30 ++++++++++++++++++++++-------- src/JSON.hs | 18 +++++------------- src/Main.hs | 6 ++---- 6 files changed, 45 insertions(+), 34 deletions(-) create mode 100644 src/Files.hs diff --git a/src/Blog.hs b/src/Blog.hs index 092ae69..b69629a 100644 --- a/src/Blog.hs +++ b/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 { diff --git a/src/Dom.hs b/src/Dom.hs index fabe298..c07e0b9 100644 --- a/src/Dom.hs +++ b/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 ) diff --git a/src/Files.hs b/src/Files.hs new file mode 100644 index 0000000..e12f464 --- /dev/null +++ b/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 diff --git a/src/JS.hs b/src/JS.hs index 435129a..8ab5cdf 100644 --- a/src/JS.hs +++ b/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 ) diff --git a/src/JSON.hs b/src/JSON.hs index f4ee377..9d4d30d 100644 --- a/src/JSON.hs +++ b/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) diff --git a/src/Main.hs b/src/Main.hs index 775acb3..4a48c93 100644 --- a/src/Main.hs +++ b/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 )