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/Income.hs | 148 ++++++++++++++++++++++++++++-----------------
 1 file changed, 93 insertions(+), 55 deletions(-)

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

diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index ff6accd..c6cdb55 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,73 +1,111 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.Income
-  ( list
+  ( IncomeId
+  , Income(..)
+  , list
   , create
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
-import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
 import Data.Time.Calendar (Day)
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
+import Prelude hiding (id)
+import qualified Database.SQLite.Simple as SQLite
+
+import Model.Query (Query(Query))
+import Model.User (User, UserId)
+import qualified Model.User as User
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-import Control.Monad.IO.Class (liftIO)
+type IncomeId = Int64
 
-import Database.Persist
+data Income = Income
+  { id :: IncomeId
+  , userId :: UserId
+  , date :: Day
+  , amount :: Int
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
 
-import Model.Database
-import qualified Model.Json.Income as Json
+instance Resource Income where
+  resourceCreatedAt = createdAt
+  resourceEditedAt = editedAt
+  resourceDeletedAt = deletedAt
 
-list :: Persist [Json.Income]
-list = map getJsonIncome <$> selectList [IncomeDeletedAt ==. Nothing] []
+instance FromRow Income where
+  fromRow = Income <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-getJsonIncome :: Entity Income -> Json.Income
-getJsonIncome incomeEntity =
-  Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeDate income) (incomeAmount income)
-  where income = entityVal incomeEntity
+list :: Query [Income]
+list = Query (\conn -> SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL")
 
-create :: UserId -> Day -> Int -> Persist IncomeId
-create userId date amount = do
-  now <- liftIO getCurrentTime
-  insert (Income userId date amount now Nothing Nothing)
+create :: UserId -> Day -> Int -> Query IncomeId
+create incomeUserId incomeDate incomeAmount =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
+      (incomeUserId, incomeDate, incomeAmount, now)
+    SQLite.lastInsertRowId conn
+  )
 
-editOwn :: UserId -> IncomeId -> Day -> Int -> Persist Bool
-editOwn userId incomeId date amount = do
-  mbIncome <- get incomeId
-  case mbIncome of
-    Just income ->
-      if incomeUserId income == userId
-        then do
-          now <- liftIO getCurrentTime
-          update incomeId
-            [ IncomeEditedAt =. Just now
-            , IncomeDate =. date
-            , IncomeAmount =. amount
-            ]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
+editOwn :: UserId -> IncomeId -> Day -> Int -> Query Bool
+editOwn incomeUserId incomeId incomeDate incomeAmount =
+  Query (\conn -> do
+    mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
+    case mbIncome of
+      Just income ->
+        if userId income == incomeUserId
+          then do
+            now <- getCurrentTime
+            SQLite.execute
+              conn
+              "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ?"
+              (now, incomeDate, incomeAmount, incomeId)
+            return True
+          else
+            return False
+      Nothing ->
+        return False
+  )
 
-deleteOwn :: Entity User -> IncomeId -> Persist Bool
-deleteOwn user incomeId = do
-  mbIncome <- get incomeId
-  case mbIncome of
-    Just income ->
-      if incomeUserId income == entityKey user
-        then do
-          now <- liftIO getCurrentTime
-          update incomeId [IncomeDeletedAt =. Just now]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
+deleteOwn :: User -> IncomeId -> Query Bool
+deleteOwn user incomeId =
+  Query (\conn -> do
+    mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
+    case mbIncome of
+      Just income ->
+        if userId income == User.id user
+          then do
+            now <- getCurrentTime
+            SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
+            return True
+          else
+            return False
+      Nothing ->
+        return False
+  )
 
-modifiedDuring :: UTCTime -> UTCTime -> Persist [Income]
+modifiedDuring :: UTCTime -> UTCTime -> Query [Income]
 modifiedDuring start end =
-  map entityVal <$> selectList
-    (   [IncomeCreatedAt >=. start, IncomeCreatedAt <. end]
-    ||. [IncomeEditedAt >=. Just start, IncomeEditedAt <. Just end]
-    ||. [IncomeDeletedAt >=. Just start, IncomeDeletedAt <. Just end]
-    )
-    []
+  Query (\conn ->
+    SQLite.query
+      conn
+      "SELECT * FROM income WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
+      (start, end, start, end, start, end)
+  )
-- 
cgit v1.2.3