mateamt/src/Main.hs

59 lines
1.3 KiB
Haskell
Raw Normal View History

2019-04-15 20:23:25 +00:00
{-# LANGUAGE OverloadedStrings #-}
2019-03-22 21:34:01 +00:00
module Main where
2019-04-15 20:23:25 +00:00
import Servant
import Data.Time.Clock
import Database.PostgreSQL.Simple
2019-04-16 11:30:16 +00:00
import Network.Wai
import Network.Wai.Logger
2019-04-15 20:23:25 +00:00
import Network.Wai.Handler.Warp
import Opaleye
import Control.Monad.IO.Class (liftIO)
import Control.Monad (void)
-- internal imports
import API
import Model as M
import Types
2019-03-22 21:34:01 +00:00
main :: IO ()
2019-04-15 20:23:25 +00:00
main = do
conn <- connectPostgreSQL
"host='localhost' port=5432 dbname='mateamt' user='mateamt' password='mateamt'"
2019-04-16 11:03:07 +00:00
execute_ conn initUser
2019-04-16 12:02:41 +00:00
execute_ conn initBeverage
2019-04-16 11:30:16 +00:00
withStdoutLogger $ \log -> do
let settings = setPort 3000 $ setLogger log defaultSettings
runSettings settings (app conn)
2019-04-15 20:23:25 +00:00
app :: Connection -> Application
app conn = serve userApi (users conn)
userApi :: Proxy UserAPI
userApi = Proxy
users :: Connection -> Server UserAPI
users conn =
userList :<|>
2019-04-16 04:23:08 +00:00
userNew :<|>
userUpdate
2019-04-15 20:23:25 +00:00
where
userList :: Maybe Refine -> Handler [User]
userList ref = liftIO $ userSelect conn ref
userNew :: UserSubmit -> Handler Int
userNew us = liftIO $ do
now <- getCurrentTime
head <$> runInsert_ conn (insertUser us (utctDay now))
2019-04-16 04:23:08 +00:00
userUpdate :: (Int, UserSubmit) -> Handler ()
userUpdate (id, us) = liftIO $ do
now <- getCurrentTime
void $ runUpdate_ conn (updateUser id us (utctDay now))