Move all output to a sum type

All errors, warnings, and messages are now listed in a sum type
in 'CAStore.Type.Text'. The added structure should help with
writing better error messages. Also, if and when we get to
localising ca-store, implementation will be trivial.

.gitignore

@@ -12,6 +12,8 @@
 !src/CAStore/Config/CLI.hs
 !src/CAStore/Program.hs
 !src/CAStore/Program/Internal.hs
+!src/CAStore/Program/IO/Text.hs
 !src/CAStore/Program/Storage.hs
 !src/CAStore/Type.hs
+!src/CAStore/Type/Text.hs
 !src/Data/List/Extra.hs

app/Main.hs

@@ -3,8 +3,8 @@ module Main(main) where
 import CAStore.Command (runCommand)
 import CAStore.Config (finalConfig)
 import CAStore.Program (Program, runProgram, getCommand)
+import CAStore.Program.IO.Text (err)
 import CAStore.Program.Storage (initialise)
-import Control.Monad.IO.Class (liftIO)
 
 main :: IO ()
 main = finalConfig >>= flip runProgram defaultProgram
@@ -12,6 +12,4 @@ main = finalConfig >>= flip runProgram defaultProgram
 defaultProgram :: Program ()
 defaultProgram = do
   initialise
-  getCommand >>= \case
+  getCommand >>= either err runCommand
-    Nothing  -> liftIO $ putStrLn "ERROR: Invalid command"
-    Just cmd -> runCommand cmd

package.yaml

@@ -53,8 +53,10 @@ library:
   - CAStore.Config.Type
   - CAStore.Program
   - CAStore.Program.Internal
+  - CAStore.Program.IO.Text
   - CAStore.Program.Storage
   - CAStore.Type
+  - CAStore.Type.Text
   - Data.List.Extra
 
 executables:

src/CAStore/Command.hs

@@ -7,7 +7,9 @@ where
 
 import CAStore.Command.Type (Command(..), parseCommand)
 import CAStore.Program (Program, storeFile, unstoreFile, getFileLocation)
+import CAStore.Program.IO.Text
 import CAStore.Program.Storage (registerFiles, unregisterFiles, generateId)
+import CAStore.Type.Text
 import Control.Monad (forM_)
 import Control.Monad.IO.Class (liftIO)
 import System.Directory (doesFileExist)
@@ -25,6 +27,6 @@ runCommand (FileVerify ss) = forM_ ss $ \sid -> do
     True -> do
       sid' <- generateId file
       case sid == sid' of
-        True -> liftIO $ putStrLn $ show sid ++ " is valid."
+        True -> msg $ MsgArb $ show sid ++ " is valid."
-        False -> liftIO $ putStrLn $ show sid ++ " has been corrupted."
+        False -> err $ ErrArb $ show sid ++ " has been corrupted."
-    False -> liftIO $ putStrLn $ show sid ++ " does not exist in the store."
+    False -> err $ ErrArb $ show sid ++ " does not exist in the store."

src/CAStore/Command/Type.hs

@@ -12,11 +12,11 @@ data Command
   | FileVerify [StoreId]
   deriving (Show)
 
-parseCommand :: [String] -> Maybe Command
+parseCommand :: [String] -> Either Error Command
 parseCommand ("file":"add":xs)
-  = Just $ FileAdd xs
+  = pure $ FileAdd xs
 parseCommand ("file":"remove":xs)
-  = Just $ FileRemove $ StoreId <$> xs
+  = pure $ FileRemove $ StoreId <$> xs
 parseCommand ("file":"verify":xs)
-  = Just $ FileVerify $ StoreId <$> xs
+  = pure $ FileVerify $ StoreId <$> xs
-parseCommand _ = Nothing
+parseCommand xs = Left $ ErrInvalidCommand xs

src/CAStore/Config/CLI.hs

