From 1d47e94bbe26479ffaaafecd27cdb83d072bfe01 Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Fri, 24 Jul 2020 22:46:54 +0100
Subject: 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.
---
 src/API.hs | 45 ++++++++++++++-------------------------------
 1 file changed, 14 insertions(+), 31 deletions(-)

(limited to 'src/API.hs')

diff --git a/src/API.hs b/src/API.hs
index b2c7fd57d67f..b46ae5b3560f 100644
--- a/src/API.hs
+++ b/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)
-- 
cgit 1.4.1