1 files changed, 123 insertions, 0 deletions
diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
new file mode 100644
index 0000000..b0a6fca
--- /dev/null
+++ b/server/src/Persistence/Category.hs
@@ -0,0 +1,123 @@
+module Persistence.Category
+  ( count
+  , list
+  , listAll
+  , create
+  , edit
+  , delete
+  ) where
+
+import qualified Data.Maybe             as Maybe
+import           Data.Text              (Text)
+import           Data.Time.Clock        (getCurrentTime)
+import           Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
+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)
+
+data CountRow = CountRow Int
+
+instance FromRow CountRow where
+  fromRow = CountRow <$> SQLite.field
+
+count :: Query Int
+count =
+  Query (\conn ->
+    (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$>
+      SQLite.query_ conn "SELECT COUNT(*) FROM category WHERE deleted_at IS NULL"
+  )
+
+
+list :: Int -> Int -> Query [Category]
+list page perPage =
+  Query (\conn ->
+    map (\(Row c) -> c) <$>
+      SQLite.queryNamed
+          conn
+          "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY name LIMIT :limit OFFSET :offset"
+          [ ":limit" := perPage
+          , ":offset" := (page - 1) * perPage
+          ]
+  )
+
+listAll :: Query [Category]
+listAll =
+  Query (\conn ->
+    map (\(Row c) -> c) <$>
+      SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
+  )
+
+create :: Text -> Text -> Query ()
+create name color =
+  Query (\conn -> do
+    currentTime <- getCurrentTime
+    SQLite.executeNamed
+      conn
+      "INSERT INTO category (name, color, created_at) VALUES (:name, :color, :created_at)"
+      [ ":name" := name
+      , ":color" := color
+      , ":created_at" := currentTime
+      ]
+  )
+
+edit :: CategoryId -> Text -> Text -> Query Bool
+edit id name color =
+  Query (\conn -> do
+    mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
+      (SQLite.queryNamed conn "SELECT * FROM category WHERE id = :id" [ ":id" := id ])
+    if Maybe.isJust mbCategory
+      then do
+        currentTime <- getCurrentTime
+        SQLite.executeNamed
+          conn
+          "UPDATE category SET edited_at = :editedAt, name = :name, color = :color WHERE id = :id"
+          [ ":editedAt" := currentTime
+          , ":name" := name
+          , ":color" := color
+          , ":id" := id
+          ]
+        return True
+      else
+        return False
+  )
+
+data BoolRow = BoolRow Int
+
+instance FromRow BoolRow where
+  fromRow = BoolRow <$> SQLite.field
+
+delete :: CategoryId -> Query Bool
+delete id =
+  Query (\conn -> do
+    mbPayment <- (fmap (\(BoolRow b) -> b) . Maybe.listToMaybe) <$>
+      (SQLite.queryNamed
+        conn
+        "SELECT true FROM payment WHERE category = :id AND deleted_at IS NULL"
+        [ ":id" := id ])
+    if Maybe.isNothing mbPayment
+      then do
+        currentTime <- getCurrentTime
+        SQLite.executeNamed
+          conn
+          "UPDATE category SET deleted_at = :deletedAt WHERE id = :id AND deleted_at IS NULL"
+          [ ":deletedAt" := currentTime
+          , ":id" := id
+          ]
+        return True
+      else
+        return False
+  )