Implement envy
This commit is contained in:
+19
-12
@@ -10,6 +10,7 @@ import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Data.Time (Day, toGregorian)
|
||||
import GHC.Generics (Generic)
|
||||
import Network.HTTP.Media ((//), (/:))
|
||||
import Network.HTTP.Types (Status (..), mkStatus, status200)
|
||||
import Servant
|
||||
@@ -31,7 +32,6 @@ import Servant
|
||||
, (:>)
|
||||
, pattern MkHandler
|
||||
)
|
||||
import System.Exit (exitWith, ExitCode (..))
|
||||
import System.FilePath ((</>))
|
||||
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
|
||||
import Text.Blaze.Html5 ((!))
|
||||
@@ -51,25 +51,32 @@ import Yore.DB (DayFile (..))
|
||||
import Yore.Error (Error (..))
|
||||
import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight)
|
||||
|
||||
import qualified Yore.Config as Config
|
||||
import qualified Envy
|
||||
import qualified Yore.DB as DB
|
||||
import qualified Yore.Log as Log
|
||||
|
||||
data Config f = Config
|
||||
{ port :: Envy.Env f (Envy.Optional Integer 3000)
|
||||
, downloadDir :: Envy.Env f (Envy.Optional String "download")
|
||||
, factor :: Envy.Env f (Envy.Required Rational)
|
||||
, factorFallback :: Envy.Env f (Envy.Optional Rational '(1, 1))
|
||||
}
|
||||
deriving (Generic)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
cfg <- Config.load @Config.Config >>= \case
|
||||
Left err -> do
|
||||
Log.error err
|
||||
exitWith $ ExitFailure 1
|
||||
Right cfg ->
|
||||
pure cfg
|
||||
print . port =<< Envy.load @Config
|
||||
print . downloadDir =<< Envy.load @Config
|
||||
print . factor =<< Envy.load @Config
|
||||
let
|
||||
settings =
|
||||
Warp.setLogger logger $
|
||||
Warp.setPort 3000 $
|
||||
Warp.setOnException onException Warp.defaultSettings
|
||||
|
||||
db <- DB.initDB "host=localhost user=yore-test port=5433 dbname=yore-test"
|
||||
Warp.runSettings settings $ serve (Proxy :: Proxy API) $ hoistServer (Proxy :: Proxy API) nt $ server db
|
||||
where
|
||||
settings =
|
||||
Warp.setLogger logger $
|
||||
Warp.setOnException onException Warp.defaultSettings
|
||||
|
||||
logger req status _ = do
|
||||
Log.info $
|
||||
printf
|
||||
|
||||
Reference in New Issue
Block a user