Integrate Persistent with Servant

Query my SQLite database from within my Servant handlers. Nothing I've written
is domain-specific to the business logic yet -- I'm just making sure everything
integrates.
This commit is contained in:
William Carroll 2020-07-24 22:46:54 +01:00
parent 660b8d43e5
commit 1d47e94bbe
6 changed files with 117 additions and 34 deletions

View file

@ -1,39 +1,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
--------------------------------------------------------------------------------
module API where
--------------------------------------------------------------------------------
import qualified Data.Pool as DP
import qualified Database.SQLite.Simple as DB
import Data.Proxy
import Data.Text
import Database.Persist
import Servant.API
import Data.Aeson
import GHC.Generics
import GHC.TypeLits
import Network.Wai.Handler.Warp
import Servant
import Control.Monad.IO.Class
import qualified Types as T
--------------------------------------------------------------------------------
handlers :: DP.Pool DB.Connection -> Server API
handlers pool = do
getHandler pool :<|> pure 0
getHandler :: DP.Pool DB.Connection -> Handler Int
getHandler pool =
DP.withResource pool $ \conn -> do
result <- liftIO $ DB.query_ conn "select 2 + 2"
case result of
[DB.Only x] -> pure x
_ -> pure (-1)
type API = "number" :> Get '[JSON] Int
:<|> "other" :> Post '[JSON] Int
main :: IO ()
main = do
pool <- DP.createPool (DB.open "data.db") DB.close 1 0.5 1
run 3000 (serve (Proxy @ API) (handlers pool))
type API = "user"
:> ReqBody '[JSON] T.User
:> Post '[JSON] (Maybe (Key T.User))
:<|> "user"
:> Capture "name" Text
:> Get '[JSON] (Maybe T.User)