-
Notifications
You must be signed in to change notification settings - Fork 3
/
Db.hs
87 lines (75 loc) · 2.51 KB
/
Db.hs
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Db (
User(..)
, Todo(..)
, createTables
, saveTodo
, listTodos) where
import Control.Applicative
import Control.Monad
import Data.Aeson
import Data.Int (Int64)
import Data.Maybe
import qualified Data.Text as T
import Database.SQLite.Simple
data User = User Int T.Text
data Todo =
Todo
{ todoId :: Maybe Int64
, todoText :: T.Text
, todoDone :: Bool
} deriving (Show)
instance FromJSON Todo where
parseJSON (Object v) =
Todo <$> optional (v .: "id")
<*> v .: "text"
<*> v .: "done"
parseJSON _ = mzero
instance ToJSON Todo where
toJSON (Todo i text done) =
object [ "id" .= fromJust i
, "text" .= text
, "done" .= done
]
instance FromRow Todo where
fromRow = Todo <$> field <*> field <*> field
tableExists :: Connection -> String -> IO Bool
tableExists conn tblName = do
r <- query conn "SELECT name FROM sqlite_master WHERE type='table' AND name=?" (Only tblName)
case r of
[Only (_ :: String)] -> return True
_ -> return False
-- | Create the necessary database tables, if not already initialized.
createTables :: Connection -> IO ()
createTables conn = do
-- Note: for a bigger app, you probably want to create a 'version'
-- table too and use it to keep track of schema version and
-- implement your schema upgrade procedure here.
schemaCreated <- tableExists conn "todos"
unless schemaCreated $
execute_ conn
(Query $
T.concat [ "CREATE TABLE todos ("
, "id INTEGER PRIMARY KEY, "
, "user_id INTEGER NOT NULL, "
, "saved_on TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL, "
, "text TEXT, "
, "done BOOLEAN)"])
-- | Retrieve a user's list of comments
listTodos :: Connection -> User -> IO [Todo]
listTodos conn (User uid _) =
query conn "SELECT id,text,done FROM todos WHERE user_id = ?" (Only uid)
-- | Save or update a todo
saveTodo :: Connection -> User -> Todo -> IO Todo
saveTodo conn (User uid _) t =
maybe newTodo updateTodo (todoId t)
where
newTodo = do
execute conn "INSERT INTO todos (user_id,text,done) VALUES (?,?,?)"
(uid, todoText t, todoDone t)
rowId <- lastInsertRowId conn
return $ t { todoId = Just rowId }
updateTodo tid = do
execute conn "UPDATE todos SET text = ?, done = ? WHERE (user_id = ? AND id = ?)"
(todoText t, todoDone t, uid, tid)
return t