Put program into a runnable state, and break the cycle that was discovered

.gitignore

@@ -6,10 +6,12 @@
 !package.yaml
 !app/Main.hs
 !src/CAStore/Command.hs
+!src/CAStore/Command/Type.hs
 !src/CAStore/Config.hs
 !src/CAStore/Config/Type.hs
 !src/CAStore/Config/CLI.hs
 !src/CAStore/Program.hs
+!src/CAStore/Program/Internal.hs
 !src/CAStore/Program/Storage.hs
 !src/CAStore/Type.hs
 !src/Data/List/Extra.hs

app/Main.hs

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

package.yaml

@@ -47,10 +47,12 @@ library:
   - sqlite-simple
   exposed-modules:
   - CAStore.Command
+  - CAStore.Command.Type
   - CAStore.Config
   - CAStore.Config.CLI
   - CAStore.Config.Type
   - CAStore.Program
+  - CAStore.Program.Internal
   - CAStore.Program.Storage
   - CAStore.Type
   - Data.List.Extra

src/CAStore/Command.hs

@@ -1,31 +1,15 @@
 module CAStore.Command
   ( Command(..)
-  , runCommand
   , parseCommand
+  , runCommand
   )
 where
 
+import CAStore.Command.Type (Command(..), parseCommand)
 import CAStore.Program (Program, storeFile, unstoreFile)
 import CAStore.Program.Storage (registerFile, unregisterFile)
-import CAStore.Type
 import Control.Monad (forM_)
 import Control.Monad.IO.Class (liftIO)
-import Data.ByteString.Char8 (pack)
-
-data Command
-  = FileAdd [FilePath]
-  | FileRemove [StoreId]
-  | FileVerify [StoreId]
-  deriving (Show)
-
-parseCommand :: [String] -> Maybe Command
-parseCommand ("file":"add":xs)
-  = Just $ FileAdd xs
-parseCommand ("file":"remove":xs)
-  = Just $ FileRemove $ StoreId . pack <$> xs
-parseCommand ("file":"verify":xs)
-  = Just $ FileVerify $ StoreId . pack <$> xs
-parseCommand _ = Nothing
 
 runCommand :: Command -> Program ()
 runCommand (FileAdd fs) = forM_ fs $ \x -> do

src/CAStore/Command/Type.hs

@@ -0,0 +1,23 @@
+module CAStore.Command.Type
+  ( Command(..)
+  , parseCommand
+  )
+where
+
+import CAStore.Type
+import Data.ByteString.Char8 (pack)
+
+data Command
+  = FileAdd [FilePath]
+  | FileRemove [StoreId]
+  | FileVerify [StoreId]
+  deriving (Show)
+
+parseCommand :: [String] -> Maybe Command
+parseCommand ("file":"add":xs)
+  = Just $ FileAdd xs
+parseCommand ("file":"remove":xs)
+  = Just $ FileRemove $ StoreId . pack <$> xs
+parseCommand ("file":"verify":xs)
+  = Just $ FileVerify $ StoreId . pack <$> xs
+parseCommand _ = Nothing

src/CAStore/Program.hs

@@ -1,9 +1,9 @@
 module CAStore.Program
   ( Program
   , runProgram
-  , defaultProgram
   , getConnectionHandle
   , getStoreRoot
+  , getCommand
 
   -- * File Operations
   , storeFile
@@ -11,59 +11,10 @@ module CAStore.Program
   )
 where
 
-import CAStore.Config (Config(..))
+import CAStore.Program.Internal
 import CAStore.Type
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Reader (ReaderT(..), asks)
-import Database.SQLite.Simple
-import qualified Data.ByteString as B
-import Data.ByteString.Char8 (unpack)
-import Data.Functor.Identity (Identity(..))
+import Control.Monad.IO.Class (liftIO)
 import qualified System.Directory as D
