Replace persistent by sqlite-simple

1 files changed, 81 insertions, 47 deletions

diff --git a/src/server/Model/Category.hs b/src/server/Model/Category.hs
index 50c3622..9597bd9 100644
--- a/src/server/Model/Category.hs
+++ b/src/server/Model/Category.hs
@@ -1,56 +1,90 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.Category
-  ( list
+  ( CategoryId
+  , Category(..)
+  , list
   , create
   , edit
   , delete
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Maybe (isJust)
+import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
+import qualified Database.SQLite.Simple as SQLite
+
+import Model.Query (Query(Query))
+
+type CategoryId = Int64
+
+data Category = Category
+  { id :: CategoryId
+  , name :: Text
+  , color :: Text
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
+
+instance FromRow Category where
+  fromRow = Category <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
+
+list :: Query [Category]
+list =
+  Query (\conn ->
+    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 <- listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId) :: IO [Category])
+    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
+  )
 
-import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist hiding (delete)
-
-import Model.Database
-import qualified Model.Json.Category as Json
-
-list :: Persist [Json.Category]
-list = map getJsonCategory <$> selectList [ CategoryDeletedAt ==. Nothing ] []
-
-getJsonCategory :: Entity Category -> Json.Category
-getJsonCategory categoryEntity =
-  Json.Category (entityKey categoryEntity) (categoryName category) (categoryColor category)
-  where category = entityVal categoryEntity
-
-create :: Text -> Text -> Persist CategoryId
-create name color = do
-  now <- liftIO getCurrentTime
-  insert (Category name color now Nothing Nothing)
-
-edit :: CategoryId -> Text -> Text -> Persist Bool
-edit categoryId name color = do
-  mbCategory <- get categoryId
-  if isJust mbCategory
-    then do
-      now <- liftIO getCurrentTime
-      update categoryId
-        [ CategoryEditedAt =. Just now
-        , CategoryName =. name
-        , CategoryColor =. color
-        ]
-      return True
-    else
-      return False
-
-delete :: CategoryId -> Persist Bool
-delete categoryId = do
-  mbCategory <- get categoryId
-  if isJust mbCategory
-    then do
-      now <- liftIO getCurrentTime
-      update categoryId [CategoryDeletedAt =. Just now]
-      return True
-    else
-      return False
+delete :: CategoryId -> Query Bool
+delete categoryId =
+  Query (\conn -> do
+    mbCategory <- listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId) :: IO [Category])
+    if isJust mbCategory
+      then do
+        now <- getCurrentTime
+        SQLite.execute
+          conn
+          "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
+        return True
+      else
+        return False
+  )