From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Jan 2018 12:13:09 +0100
Subject: WIP

---
 server/src/Persistence/Category.hs | 79 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 server/src/Persistence/Category.hs

(limited to 'server/src/Persistence/Category.hs')

diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
new file mode 100644
index 0000000..2afe5db
--- /dev/null
+++ b/server/src/Persistence/Category.hs
@@ -0,0 +1,79 @@
+module Persistence.Category
+  ( list
+  , create
+  , edit
+  , delete
+  ) where
+
+import           Data.Maybe             (isJust, listToMaybe)
+import           Data.Text              (Text)
+import           Data.Time.Clock        (getCurrentTime)
+import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import qualified Database.SQLite.Simple as SQLite
+import           Prelude                hiding (id)
+
+import           Common.Model           (Category (..), CategoryId)
+
+import           Model.Query            (Query (Query))
+
+newtype Row = Row Category
+
+instance FromRow Row where
+  fromRow = Row <$> (Category <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field)
+
+list :: Query [Category]
+list =
+  Query (\conn ->
+    map (\(Row c) -> c) <$>
+      SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
+  )
+
+create :: Text -> Text -> Query CategoryId
+create categoryName categoryColor =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
+      (categoryName, categoryColor, now)
+    SQLite.lastInsertRowId conn
+  )
+
+edit :: CategoryId -> Text -> Text -> Query Bool
+edit categoryId categoryName categoryColor =
+  Query (\conn -> do
+    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
+    if isJust mbCategory
+      then do
+        now <- getCurrentTime
+        SQLite.execute
+          conn
+          "UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?"
+          (now, categoryName, categoryColor, categoryId)
+        return True
+      else
+        return False
+  )
+
+delete :: CategoryId -> Query Bool
+delete categoryId =
+  Query (\conn -> do
+    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
+    if isJust mbCategory
+      then do
+        now <- getCurrentTime
+        SQLite.execute
+          conn
+          "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
+        return True
+      else
+        return False
+  )
-- 
cgit v1.2.3