@@ -19,6 +19,6 @@ parseCLI = execParser $ info (bsequence' parser) mempty
 
 parser :: Config Parser
 parser = Config
-  { storeLocation = argument (maybeReader parseStoreLocation) (metavar "STORE")
+  { storeLocation = argument (maybeReader (either (const Nothing) Just . parseStoreLocation)) (metavar "STORE")
   , arguments = some (strArgument (metavar "COMMAND"))
   }

src/CAStore/Program/IO/Text.hs

@@ -0,0 +1,29 @@
+module CAStore.Program.IO.Text
+  ( err
+  , warn
+  , msg
+  )
+where
+
+import CAStore.Program.Internal (Program(..))
+import CAStore.Type.Text
+import Control.Monad.IO.Class (liftIO)
+import Data.Foldable1 (intercalate1)
+import Data.List.NonEmpty (NonEmpty(..))
+
+display :: String -> Program ()
+display = Program . liftIO . putStrLn
+
+err :: Error -> Program ()
+err (ErrArb x)
+  = display $ "ERROR: " ++ x
+err (ErrInvalidCommand [])
+  = display $ "ERROR: No command specified"
+err (ErrInvalidCommand (x:xs))
+  = display $ "ERROR: Invalid command '" ++ intercalate1 " " (x :| xs) ++ "'"
+
+warn :: Warning -> Program ()
+warn (WarnArb x) = display $ "WARN: " ++ x
+
+msg :: Message -> Program ()
+msg (MsgArb x) = display x

src/CAStore/Program/Internal.hs

@@ -1,5 +1,5 @@
 module CAStore.Program.Internal
-  ( Program
+  ( Program(..)
   , runProgram
   , Env(..)
   , getConnectionHandle
@@ -39,7 +39,7 @@ defineStoreRoot (StoreShort p) = do
 data Env = Env
   { handle :: Connection
   , storeRoot :: FilePath
-  , mCommand :: Maybe Command
+  , mCommand :: Either Error Command
   }
 
 makeEnv :: Config Identity -> FilePath -> Connection -> Env
@@ -61,5 +61,5 @@ getFileLocation (StoreId x)
   =   (\root -> root </> "files" </> (take 2 x) </> x)
   <$> getStoreRoot
 
-getCommand :: Program (Maybe Command)
+getCommand :: Program (Either Error Command)
 getCommand = Program $ asks mCommand

src/CAStore/Type.hs

@@ -1,5 +1,8 @@
 module CAStore.Type
-  ( StoreId(..)
+  ( Error(..)
+  , Warning(..)
+  , Message(..)
+  , StoreId(..)
   , Tag(..)
   , StoreLocation(..)
   , parseStoreLocation
@@ -7,6 +10,7 @@ module CAStore.Type
   )
 where
 
+import CAStore.Type.Text
 import Database.SQLite.Simple.FromField (FromField, fromField)
 import Database.SQLite.Simple.ToField (ToField, toField)
 
@@ -36,10 +40,10 @@ data StoreLocation
   | StorePath FilePath
   deriving (Show)
 
-parseStoreLocation :: String -> Maybe StoreLocation
+parseStoreLocation :: String -> Either Error StoreLocation
-parseStoreLocation x@('/':_) = Just $ StorePath x
+parseStoreLocation x@('/':_) = pure $ StorePath x
-parseStoreLocation x@('.':'/':_) = Just $ StorePath x
+parseStoreLocation x@('.':'/':_) = pure $ StorePath x
-parseStoreLocation x = Just $ StoreShort x
+parseStoreLocation x = pure $ StoreShort x
 
 data OutputType = OutputId | OutputFilename
   deriving (Show)

src/CAStore/Type/Text.hs

@@ -0,0 +1,16 @@
+module CAStore.Type.Text
+  ( Error(..)
+  , Warning(..)
+  , Message(..)
+  )
+where
+
+data Error
+  = ErrArb String
+  | ErrInvalidCommand [String]
+
+data Warning
+  = WarnArb String
+
+data Message
+  = MsgArb String