Path.hs

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

import Arguments (Arguments)
import qualified Arguments as Arguments (Arguments(..))
import Control.Monad (join)
import Control.Monad.Except (MonadError(..), ExceptT(..), runExceptT)
import Data.Aeson (ToJSON(..), (.=), pairs)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Files (File(..), filePath)
import GHC.Generics (Generic)

data Path = Path {
      articlesPath :: Maybe FilePath
    , pagesPath :: Maybe FilePath
    , remarkableConfig :: Maybe FilePath
    , root :: FilePath
  } deriving (Eq, Generic, Show)

instance ToJSON Path where
  toEncoding (Path {articlesPath, pagesPath}) = pairs (
        "articlesPath" .= articlesPath
      <> "pagesPath" .= pagesPath
    )

checkFor :: (FilePath -> File) -> FilePath -> ExceptT String IO (Maybe FilePath)
checkFor fileOrDir = ExceptT . fmap (Just <$>) . filePath . fileOrDir

getMarkdownPath :: FilePath -> Maybe FilePath -> ExceptT String IO (Maybe FilePath)
getMarkdownPath defaultPath Nothing =
  ExceptT . (Right . either (\_ -> Nothing) Just <$>) . filePath $ Dir defaultPath
getMarkdownPath _ (Just customPath) = checkFor Dir customPath

build :: FilePath -> Arguments -> IO (Either String Path)
build root arguments = runExceptT . join $ pack
  <$> getMarkdownPath "articles" (Arguments.articlesPath arguments)
  <*> getMarkdownPath "pages" (Arguments.pagesPath arguments)
  <*> maybe ignore (checkFor File) (Arguments.remarkableConfig arguments)
  where
    pack Nothing Nothing _ =
      throwError "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
    pack articlesPath pagesPath remarkableConfig =
      return $ Path {articlesPath, pagesPath, remarkableConfig, root}
    ignore = return Nothing