Stop dying in Path validation and return an Either instead so we can handle expected errors cleanly

This commit is contained in:
Tissevert 2020-10-23 15:36:49 +02:00
parent 4c6ee2d9bc
commit e74eadd6ba
2 changed files with 9 additions and 9 deletions

View file

@ -41,6 +41,7 @@ import Page (Page)
import qualified Page (at) import qualified Page (at)
import Prelude hiding (lookup) import Prelude hiding (lookup)
import System.Directory (doesFileExist, withCurrentDirectory) import System.Directory (doesFileExist, withCurrentDirectory)
import System.Exit (die)
import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName) import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
import Text.Parsec (ParseError) import Text.Parsec (ParseError)
@ -115,7 +116,7 @@ build arguments = do
templates <- Template.build wording templates <- Template.build wording
root <- Files.absolute . Dir $ Arguments.sourceDir arguments root <- Files.absolute . Dir $ Arguments.sourceDir arguments
withCurrentDirectory root $ do withCurrentDirectory root $ do
path <- Path.build root arguments path <- either die return =<< Path.build root arguments
let name = maybe (takeFileName $ dropTrailingPathSeparator root) id let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
$ Arguments.name arguments $ Arguments.name arguments
skin <- Skin.build name arguments skin <- Skin.build name arguments

View file

@ -12,14 +12,13 @@ import Data.Aeson (ToJSON(..), (.=), pairs)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Files (File(..), filePath, filePathMaybe) import Files (File(..), filePath, filePathMaybe)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import System.Exit (die)
data Path = Path { data Path = Path {
articlesPath :: Maybe FilePath articlesPath :: Maybe FilePath
, pagesPath :: Maybe FilePath , pagesPath :: Maybe FilePath
, remarkableConfig :: Maybe FilePath , remarkableConfig :: Maybe FilePath
, root :: FilePath , root :: FilePath
} deriving Generic } deriving (Eq, Generic, Show)
instance ToJSON Path where instance ToJSON Path where
toEncoding (Path {articlesPath, pagesPath}) = pairs ( toEncoding (Path {articlesPath, pagesPath}) = pairs (
@ -31,14 +30,14 @@ getMarkdownPath :: FilePath -> Maybe FilePath -> IO (Maybe FilePath)
getMarkdownPath defaultPath Nothing = filePathMaybe (Dir defaultPath) getMarkdownPath defaultPath Nothing = filePathMaybe (Dir defaultPath)
getMarkdownPath _ (Just path) = Just <$> filePath (Dir path) getMarkdownPath _ (Just path) = Just <$> filePath (Dir path)
build :: FilePath -> Arguments -> IO Path build :: FilePath -> Arguments -> IO (Either String Path)
build root arguments = do build root arguments = do
articlesPath <- getMarkdownPath "articles" $ Arguments.articlesPath arguments articlesPath <- getMarkdownPath "articles" $ Arguments.articlesPath arguments
pagesPath <- getMarkdownPath "pages" $ Arguments.pagesPath arguments pagesPath <- getMarkdownPath "pages" $ Arguments.pagesPath arguments
checkForContent articlesPath pagesPath
remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
return $ Path {articlesPath, pagesPath, remarkableConfig, root} checkForContent articlesPath pagesPath remarkableConfig
where where
checkForContent Nothing Nothing = checkForContent Nothing Nothing _ = return $
die "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep" Left "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
checkForContent _ _ = return () checkForContent articlesPath pagesPath remarkableConfig =
return . Right $ Path {articlesPath, pagesPath, remarkableConfig, root}