Implement correct behaviour for default and custom articles and pages as outlined by the previous unit tests

src/Blog.hs

@@ -34,14 +34,14 @@ import qualified Data.Map as Map (empty, fromList)
 import Data.Set (Set)
 import qualified Data.Set as Set (empty, null, singleton, union)
 import Data.Text (Text)
-import Files (File(..), absolute)
+import Files (File(..), filePath)
 import qualified Files (find)
 import Markdown (getKey)
 import Page (Page)
 import qualified Page (at)
 import Prelude hiding (lookup)
-import System.Directory (doesFileExist, withCurrentDirectory)
+import Pretty (assertRight, onRight)
-import System.Exit (die)
+import System.Directory (doesFileExist, makeAbsolute, withCurrentDirectory)
 import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
 import Text.Parsec (ParseError)
 
@@ -114,9 +114,9 @@ build arguments = do
   let hasRSS = maybe False (\_-> True) $ rss urls
   wording <- Wording.build arguments
   templates <- Template.build wording
-  root <- Files.absolute . Dir $ Arguments.sourceDir arguments
+  root <- onRight makeAbsolute =<< filePath (Dir $ Arguments.sourceDir arguments)
   withCurrentDirectory root $ do
-    path <- either die return =<< Path.build root arguments
+    path <- assertRight =<< Path.build root arguments
     let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
               $ Arguments.name arguments
     skin <- Skin.build name arguments

src/Blog/Path.hs

@@ -8,9 +8,11 @@ module Blog.Path (
 
 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)
 import Data.Monoid ((<>))
-import Files (File(..), filePath, filePathMaybe)
+import Files (File(..), filePath)
 import GHC.Generics (Generic)
 
 data Path = Path {
@@ -26,18 +28,22 @@ instance ToJSON Path where
       <> "pagesPath" .= pagesPath
     )
 
-getMarkdownPath :: FilePath -> Maybe FilePath -> IO (Maybe FilePath)
+checkFor :: (FilePath -> File) -> FilePath -> ExceptT String IO (Maybe FilePath)
-getMarkdownPath defaultPath Nothing = filePathMaybe (Dir defaultPath)
+checkFor fileOrDir = ExceptT . fmap (Just <$>) . filePath . fileOrDir
-getMarkdownPath _ (Just path) = Just <$> filePath (Dir path)
+
+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 = do
+build root arguments = runExceptT . join $ pack
-  articlesPath <- getMarkdownPath "articles" $ Arguments.articlesPath arguments
+  <$> getMarkdownPath "articles" (Arguments.articlesPath arguments)
-  pagesPath <- getMarkdownPath "pages" $ Arguments.pagesPath arguments
+  <*> getMarkdownPath "pages" (Arguments.pagesPath arguments)
-  remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
+  <*> maybe ignore (checkFor File) (Arguments.remarkableConfig arguments)
-  checkForContent articlesPath pagesPath remarkableConfig
   where
-    checkForContent Nothing Nothing _ = return $
+    pack Nothing Nothing _ =
-      Left "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
+      throwError "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
-    checkForContent articlesPath pagesPath remarkableConfig =
+    pack articlesPath pagesPath remarkableConfig =
-      return . Right $ Path {articlesPath, pagesPath, remarkableConfig, root}
+      return $ Path {articlesPath, pagesPath, remarkableConfig, root}
+    ignore = return Nothing

src/Files.hs

@@ -1,38 +1,32 @@
 module Files (
       File(..)
-    , absolute
     , absoluteLink
     , filePath
-    , filePathMaybe
     , find
   ) where
 
-import System.Exit (die)
+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
-import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute)
 import System.FilePath ((</>))
 
 data File = File FilePath | Dir FilePath
 
-absolute :: File -> IO (FilePath)
-absolute file = filePath file >>= makeAbsolute
-
 absoluteLink :: FilePath -> FilePath
 absoluteLink ('.':path) = path
 absoluteLink path = "/" </> path
 
-filePathMaybe :: File -> IO (Maybe FilePath)
+filePath :: File -> IO (Either String FilePath)
-filePathMaybe = filePathAux
+filePath = filePathAux
   where
-    filePathAux (File path) = ifToMaybe path <$> doesFileExist path
+    filePathAux (File path) = ifIO doesFileExist path Right (notExist . File)
-    filePathAux (Dir path) = ifToMaybe path <$> doesDirectoryExist path
+    filePathAux (Dir path) = ifIO doesDirectoryExist path Right (notExist . Dir)
-    ifToMaybe path bool = if bool then return path else Nothing
+    ifIO predicate value whenTrue whenFalse = do
-
+      result <- predicate value
-filePath :: File -> IO FilePath
+      return $ if result then whenTrue value else whenFalse value
-filePath file = filePathMaybe file >>= maybe (die $ notExist file) return
+    notExist (File path) = Left $ path ++ ": no such file"
-  where
+    notExist (Dir path) = Left $ path ++ ": no such directory"
-    notExist (File path) = path ++ ": no such file"
-    notExist (Dir path) = path ++ ": no such directory"
 
 find :: FilePath -> IO [FilePath]
 find path =
-  filePathMaybe (Dir path) >>= maybe (return []) (fmap ((path </>) <$>) . listDirectory)
+  filePath (Dir path) >>= emptyIfMissing (fmap ((path </>) <$>) . listDirectory)
+  where
+    emptyIfMissing = either (\_ -> return [])

src/Pretty.hs

@@ -1,6 +1,16 @@
 module Pretty (
-    (.$)
+      (.$)
+    , assertRight
+    , onRight
   ) where
 
+import System.Exit (die)
+
 (.$) :: (a -> b) -> (b -> c) -> (a -> c)
 (.$) f g = g . f
+
+onRight :: (a -> IO b) -> Either String a -> IO b
+onRight = either die
+
+assertRight :: Either String a -> IO a
+assertRight = onRight return