1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
{-# LANGUAGE OverloadedStrings #-}
module Model.User
( UserId
, User(..)
, list
, getUser
, 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.Time.Clock (UTCTime)
import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
import Prelude hiding (id)
import qualified Database.SQLite.Simple as SQLite
import Model.Query (Query(Query))
type UserId = Int64
data User = User
{ id :: UserId
, creation :: UTCTime
, email :: Text
, name :: Text
} deriving Show
instance FromRow User where
fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
list :: Query [User]
list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
getUser :: Text -> Query (Maybe User)
getUser userEmail =
Query (\conn -> listToMaybe <$>
SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
)
findUser :: UserId -> [User] -> Maybe User
findUser userId = find ((==) userId . id)
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 -> Query ()
deleteUser userEmail =
Query (\conn ->
SQLite.execute conn "DELETE FROM user WHERE email = ?" (Only userEmail)
)
|