-import System.FilePath ((</>))
-
-newtype Program a = Program (ReaderT Env IO a)
-  deriving (Functor, Applicative, Monad, MonadIO)
-    via (ReaderT Env IO)
-
-runProgram :: Config Identity -> Program a -> IO a
-runProgram cfg (Program x) = do
-  root <- defineStoreRoot $ runIdentity $ storeLocation cfg
-  D.createDirectoryIfMissing True root
-  let db = root </> "db.db"
-  withConnection db (runReaderT x . makeEnv cfg root)
-
-data Env = Env
-  { handle :: Connection
-  , storeRoot :: FilePath
-  }
-
-makeEnv :: Config Identity -> FilePath -> Connection -> Env
-makeEnv _ root conn = Env
-  { handle = conn
-  , storeRoot = root
-  }
-
-defineStoreRoot :: StoreLocation -> IO FilePath
-defineStoreRoot (StorePath p) = pure p
-defineStoreRoot (StoreShort p) = do
-  dir <- D.getXdgDirectory D.XdgData $ "ca-store" </> p
-  pure dir
-
-defaultProgram :: Program ()
-defaultProgram = pure ()
-
-getConnectionHandle :: Program Connection
-getConnectionHandle = Program $ asks handle
-
-getStoreRoot :: Program FilePath
-getStoreRoot = Program $ asks storeRoot
-
--- | Determine the final location for a file inside the store
-getFileLocation :: StoreId -> Program FilePath
-getFileLocation (StoreId x)
-  =   (\root -> root </> "files" </> (unpack $ B.take 2 x) </> (unpack x))
-  <$> getStoreRoot
 
 -- | Add a file to the store
 -- You must already have a 'StoreId' to use this function. You get one by

src/CAStore/Program/Internal.hs

@@ -0,0 +1,67 @@
+module CAStore.Program.Internal
+  ( Program
+  , runProgram
+  , Env(..)
+  , getConnectionHandle
+  , getStoreRoot
+  , getFileLocation
+  , getCommand
+  )
+where
+
+import CAStore.Command.Type (Command(..), parseCommand)
+import CAStore.Config (Config(..))
+import CAStore.Type
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Reader (ReaderT(..), asks)
+import Database.SQLite.Simple (Connection, withConnection)
+import qualified System.Directory as D
+import System.FilePath ((</>))
+import qualified Data.ByteString as B (take)
+import Data.ByteString.Char8 (unpack)
+import Data.Functor.Identity (Identity(..))
+
+newtype Program a = Program (ReaderT Env IO a)
+  deriving (Functor, Applicative, Monad, MonadIO)
+    via (ReaderT Env IO)
+
+runProgram :: Config Identity -> Program a -> IO a
+runProgram cfg (Program x) = do
+  root <- defineStoreRoot $ runIdentity $ storeLocation cfg
+  D.createDirectoryIfMissing True root
+  let db = root </> "db.db"
+  withConnection db (runReaderT x . makeEnv cfg root)
+
+defineStoreRoot :: StoreLocation -> IO FilePath
+defineStoreRoot (StorePath p) = pure p
+defineStoreRoot (StoreShort p) = do
+  dir <- D.getXdgDirectory D.XdgData $ "ca-store" </> p
+  pure dir
+
+data Env = Env
+  { handle :: Connection
+  , storeRoot :: FilePath
+  , mCommand :: Maybe Command
+  }
+
+makeEnv :: Config Identity -> FilePath -> Connection -> Env
+makeEnv cfg root conn = Env
+  { handle = conn
+  , storeRoot = root
+  , mCommand = parseCommand $ runIdentity $ arguments cfg
+  }
+
+getConnectionHandle :: Program Connection
+getConnectionHandle = Program $ asks handle
+
+getStoreRoot :: Program FilePath
+getStoreRoot = Program $ asks storeRoot
+
+-- | Determine the final location for a file inside the store
+getFileLocation :: StoreId -> Program FilePath
+getFileLocation (StoreId x)
+  =   (\root -> root </> "files" </> (unpack $ B.take 2 x) </> (unpack x))
+  <$> getStoreRoot
+
+getCommand :: Program (Maybe Command)
+getCommand = Program $ asks mCommand

src/CAStore/Program/Storage.hs

@@ -7,7 +7,7 @@ module CAStore.Program.Storage
   )
 where
 
-import CAStore.Program
+import CAStore.Program.Internal
 import CAStore.Type (StoreId(..))
 import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)