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:
parent
660b8d43e5
commit
1d47e94bbe
6 changed files with 117 additions and 34 deletions
45
src/API.hs
45
src/API.hs
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue