2018-08-02 23:07:05 +03:00
|
|
|
{-# Language OverloadedStrings #-}
|
2018-08-02 23:33:47 +03:00
|
|
|
{-# Language RecordWildCards #-}
|
|
|
|
{-# Language DuplicateRecordFields #-}
|
|
|
|
{-# Language TypeApplications #-}
|
|
|
|
{-# Language DataKinds #-}
|
2018-08-02 23:59:08 +03:00
|
|
|
{-# Language NoImplicitPrelude #-}
|
2018-08-02 21:39:08 +03:00
|
|
|
module Main where
|
|
|
|
|
2018-08-02 22:11:11 +03:00
|
|
|
import Server (server)
|
|
|
|
import Network.Wai.Handler.Warp (run)
|
2018-08-02 22:32:23 +03:00
|
|
|
import Types
|
2018-08-02 23:33:47 +03:00
|
|
|
import Configuration
|
2018-08-02 23:07:05 +03:00
|
|
|
import Dhall (input, auto)
|
2018-08-02 23:33:47 +03:00
|
|
|
import ClassyPrelude
|
|
|
|
import Control.Lens (view)
|
|
|
|
import Data.Generics.Product
|
2018-08-02 23:59:08 +03:00
|
|
|
import Data.Pool (createPool)
|
|
|
|
import Database.Selda.PostgreSQL (PGConnectInfo(..), pgOpen, seldaClose)
|
2018-08-02 22:11:11 +03:00
|
|
|
|
2018-08-03 23:36:38 +03:00
|
|
|
defaultMain :: App -> IO ()
|
|
|
|
defaultMain = run 8080 . server
|
|
|
|
|
|
|
|
withApp :: Config -> (App -> IO ()) -> IO ()
|
|
|
|
withApp config f = do
|
2018-08-02 23:59:08 +03:00
|
|
|
let pgHost = view (field @"database" . field @"host") config
|
|
|
|
pgPort = 5432
|
|
|
|
pgDatabase = view (field @"database" . field @"database") config
|
|
|
|
pgUsername = Just (view (field @"database" . field @"username") config)
|
|
|
|
pgPassword = Just (view (field @"database" . field @"password") config)
|
|
|
|
database <- createPool (pgOpen (PGConnectInfo{..})) seldaClose 10 2 5
|
2018-08-03 23:36:38 +03:00
|
|
|
f App{..}
|
2018-08-02 23:33:47 +03:00
|
|
|
|
2018-08-02 21:39:08 +03:00
|
|
|
main :: IO ()
|
2018-08-02 23:07:05 +03:00
|
|
|
main = do
|
|
|
|
c <- input auto "./config/config.dhall"
|
2018-08-03 23:36:38 +03:00
|
|
|
withApp c defaultMain
|