Factored out IO functions into classes for easier testing.

diff --git a/app/Main.hs b/app/Main.hs
index 375caf9..6f37f7e 100644 (file)
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,14 +1,20 @@
 module Main where
 
+import Configuration (ServerConfiguration(..), defaultConfiguration, readConfiguration)
 import Control.Monad ((<=<))
-import Data.Maybe (fromMaybe, listToMaybe)
-import Network.Wai.Handler.Warp (Port(..), run)
+import Control.Monad.IO.Class (liftIO)
+import Data.Either (either)
+import Data.Maybe (maybe, listToMaybe)
+import Network.Wai.Handler.Warp (run)
 import Server
+import ServerMonad (ConfigMonad(..), ServerMonad(..))
 import System.Environment (getArgs)
 import Text.Read (readMaybe)
 
 main :: IO ()
-main = getPort >>= flip run app
+main = runConfigMonad getConfiguration >>= flip run app . configPort
 
-getPort :: IO Port
-getPort = getArgs >>= pure . fromMaybe 5000 . (readMaybe <=< listToMaybe)
+getConfiguration :: ConfigMonad ServerConfiguration
+getConfiguration = do
+  configFilePath <- liftIO getArgs >>= pure . (readMaybe <=< listToMaybe)
+  maybe (pure $ Right defaultConfiguration) readConfiguration configFilePath >>= pure . either error id

diff --git a/package.yaml b/package.yaml
index 37a0fa0..720a088 100644 (file)
--- a/package.yaml
+++ b/package.yaml
@@ -48,6 +48,7 @@ default-extensions:
 - FlexibleContexts
 - FlexibleInstances
 - GADTs
+- GeneralizedNewtypeDeriving
 - KindSignatures
 - MultiParamTypeClasses
 - OverloadedStrings

diff --git a/src/Configuration.hs b/src/Configuration.hs
new file mode 100644 (file)
index 0000000..d1b8958
--- /dev/null
+++ b/src/Configuration.hs
@@ -0,0 +1,24 @@
+module Configuration where
+
+import Control.Monad ((<=<))
+import Data.Aeson (FromJSON(..), eitherDecodeStrict')
+import GHC.Generics (Generic(..))
+import Network.Wai.Handler.Warp (Port(..))
+import qualified Data.ByteString as B
+
+class (Monad m) => MonadReadConfig m where
+  readConfigFile :: FilePath -> m B.ByteString
+
+data ServerConfiguration = ServerConfiguration { configPort :: !Port
+                                               , configShowExceptions :: !Bool
+                                               } deriving (Generic)
+
+instance FromJSON ServerConfiguration
+
+defaultConfiguration :: ServerConfiguration
+defaultConfiguration = ServerConfiguration { configPort = 5000
+                                           , configShowExceptions = False
+                                           }
+
+readConfiguration :: (MonadReadConfig m) => FilePath -> m (Either String ServerConfiguration)
+readConfiguration = pure . eitherDecodeStrict' <=< readConfigFile

diff --git a/src/ServerMonad.hs b/src/ServerMonad.hs
new file mode 100644 (file)
index 0000000..fd1d1c4
--- /dev/null
+++ b/src/ServerMonad.hs
@@ -0,0 +1,15 @@
+module ServerMonad where
+
+import Configuration (ServerConfiguration(..), MonadReadConfig(..))
+import Control.Monad.IO.Class (MonadIO(..), liftIO)
+import Control.Monad.Reader (MonadReader(..), ReaderT(..))
+import qualified Data.ByteString as B
+
+newtype ConfigMonad a = ConfigMonad { runConfigMonad :: IO a
+                                    } deriving (Functor, Applicative, Monad, MonadIO)
+
+newtype ServerMonad a = ServerMonad { runServerMonad :: ReaderT ServerConfiguration IO a
+                                    } deriving (Functor, Applicative, Monad, MonadIO, MonadReader ServerConfiguration)
+
+instance MonadReadConfig ConfigMonad where
+  readConfigFile = liftIO . B.readFile