Dhall configuration

src/Configuration.hs

@@ -0,0 +1,19 @@
+{-# Language NoImplicitPrelude #-}
+{-# Language DeriveGeneric #-}
+{-# Language DuplicateRecordFields #-}
+module Configuration where
+
+import ClassyPrelude
+import Dhall (Interpret)
+
+data Pg = Pg { username :: Text
+             , password :: Text
+             , host :: Text
+             , database :: Text }
+        deriving (Show, Generic)
+
+
+newtype Config = Config { database :: Pg } deriving (Show, Generic)
+
+instance Interpret Pg
+instance Interpret Config

src/Devel/Main.hs

@@ -1,3 +1,4 @@
+{-# Language OverloadedStrings #-}
 module Devel.Main where
 
 import Main (defaultMain)
@@ -6,6 +7,7 @@ import Control.Monad (void)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Foreign.Store (Store(..), lookupStore, readStore, storeAction, withStore)
 import GHC.Word (Word32)
+import Dhall (input, auto)
 
 update :: IO ()
 update = do
@@ -23,7 +25,7 @@ update = do
       withStore doneStore takeMVar
       readStore doneStore >>= start
     start :: MVar () -> IO ThreadId
-    start done = forkFinally defaultMain (\_ -> putMVar done ())
+    start done = forkFinally (input auto "./config/devel.dhall" >>= defaultMain) (\_ -> putMVar done ())
 
 modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
 modifyStoredIORef store f = withStore store $ \ref -> do

src/Main.hs

@@ -1,11 +1,16 @@
+{-# Language OverloadedStrings #-}
 module Main where
 
 import Server (server)
 import Network.Wai.Handler.Warp (run)
 import Types
+import Configuration (Config)
+import Dhall (input, auto)
 
-defaultMain :: IO ()
-defaultMain = run 8080 (server App)
+defaultMain :: Config -> IO ()
+defaultMain c = run 8080 (server (App c))
 
 main :: IO ()
-main = defaultMain
+main = do
+  c <- input auto "./config/config.dhall"
+  defaultMain c

src/Types.hs

@@ -3,7 +3,8 @@ module Types where
 
 import ClassyPrelude
 import Control.Monad.Logger
+import Configuration
 
-data App = App
+newtype App = App { config :: Config }
 
 type AppM = LoggingT (ReaderT App IO)