Refactor code to get rid of fake *Export types

src/Blog/Path.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Blog.Path (
       Path(..)
     , build
@@ -6,7 +8,9 @@ module Blog.Path (
 
 import Arguments (Arguments)
 import qualified Arguments as Arguments (Arguments(..))
+import Data.Aeson (ToJSON(..), (.=), pairs)
 import Files (File(..), absolute, filePath)
+import GHC.Generics (Generic)
 
 data Path = Path {
       articlesPath :: FilePath
@@ -14,7 +18,14 @@ data Path = Path {
     , pagesPath :: Maybe FilePath
     , remarkableConfig :: Maybe FilePath
     , root :: FilePath
-  }
+  } deriving Generic
+
+instance ToJSON Path where
+  toEncoding (Path {articlesPath, commentsAt, pagesPath}) = pairs (
+        "articlesPath" .= articlesPath
+      <> "commentsAt" .= commentsAt
+      <> "pagesPath" .= pagesPath
+    )
 
 build :: Arguments -> IO Path
 build arguments = do

src/Blog/Skin.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Blog.Skin (
       Skin(..)
     , build
@@ -7,8 +9,10 @@ module Blog.Skin (
 import Arguments (Arguments)
 import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArticlesCount, previewLinesCount)
 import Control.Monad (filterM)
+import Data.Aeson (ToJSON(..), (.=), pairs)
 import Data.Maybe (listToMaybe)
 import Files (absoluteLink)
+import GHC.Generics (Generic)
 import Prelude hiding (head)
 import System.Directory (doesFileExist)
 import System.FilePath ((</>), (<.>))
@@ -20,7 +24,13 @@ data Skin = Skin {
     , head :: Maybe String
     , previewArticlesCount :: Int
     , previewLinesCount :: Int
-  }
+  } deriving Generic
+
+instance ToJSON Skin where
+  toEncoding (Skin {previewArticlesCount, previewLinesCount}) = pairs (
+        "previewArticlesCount" .= previewArticlesCount
+      <> "previewLinesCount" .= previewLinesCount
+    )
 
 findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
 findImage _ (Just path) = return . Just $ absoluteLink path

src/Blog/Wording.hs

@@ -7,12 +7,13 @@ module Blog.Wording (
 
 import Arguments (Arguments(..))
 import Control.Monad (foldM)
+import Data.Aeson (ToJSON(..), (.=), object, pairs)
 import Data.List (intercalate)
 import Data.Map (Map, (!))
 import qualified Data.Map as Map (empty, fromList, map, union)
 import Data.Text (Text)
 import qualified Data.Text as Text (pack, unpack)
-import Data.Text.Template (Template, renderA, templateSafe)
+import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
 import Paths_hablo (getDataFileName)
 import Text.ParserCombinators.Parsec (
       Parser
@@ -32,18 +33,25 @@ data Wording = Wording {
     , tagsList :: Text
   }
 
-keys :: [Parser String]
+keys :: [String]
-keys = try . string <$> [
+keys = [
-      "allLink"
+      "allLink", "allPage", "allTaggedPage", "commentsSection"
-    , "allPage"
+    , "latestLink", "latestPage", "latestTaggedPage", "tagsList"
-    , "allTaggedPage"
-    , "commentsSection"
-    , "latestLink"
-    , "latestPage"
-    , "latestTaggedPage"
-    , "tagsList"
   ]
 
+values :: [Wording -> Text]
+values = [
+      allLink, allPage, showTemplate . allTaggedPage, commentsSection
+    , latestLink, latestPage, showTemplate . latestTaggedPage, tagsList
+  ]
+
+texts :: Wording -> [Text]
+texts wording = ($ wording) <$> values
+
+instance ToJSON Wording where
+  toJSON = object . zipWith (.=) (Text.pack <$> keys) . texts
+  toEncoding = pairs . foldl (<>) mempty . zipWith (.=) (Text.pack <$> keys) . texts
+
 addWording :: Map String Text -> FilePath -> IO (Map String Text)
 addWording currentWording wordingFile = do
   parsed <- parse wordingP wordingFile <$> readFile wordingFile
@@ -54,7 +62,7 @@ addWording currentWording wordingFile = do
 wordingP :: Parser (Map String Text)
 wordingP = Map.map Text.pack . Map.fromList <$> (many eol *> line `endBy` (many1 eol))
   where
-    line = (,) <$> (choice keys <* equal) <*> many (noneOf "\r\n")
+    line = (,) <$> (choice (try . string <$> keys) <* equal) <*> many (noneOf "\r\n")
     equal = many (char ' ') *> char '=' *> many (char ' ')
     eol = try (string "\r\n") <|> string "\r" <|> string "\n"
 

src/JSON.hs

@@ -6,16 +6,14 @@ module JSON (
 
 import Article (Article)
 import qualified Article (Article(..))
-import Blog (Blog)
+import Blog (Blog, Path, Skin, Wording)
-import qualified Blog (Blog(..), Path(..), Skin(..), Wording(..))
+import qualified Blog (Blog(..))
 import Control.Monad.Reader (ReaderT, ask)
 import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
 import Data.ByteString.Lazy (ByteString)
 import Data.Map (Map, mapWithKey)
 import qualified Data.Map as Map (filter, keys)
 import qualified Data.Set as Set (elems, member)
-import Data.Text (Text)
-import Data.Text.Template (showTemplate)
 import GHC.Generics
 
 data ArticleExport = ArticleExport {
@@ -28,50 +26,19 @@ data ArticleExport = ArticleExport {
 instance ToJSON ArticleExport where
   toEncoding = genericToEncoding defaultOptions
 
-data PathExport = PathExport {
-      articlesPath :: FilePath
-    , commentsAt :: Maybe String
-    , pagesPath :: Maybe FilePath
-  } deriving (Generic)
-
-instance ToJSON PathExport where
-  toEncoding = genericToEncoding defaultOptions
-
-data SkinExport = SkinExport {
-      previewArticlesCount :: Int
-    , previewLinesCount :: Int
-  } deriving (Generic)
-
-instance ToJSON SkinExport where
-  toEncoding = genericToEncoding defaultOptions
-
-data WordingExport = WordingExport {
-      allLink :: Text
-    , allPage :: Text
-    , allTaggedPage :: Text
-    , commentsSection :: Text
-    , latestLink :: Text
-    , latestPage :: Text
-    , latestTaggedPage :: Text
-    , tagsList :: Text
-  } deriving (Generic)
-
-instance ToJSON WordingExport where
-  toEncoding = genericToEncoding defaultOptions
-
 data BlogDB = BlogDB {
       articles :: Map String ArticleExport
-    , path :: PathExport
+    , path :: Path
-    , skin :: SkinExport
+    , skin :: Skin
     , tags :: Map String [String]
-    , wording :: WordingExport
+    , wording :: Wording
   } deriving (Generic)
 
 instance ToJSON BlogDB where
   toEncoding = genericToEncoding defaultOptions
 
-export :: Blog -> String -> Article -> ArticleExport
+exportArticle :: Blog -> String -> Article -> ArticleExport
-export blog key article = ArticleExport {
+exportArticle blog key article = ArticleExport {
       title = Article.title article
     , bodyOffset = Article.bodyOffset article
     , metadata = Article.metadata article
@@ -82,25 +49,9 @@ exportBlog :: ReaderT Blog IO ByteString
 exportBlog = do
   blog <- ask
   return . encode $ BlogDB {
-        articles = mapWithKey (export blog) $ Blog.articles blog
+        articles = mapWithKey (exportArticle blog) $ Blog.articles blog
-      , path = PathExport {
+      , path = Blog.path blog
-              articlesPath = Blog.articlesPath $ Blog.path blog
+      , skin = Blog.skin blog
-            , commentsAt = Blog.commentsAt $ Blog.path blog
-            , pagesPath = Blog.pagesPath $ Blog.path blog
-          }
-      , skin = SkinExport {
-              previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog
-            , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog
-          }
       , tags = Set.elems <$> Blog.tags blog
-      , wording = WordingExport {
+      , wording = Blog.wording blog
-              allLink = Blog.allLink $ Blog.wording blog
-            , allPage = Blog.allPage $ Blog.wording blog
-            , allTaggedPage = showTemplate . Blog.allTaggedPage $ Blog.wording blog
-            , commentsSection = Blog.commentsSection $ Blog.wording blog
-            , latestLink = Blog.latestLink $ Blog.wording blog
-            , latestPage = Blog.latestPage $ Blog.wording blog
-            , latestTaggedPage = showTemplate . Blog.latestTaggedPage $ Blog.wording blog
-            , tagsList = Blog.tagsList $ Blog.wording blog
-          }
     }