From 0b191f5c48edffc9da3e38c284e9640fd82e7cb1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 5 Jun 2017 18:02:13 +0200
Subject: Replace persistent by sqlite-simple

---
 src/server/Model/User.hs | 70 +++++++++++++++++++++++++++++++-----------------
 1 file changed, 46 insertions(+), 24 deletions(-)

(limited to 'src/server/Model/User.hs')

diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
index ab39822..c8a0d53 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,42 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.User
-  ( list
+  ( UserId
+  , User(..)
+  , list
   , getUser
-  , getJson
   , findUser
   , createUser
   , deleteUser
   ) where
 
+import Data.Int (Int64)
+import Data.List (find)
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
-import Data.List (find)
+import Data.Time.Clock (UTCTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
+import Prelude hiding (id)
+import qualified Database.SQLite.Simple as SQLite
 
-import Control.Monad.IO.Class (liftIO)
+import Model.Query (Query(Query))
 
-import Database.Persist
+type UserId = Int64
 
-import Model.Database
-import qualified Model.Json.User as Json
+data User = User
+  { id :: UserId
+  , creation :: UTCTime
+  , email :: Text
+  , name :: Text
+  } deriving Show
 
-list :: Persist [Entity User]
-list = selectList [] [Desc UserCreation]
+instance FromRow User where
+  fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
 
-getUser :: Text -> Persist (Maybe (Entity User))
-getUser email = selectFirst [UserEmail ==. email] []
+list :: Query [User]
+list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
 
-findUser :: UserId -> [Entity User] -> Maybe User
-findUser i = fmap entityVal . find ((==) i . entityKey)
+getUser :: Text -> Query (Maybe User)
+getUser userEmail =
+  Query (\conn -> listToMaybe <$>
+    SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
+  )
 
-getJson :: Entity User -> Json.User
-getJson userEntity =
-  let user = entityVal userEntity
-  in  Json.User (entityKey userEntity) (userName user) (userEmail user)
+findUser :: UserId -> [User] -> Maybe User
+findUser userId = find ((==) userId . id)
 
-createUser :: Text -> Text -> Persist UserId
-createUser email name = do
-  now <- liftIO getCurrentTime
-  insert $ User now email name
+createUser :: Text -> Text -> Query UserId
+createUser userEmail userName =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO user (creation, email, name) VALUES (?, ?, ?)"
+      (now, userEmail, userName)
+    SQLite.lastInsertRowId conn
+  )
 
-deleteUser :: Text -> Persist ()
-deleteUser email =
-  deleteWhere [UserEmail ==. email]
+deleteUser :: Text -> Query ()
+deleteUser userEmail =
+  Query (\conn ->
+    SQLite.execute conn "DELETE FROM user WHERE email = ?" (Only userEmail)
+  )
-- 
cgit v1.2.3