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

.dockerignore

@@ -0,0 +1,2 @@
+.stack-work
+data/

.gitignore

@@ -1,4 +1,7 @@
+data/
+bin/
+/config.dhall
+/Dockerfile
+docker-stack.yml
 .stack-work/
-./data
-./config.dhall
 *~

Purr.cabal

@@ -19,13 +19,38 @@ extra-source-files:
 
 library
   exposed-modules:
+      Core.Configuration
+      Core.HTTP
+      Core.Mongo
+      Core.Types
+      Feature.Handlers
       Lib
   other-modules:
       Paths_Purr
   hs-source-dirs:
       src
+  default-extensions:
+      OverloadedStrings
+      GeneralizedNewtypeDeriving
+      DeriveGeneric
+      ConstraintKinds
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
   build-depends:
-      base >=4.7 && <5
+      AesonBson ==0.4.1
+    , aeson >=2.0.0.0
+    , base >=4.7
+    , bson >=0.3
+    , dhall >=1.40 && <1.41.2
+    , http-types >=0.12.3
+    , iso8601-time >=0.1.5
+    , mongoDB >=2.7.1.1
+    , mtl >=2.2.2
+    , scotty ==0.12
+    , text >=1.2
+    , time >=1.9
+    , wai-extra >=3.1.12.1
   default-language: Haskell2010
 
 executable Purr-exe
@@ -34,10 +59,30 @@ executable Purr-exe
       Paths_Purr
   hs-source-dirs:
       app
+  default-extensions:
+      OverloadedStrings
+      GeneralizedNewtypeDeriving
+      DeriveGeneric
+      ConstraintKinds
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      Purr
+      AesonBson ==0.4.1
-    , base >=4.7 && <5
+    , Purr
+    , aeson >=2.0.0.0
+    , base >=4.7
+    , bson >=0.3
+    , dhall >=1.40 && <1.41.2
+    , http-types >=0.12.3
+    , iso8601-time >=0.1.5
+    , mongoDB >=2.7.1.1
+    , mtl >=2.2.2
+    , scotty ==0.12
+    , text >=1.2
+    , time >=1.9
+    , wai-extra >=3.1.12.1
   default-language: Haskell2010
 
 test-suite Purr-test
@@ -47,8 +92,28 @@ test-suite Purr-test
       Paths_Purr
   hs-source-dirs:
       test
+  default-extensions:
+      OverloadedStrings
+      GeneralizedNewtypeDeriving
+      DeriveGeneric
+      ConstraintKinds
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      Purr
+      AesonBson ==0.4.1
-    , base >=4.7 && <5
+    , Purr
+    , aeson >=2.0.0.0
+    , base >=4.7
+    , bson >=0.3
+    , dhall >=1.40 && <1.41.2
+    , http-types >=0.12.3
+    , iso8601-time >=0.1.5
+    , mongoDB >=2.7.1.1
+    , mtl >=2.2.2
+    , scotty ==0.12
+    , text >=1.2
+    , time >=1.9
+    , wai-extra >=3.1.12.1
   default-language: Haskell2010

app/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
-import Lib
+import Prelude
+import qualified Lib
 
 main :: IO ()
-main = someFunc
+main = Lib.main

examples/Dockerfile

@@ -0,0 +1,11 @@
+FROM haskell:9.0.2
+
+WORKDIR /app
+ADD . /app
+
+RUN stack setup
+RUN stack build --copy-bins --local-bin-path ./
+
+EXPOSE 3000
+
+CMD ./Purr-exe

examples/config.dhall

@@ -0,0 +1,10 @@
+-- /config.dhall
+{ hostname = "localhost"
+, port = +3001
+, environment = "development"
+, adminDB = "admin"
+, dataDB = "data"
+, collection = "store"
+, mongoUsername = "root"
+, mongoPassword = "REPLACEME"
+}

package.yaml

@@ -9,6 +9,15 @@ extra-source-files:
 - README.md
 - ChangeLog.md
 
+default-extensions:
+- OverloadedStrings
+- GeneralizedNewtypeDeriving
+- DeriveGeneric
+- ConstraintKinds
+- FlexibleContexts
+- FlexibleInstances
+- ScopedTypeVariables
+
 # Metadata used when publishing your package
 # synopsis:            Short description of your package
 # category:            Web
@@ -19,7 +28,19 @@ extra-source-files:
 description:         https://git.eversole.co/James/Purr
 
 dependencies:
-- base >= 4.7 && < 5
+- aeson >= 2.0.0.0
+- AesonBson == 0.4.1
+- bson >= 0.3
+- base >= 4.7 
+- dhall >= 1.40 && < 1.41.2
+- http-types >= 0.12.3
+- iso8601-time >= 0.1.5 
+- mongoDB >= 2.7.1.1 
+- mtl >= 2.2.2 
+- scotty == 0.12
+- time >= 1.9
+- text >= 1.2
+- wai-extra >= 3.1.12.1
 
 library:
   source-dirs: src

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
+module Lib ( main ) where
-    ( someFunc
-    ) where
 
-someFunc :: IO ()
+import Core.Types
-someFunc = putStrLn "someFunc"
+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 

stack.yaml

@@ -35,12 +35,9 @@ packages:
 # These entries can reference officially published versions as well as
 # forks / in-progress versions pinned to a git hash. For example:
 #
-# extra-deps:
+extra-deps:
-# - acme-missiles-0.3
+- AesonBson-0.4.1@sha256:30a4ecb39e8da94dc1e1e8945eb0d4e33a833ae4342841b3c87c56b5918a90a1,1398
-# - git: https://github.com/commercialhaskell/stack.git
+- bson-generic-0.0.9@sha256:ea6685daa618b2bbe6e189c33e195e812501baf42f53183eedc16f011690895a,817
-#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

stack.yaml.lock

@@ -3,7 +3,21 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    hackage: AesonBson-0.4.1@sha256:30a4ecb39e8da94dc1e1e8945eb0d4e33a833ae4342841b3c87c56b5918a90a1,1398
+    pantry-tree:
+      size: 378
+      sha256: 10c7444de357f7fc1473542d8b3307811420889be32d5a2033d0dbc2d32a375d
+  original:
+    hackage: AesonBson-0.4.1@sha256:30a4ecb39e8da94dc1e1e8945eb0d4e33a833ae4342841b3c87c56b5918a90a1,1398
+- completed:
+    hackage: bson-generic-0.0.9@sha256:ea6685daa618b2bbe6e189c33e195e812501baf42f53183eedc16f011690895a,817
+    pantry-tree:
+      size: 220
+      sha256: 46d452c35c2c762af25bf4d85b5248a94cbbe5b282bc4b1217d0ab3451011ae9
+  original:
+    hackage: bson-generic-0.0.9@sha256:ea6685daa618b2bbe6e189c33e195e812501baf42f53183eedc16f011690895a,817
 snapshots:
 - completed:
     size: 618740