2019-02-22 23:29:35 +01:00
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
2019-02-19 21:48:55 +01:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2019-02-22 23:29:35 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2020-12-13 20:09:23 +01:00
|
|
|
{-# LANGUAGE CPP #-}
|
2019-02-15 15:11:31 +01:00
|
|
|
module Blog.Path (
|
|
|
|
Path(..)
|
|
|
|
, build
|
|
|
|
) where
|
|
|
|
|
|
|
|
import Arguments (Arguments)
|
|
|
|
import qualified Arguments as Arguments (Arguments(..))
|
2020-12-13 20:09:23 +01:00
|
|
|
import Control.Monad (join)
|
|
|
|
import Control.Monad.Except (MonadError(..), ExceptT(..), runExceptT)
|
2019-02-22 23:29:35 +01:00
|
|
|
import Data.Aeson (ToJSON(..), (.=), pairs)
|
2020-12-13 20:09:23 +01:00
|
|
|
#if !MIN_VERSION_base(4,11,0)
|
2019-02-26 14:46:05 +01:00
|
|
|
import Data.Monoid ((<>))
|
2020-12-13 20:09:23 +01:00
|
|
|
#endif
|
2019-03-02 23:40:34 +01:00
|
|
|
import Files (File(..), filePath)
|
2019-02-22 23:29:35 +01:00
|
|
|
import GHC.Generics (Generic)
|
2019-02-15 15:11:31 +01:00
|
|
|
|
|
|
|
data Path = Path {
|
2020-12-13 20:09:23 +01:00
|
|
|
articlesPath :: Maybe FilePath
|
2019-02-15 15:11:31 +01:00
|
|
|
, pagesPath :: Maybe FilePath
|
2019-02-22 22:02:07 +01:00
|
|
|
, remarkableConfig :: Maybe FilePath
|
2019-02-15 15:11:31 +01:00
|
|
|
, root :: FilePath
|
2020-12-13 20:09:23 +01:00
|
|
|
} deriving (Eq, Generic, Show)
|
2019-02-22 23:29:35 +01:00
|
|
|
|
|
|
|
instance ToJSON Path where
|
2019-12-21 12:50:38 +01:00
|
|
|
toEncoding (Path {articlesPath, pagesPath}) = pairs (
|
2019-02-22 23:29:35 +01:00
|
|
|
"articlesPath" .= articlesPath
|
|
|
|
<> "pagesPath" .= pagesPath
|
|
|
|
)
|
2019-02-15 15:11:31 +01:00
|
|
|
|
2020-12-13 20:09:23 +01:00
|
|
|
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
|