hablo-1.0.0.0: src/Blog/Path.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Blog.Path (
      Path(..)
    , build
  ) where

import Arguments (Arguments)
import qualified Arguments as Arguments (Arguments(..))
import Data.Aeson (ToJSON(..), (.=), pairs)
import Data.Monoid ((<>))
import Files (File(..), filePath)
import GHC.Generics (Generic)

data Path = Path {
      articlesPath :: FilePath
    , commentsAt :: Maybe String
    , 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 :: FilePath -> Arguments -> IO Path
build root arguments = do
  articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
  pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments
  remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
  return $ Path {
      articlesPath, commentsAt, pagesPath, remarkableConfig, root
    }
  where
    commentsAt = Arguments.commentsAt arguments