{-# 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 {
      Path -> Maybe FilePath
articlesPath :: Maybe FilePath
    , Path -> Maybe FilePath
pagesPath :: Maybe FilePath
    , Path -> Maybe FilePath
remarkableConfig :: Maybe FilePath
    , Path -> FilePath
root :: FilePath
  } deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, (forall x. Path -> Rep Path x)
-> (forall x. Rep Path x -> Path) -> Generic Path
forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic, Int -> Path -> ShowS
[Path] -> ShowS
Path -> FilePath
(Int -> Path -> ShowS)
-> (Path -> FilePath) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> FilePath
$cshow :: Path -> FilePath
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)

instance ToJSON Path where
  toEncoding :: Path -> Encoding
toEncoding (Path {Maybe FilePath
articlesPath :: Maybe FilePath
articlesPath :: Path -> Maybe FilePath
articlesPath, Maybe FilePath
pagesPath :: Maybe FilePath
pagesPath :: Path -> Maybe FilePath
pagesPath}) = Series -> Encoding
pairs (
        Text
"articlesPath" Text -> Maybe FilePath -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe FilePath
articlesPath
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"pagesPath" Text -> Maybe FilePath -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe FilePath
pagesPath
    )

checkFor :: (FilePath -> File) -> FilePath -> ExceptT String IO (Maybe FilePath)
checkFor :: (FilePath -> File)
-> FilePath -> ExceptT FilePath IO (Maybe FilePath)
checkFor FilePath -> File
fileOrDir = IO (Either FilePath (Maybe FilePath))
-> ExceptT FilePath IO (Maybe FilePath)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath (Maybe FilePath))
 -> ExceptT FilePath IO (Maybe FilePath))
-> (FilePath -> IO (Either FilePath (Maybe FilePath)))
-> FilePath
-> ExceptT FilePath IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either FilePath FilePath -> Either FilePath (Maybe FilePath))
-> IO (Either FilePath FilePath)
-> IO (Either FilePath (Maybe FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> Either FilePath FilePath -> Either FilePath (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (Either FilePath FilePath)
 -> IO (Either FilePath (Maybe FilePath)))
-> (FilePath -> IO (Either FilePath FilePath))
-> FilePath
-> IO (Either FilePath (Maybe FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> IO (Either FilePath FilePath)
filePath (File -> IO (Either FilePath FilePath))
-> (FilePath -> File) -> FilePath -> IO (Either FilePath FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> File
fileOrDir

getMarkdownPath :: FilePath -> Maybe FilePath -> ExceptT String IO (Maybe FilePath)
getMarkdownPath :: FilePath -> Maybe FilePath -> ExceptT FilePath IO (Maybe FilePath)
getMarkdownPath FilePath
defaultPath Maybe FilePath
Nothing =
  IO (Either FilePath (Maybe FilePath))
-> ExceptT FilePath IO (Maybe FilePath)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath (Maybe FilePath))
 -> ExceptT FilePath IO (Maybe FilePath))
-> (File -> IO (Either FilePath (Maybe FilePath)))
-> File
-> ExceptT FilePath IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Either FilePath (Maybe FilePath)
forall a b. b -> Either a b
Right (Maybe FilePath -> Either FilePath (Maybe FilePath))
-> (Either FilePath FilePath -> Maybe FilePath)
-> Either FilePath FilePath
-> Either FilePath (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe FilePath)
-> (FilePath -> Maybe FilePath)
-> Either FilePath FilePath
-> Maybe FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing) FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Either FilePath FilePath -> Either FilePath (Maybe FilePath))
-> IO (Either FilePath FilePath)
-> IO (Either FilePath (Maybe FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (Either FilePath FilePath)
 -> IO (Either FilePath (Maybe FilePath)))
-> (File -> IO (Either FilePath FilePath))
-> File
-> IO (Either FilePath (Maybe FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> IO (Either FilePath FilePath)
filePath (File -> ExceptT FilePath IO (Maybe FilePath))
-> File -> ExceptT FilePath IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> File
Dir FilePath
defaultPath
getMarkdownPath FilePath
_ (Just FilePath
customPath) = (FilePath -> File)
-> FilePath -> ExceptT FilePath IO (Maybe FilePath)
checkFor FilePath -> File
Dir FilePath
customPath

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