Organize application logic by core/feature breakouts, add dhall configuration support and add a range of new config options in the Reader, add example configuration/deployment files

src/Core/Configuration.hs

@@ -0,0 +1,11 @@
+module Core.Configuration ( main ) where
+
+import Core.Types 
+
+import Dhall
+
+instance FromDhall DhallConfig
+
+main :: IO DhallConfig
+main = do
+  input auto "./config.dhall"

src/Core/HTTP.hs

@@ -0,0 +1,14 @@
+module Core.HTTP ( app ) where
+
+import Core.Types
+
+import Feature.Handlers as RES
+
+import Network.Wai.Middleware.RequestLogger (logStdoutDev)
+import Web.Scotty.Trans 
+
+app :: PurrApp ()
+app = do
+  middleware logStdoutDev
+
+  get "/" RES.root

src/Core/Mongo.hs

@@ -0,0 +1,20 @@
+module Core.Mongo ( mongoSetup, tempGetDocs ) where
+
+import Core.Types
+
+import Control.Monad.Reader (MonadIO)
+import Database.MongoDB
+import Prelude
+
+mongoSetup :: DhallConfig -> IO MongoContext
+mongoSetup conf = do
+  mongoCon <- connect $ host (hostname conf)
+  let adminCon = MongoContext mongoCon master (adminDB conf)
+  access (mongoPipe adminCon) (mongoAccessMode adminCon) (mongoDatabase adminCon) (auth (mongoUsername conf) (mongoPassword conf))
+  return $ MongoContext mongoCon master (dataDB conf)
+
+tempGetDocs :: MonadIO m => AppConfig -> m [Document]
+tempGetDocs appConfig = access (mongoPipe db) (mongoAccessMode db) (mongoDatabase db) $ find (select [] (collection conf)) >>= rest
+  where
+    db   = dbconn appConfig
+    conf = res appConfig

src/Core/Types.hs

@@ -0,0 +1,34 @@
+module Core.Types where
+
+import qualified Data.Text.Lazy as LT
+
+import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
+import Data.Text
+import Database.MongoDB     (MongoContext)
+import GHC.Generics         (Generic)
+import Numeric.Natural      (Natural)
+import Web.Scotty.Trans     (ScottyT, ActionT)
+
+type PurrApp    a = ScottyT LT.Text ConfigM a
+type PurrAction a = ActionT LT.Text ConfigM a
+
+newtype ConfigM a = ConfigM
+  { runConfigM :: ReaderT AppConfig IO a
+  } deriving (Applicative, Functor, Monad, MonadIO, MonadReader AppConfig)
+
+data AppConfig = AppConfig
+  { res    :: DhallConfig
+  , dbconn :: MongoContext
+  }
+
+data DhallConfig = DhallConfig
+  { hostname      :: String
+  , port          :: Int
+  , environment   :: Text
+  , adminDB       :: Text
+  , dataDB        :: Text
+  , collection    :: Text
+  , mongoUsername :: Text
+  , mongoPassword :: Text
+  } deriving (Generic, Show)
+

src/Feature/Handlers.hs

@@ -0,0 +1,18 @@
+module Feature.Handlers ( root ) where
+
+import Core.Types
+import qualified Core.Mongo as DB
+
+import Control.Monad.Reader (ask, lift)
+import Data.AesonBson (aesonify)
+import Data.Bson (Document, Field (..), Value (Array, Doc))
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import Web.Scotty.Trans (json)
+import Prelude hiding (id)
+
+root :: PurrAction ()
+root = do 
+  config <- lift $ ask
+  docs   <- DB.tempGetDocs config
+  json $ aesonify ["allDocs" := Array (map Doc docs)]

src/Lib.hs

@@ -1,6 +1,23 @@
-module Lib
-    ( someFunc
-    ) where
+module Lib ( main ) where
 
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
+import Core.Types
+import qualified Core.Configuration as Configuration
+import qualified Core.HTTP          as HTTP
+import qualified Core.Mongo         as DB
+
+import Control.Monad.Reader (liftIO, runReaderT)
+import Database.MongoDB     (MongoContext)
+import GHC.Natural          (popCountNatural)
+import Web.Scotty.Trans     (scottyT)
+import Prelude              hiding (id)
+
+main :: IO ()
+main = do
+  dhallConf <- liftIO Configuration.main
+  dataDB    <- liftIO $ DB.mongoSetup dhallConf
+  let config = AppConfig { res    = dhallConf
+                         , dbconn = dataDB 
+                         }
+  scottyT (port dhallConf) (flip runApp config) HTTP.app where
+    runApp :: ConfigM a -> AppConfig -> IO a
+    runApp m c = runReaderT (runConfigM m) c