Add category page

13 files changed, 187 insertions, 129 deletions

diff --git a/server/server.cabal b/server/server.cabal
index c9ab2c7..cc6172d 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -94,10 +94,11 @@ Executable server
     Job.Model
     Job.MonthlyPayment
     Job.WeeklyReport
-    Json
     LoginSession
+    Model.CreateCategory
     Model.CreateIncome
     Model.CreatePayment
+    Model.EditCategory
     Model.EditIncome
     Model.EditPayment
     Model.IncomeResource
@@ -116,6 +117,7 @@ Executable server
     Secure
     SendMail
     Util.Time
+    Validation.Category
     Validation.Income
     Validation.Payment
     View.Mail.SignIn
diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs
index 8fbc8c8..36ce3fc 100644
--- a/server/src/Controller/Category.hs
+++ b/server/src/Controller/Category.hs
@@ -1,5 +1,6 @@
 module Controller.Category
-  ( list
+  ( listAll
+  , list
   , create
   , edit
   , delete
@@ -7,37 +8,68 @@ module Controller.Category
 
 import           Control.Monad.IO.Class    (liftIO)
 import qualified Data.Text.Lazy            as TL
+import           Data.Validation           (Validation (..))
 import           Network.HTTP.Types.Status (badRequest400, ok200)
 import           Web.Scotty                hiding (delete)
 
-import           Common.Model              (CategoryId, CreateCategory (..),
-                                            EditCategory (..))
+import           Common.Model              (CategoryId, CategoryPage (..),
+                                            CreateCategoryForm (..),
+                                            EditCategoryForm (..))
 import qualified Common.Msg                as Msg
 
-import           Json                      (jsonId)
+import qualified Controller.Helper         as ControllerHelper
+import           Model.CreateCategory      (CreateCategory (..))
+import           Model.EditCategory        (EditCategory (..))
 import qualified Model.Query               as Query
 import qualified Persistence.Category      as CategoryPersistence
 import qualified Secure
+import qualified Validation.Category       as CategoryValidation
 
-list :: ActionM ()
-list =
+listAll :: ActionM ()
+listAll =
   Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ CategoryPersistence.list) >>= json
+    (liftIO . Query.run $ CategoryPersistence.listAll) >>= json
   )
 
-create :: CreateCategory -> ActionM ()
-create (CreateCategory name color) =
+list :: Int -> Int -> ActionM ()
+list page perPage =
   Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ CategoryPersistence.create name color) >>= jsonId
+    (liftIO . Query.run $ do
+      categories <- CategoryPersistence.list page perPage
+      count <- CategoryPersistence.count
+      return $ CategoryPage page categories count
+    ) >>= json
   )
 
-edit :: EditCategory -> ActionM ()
-edit (EditCategory categoryId name color) =
-  Secure.loggedAction (\_ -> do
-    updated <- liftIO . Query.run $ CategoryPersistence.edit categoryId name color
-    if updated
-      then status ok200
-      else status badRequest400
+create :: CreateCategoryForm -> ActionM ()
+create form =
+  Secure.loggedAction (\_ ->
+    (liftIO . Query.run $ do
+      case CategoryValidation.createCategory form of
+        Success (CreateCategory name color) -> do
+          Right <$> (CategoryPersistence.create name color)
+
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.okOrBadRequest
+  )
+
+edit :: EditCategoryForm -> ActionM ()
+edit form =
+  Secure.loggedAction (\_ ->
+    (liftIO . Query.run $ do
+      case CategoryValidation.editCategory form of
+        Success (EditCategory categoryId name color) ->
+          do
+            isSuccess <- CategoryPersistence.edit categoryId name color
+            return $ if isSuccess then
+              Right ()
+            else
+              Left $ Msg.get Msg.Error_CategoryEdit
+
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 delete :: CategoryId -> ActionM ()
diff --git a/server/src/Controller/Helper.hs b/server/src/Controller/Helper.hs
index fd0d2bb..dc9cbc4 100644
--- a/server/src/Controller/Helper.hs
+++ b/server/src/Controller/Helper.hs
@@ -1,17 +1,16 @@
 module Controller.Helper
-  ( jsonOrBadRequest
+  ( okOrBadRequest
   ) where
 
-import           Data.Aeson                (ToJSON)
 import           Data.Text                 (Text)
 import qualified Data.Text.Lazy            as LT
 import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                (ActionM)
 import qualified Web.Scotty                as S
 
-jsonOrBadRequest :: forall a. (ToJSON a) => Either Text a -> ActionM ()
-jsonOrBadRequest (Left message) = do
+okOrBadRequest :: Either Text () -> ActionM ()
+okOrBadRequest (Left message) = do
   S.status Status.badRequest400
   S.text (LT.fromStrict message)
-jsonOrBadRequest (Right a) =
-  S.json a
+okOrBadRequest (Right ()) =
+  S.status Status.ok200
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 784a2db..96ccbbc 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -8,7 +8,7 @@ module Controller.Income
 import           Control.Monad.IO.Class    (liftIO)
 import qualified Data.Map                  as M
 import qualified Data.Time.Clock           as Clock
-import           Data.Validation           (Validation (Failure, Success))
+import           Data.Validation           (Validation (..))
 import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
@@ -16,6 +16,7 @@ import           Common.Model              (CreateIncomeForm (..),
                                             EditIncomeForm (..),
                                             IncomeHeader (..), IncomeId,
                                             IncomePage (..), User (..))
+import qualified Common.Msg                as Msg
 
 import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
@@ -60,7 +61,7 @@ create form =
 
         Failure validationError ->
           return $ Left validationError
-    ) >>= ControllerHelper.jsonOrBadRequest
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 edit :: EditIncomeForm -> ActionM ()
@@ -68,12 +69,17 @@ edit form =
   Secure.loggedAction (\user ->
     (liftIO . Query.run $ do
       case IncomeValidation.editIncome form of
-        Success (EditIncome incomeId amount date) -> do
-          Right <$> (IncomePersistence.edit (_user_id user) incomeId date amount)
+        Success (EditIncome incomeId amount date) ->
+          do
+            isSuccess <- IncomePersistence.edit (_user_id user) incomeId date amount
+            return $ if isSuccess then
+              Right ()
+            else
+              Left $ Msg.get Msg.Error_IncomeEdit
 
         Failure validationError ->
           return $ Left validationError
-    ) >>= ControllerHelper.jsonOrBadRequest
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 delete :: IncomeId -> ActionM ()
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index 42a4436..d6aa34f 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -8,7 +8,6 @@ module Controller.Payment
 
 import           Control.Monad.IO.Class (liftIO)
 import qualified Data.Map               as M
-import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import qualified Data.Time.Calendar     as Calendar
 import           Data.Validation        (Validation (Failure, Success))
@@ -77,30 +76,30 @@ create :: CreatePaymentForm -> ActionM ()
 create form =
   Secure.loggedAction (\user ->
     (liftIO . Query.run $ do
-      cs <- map _category_id <$> CategoryPersistence.list
+      cs <- map _category_id <$> CategoryPersistence.listAll
       case PaymentValidation.createPayment cs form of
         Success (CreatePayment name cost date category frequency) ->
           Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency
         Failure validationError ->
           return $ Left validationError
-    ) >>= ControllerHelper.jsonOrBadRequest
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 edit :: EditPaymentForm -> ActionM ()
 edit form =
   Secure.loggedAction (\user ->
     (liftIO . Query.run $ do
-      cs <- map _category_id <$> CategoryPersistence.list
+      cs <- map _category_id <$> CategoryPersistence.listAll
       case PaymentValidation.editPayment cs form of
         Success (EditPayment paymentId name cost date category frequency) -> do
-          editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
-          if Maybe.isJust editedPayment then
-            return . Right $ editedPayment
+          isSuccess <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
+          return $ if isSuccess then
+            Right ()
           else
-            return . Left $ Msg.get Msg.Error_PaymentEdit
+            Left $ Msg.get Msg.Error_PaymentEdit
         Failure validationError ->
           return $ Left validationError
-    ) >>= ControllerHelper.jsonOrBadRequest
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 delete :: PaymentId -> ActionM ()
diff --git a/server/src/Json.hs b/server/src/Json.hs
deleted file mode 100644
index 6d40305..0000000
--- a/server/src/Json.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Json
-  ( jsonObject
-  , jsonId
-  ) where
-
-import qualified Data.Aeson.Types    as Json
-import qualified Data.HashMap.Strict as M
-import           Data.Int            (Int64)
-import           Data.Text           (Text)
-import           Web.Scotty
-
-jsonObject :: [(Text, Json.Value)] -> ActionM ()
-jsonObject = json . Json.Object . M.fromList
-
-jsonId :: Int64 -> ActionM ()
-jsonId key = json . Json.Object . M.fromList $ [("id", Json.Number . fromIntegral $ key)]
diff --git a/server/src/Main.hs b/server/src/Main.hs
index f4d75a0..0b80de0 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -77,8 +77,13 @@ main = do
       incomeId <- S.param "id"
       Income.delete incomeId
 
-    S.get "/api/categories" $
-      Category.list
+    S.get "/api/allCategories" $ do
+      Category.listAll
+
+    S.get "/api/categories" $ do
+      page <- S.param "page"
+      perPage <- S.param "perPage"
+      Category.list page perPage
 
     S.post "/api/category" $
       S.jsonData >>= Category.create
diff --git a/server/src/Model/CreateCategory.hs b/server/src/Model/CreateCategory.hs
new file mode 100644
index 0000000..dae061b
--- /dev/null
+++ b/server/src/Model/CreateCategory.hs
@@ -0,0 +1,10 @@
+module Model.CreateCategory
+  ( CreateCategory(..)
+  ) where
+
+import           Data.Text (Text)
+
+data CreateCategory = CreateCategory
+  { _createCategory_name  :: Text
+  , _createCategory_color :: Text
+  } deriving (Show)
diff --git a/server/src/Model/EditCategory.hs b/server/src/Model/EditCategory.hs
new file mode 100644
index 0000000..8ee26ac
--- /dev/null
+++ b/server/src/Model/EditCategory.hs
@@ -0,0 +1,13 @@
+module Model.EditCategory
+  ( EditCategory(..)
+  ) where
+
+import           Data.Text    (Text)
+
+import           Common.Model (CategoryId)
+
+data EditCategory = EditCategory
+  { _editCategory_id    :: CategoryId
+  , _editCategory_name  :: Text
+  , _editCategory_color :: Text
+  } deriving (Show)
diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
index 00cf0a5..2934b28 100644
--- a/server/src/Persistence/Category.hs
+++ b/server/src/Persistence/Category.hs
@@ -1,5 +1,7 @@
 module Persistence.Category
-  ( list
+  ( count
+  , list
+  , listAll
   , create
   , edit
   , delete
@@ -27,14 +29,37 @@ instance FromRow Row where
     SQLite.field <*>
     SQLite.field)
 
-list :: Query [Category]
-list =
+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.query
+          conn
+          "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY edited_at, created_at DESC LIMIT ? OFFSET ?"
+          (perPage, (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 CategoryId
+create :: Text -> Text -> Query ()
 create categoryName categoryColor =
   Query (\conn -> do
     now <- getCurrentTime
@@ -42,7 +67,6 @@ create categoryName categoryColor =
       conn
       "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
       (categoryName, categoryColor, now)
-    SQLite.lastInsertRowId conn
   )
 
 edit :: CategoryId -> Text -> Text -> Query Bool
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index e689505..cd98814 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -78,7 +78,7 @@ listModifiedSince since =
         (since, since, since)
   )
 
-create :: UserId -> Day -> Int -> Query Income
+create :: UserId -> Day -> Int -> Query ()
 create userId date amount =
   Query (\conn -> do
     createdAt <- getCurrentTime
@@ -86,42 +86,23 @@ create userId date amount =
       conn
       "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
       (userId, date, amount, createdAt)
-    incomeId <- SQLite.lastInsertRowId conn
-    return $ Income
-      { _income_id        = incomeId
-      , _income_userId    = userId
-      , _income_date      = date
-      , _income_amount    = amount
-      , _income_createdAt = createdAt
-      , _income_editedAt  = Nothing
-      , _income_deletedAt = Nothing
-      }
   )
 
-edit :: UserId -> IncomeId -> Day -> Int -> Query (Maybe Income)
+edit :: UserId -> IncomeId -> Day -> Int -> Query Bool
 edit userId incomeId incomeDate incomeAmount =
   Query (\conn -> do
-    mbIncome <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
+    income <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
       SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
-    case mbIncome of
-      Just income ->
-        do
-          currentTime <- getCurrentTime
-          SQLite.execute
-            conn
-            "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ? AND user_id = ?"
-            (currentTime, incomeDate, incomeAmount, incomeId, userId)
-          return . Just $ Income
-            { _income_id        = incomeId
-            , _income_userId    = userId
-            , _income_date      = incomeDate
-            , _income_amount    = incomeAmount
-            , _income_createdAt = _income_createdAt income
-            , _income_editedAt  = Just currentTime
-            , _income_deletedAt = Nothing
-            }
-      Nothing ->
-        return Nothing
+    if Maybe.isJust income then
+      do
+        currentTime <- getCurrentTime
+        SQLite.execute
+          conn
+          "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ? AND user_id = ?"
+          (currentTime, incomeDate, incomeAmount, incomeId, userId)
+        return True
+    else
+      return False
   )
 
 delete :: UserId -> PaymentId -> Query ()
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index 953f0ae..da877ff 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -190,30 +190,17 @@ listActiveMonthlyOrderedByName =
         (Only (FrequencyField Monthly))
   )
 
-create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Payment
+create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query ()
 create userId name cost date category frequency =
   Query (\conn -> do
-    time <- getCurrentTime
+    currentTime <- getCurrentTime
     SQLite.execute
       conn
       (SQLite.Query $ T.intercalate " "
         [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
         , "VALUES (?, ?, ?, ?, ?, ?, ?)"
         ])
-      (userId, name, cost, date, category, FrequencyField frequency, time)
-    paymentId <- SQLite.lastInsertRowId conn
-    return $ Payment
-      { _payment_id        = paymentId
-      , _payment_user      = userId
-      , _payment_name      = name
-      , _payment_cost      = cost
-      , _payment_date      = date
-      , _payment_category  = category
-      , _payment_frequency = frequency
-      , _payment_createdAt = time
-      , _payment_editedAt  = Nothing
-      , _payment_deletedAt = Nothing
-      }
+      (userId, name, cost, date, category, FrequencyField frequency, currentTime)
   )
 
 createMany :: [Payment] -> Query ()
@@ -228,17 +215,17 @@ createMany payments =
       (map InsertRow payments)
   )
 
-edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query (Maybe Payment)
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Bool
 edit userId paymentId name cost date category frequency =
   Query (\conn -> do
-    mbPayment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
+    payment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
       SQLite.query
         conn
         (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ? and user_id = ?")
         (paymentId, userId)
-    case mbPayment of
-      Just payment -> do
-        now <- getCurrentTime
+    if Maybe.isJust payment then
+      do
+        currentTime <- getCurrentTime
         SQLite.execute
           conn
           (SQLite.Query $ T.intercalate " "
@@ -255,7 +242,7 @@ edit userId paymentId name cost date category frequency =
             , "  id = ?"
             , "  AND user_id = ?"
             ])
-          ( now
+          ( currentTime
           , name
           , cost
           , date
@@ -264,20 +251,9 @@ edit userId paymentId name cost date category frequency =
           , paymentId
           , userId
           )
-        return . Just $ Payment
-          { _payment_id        = paymentId
-          , _payment_user      = userId
-          , _payment_name      = name
-          , _payment_cost      = cost
-          , _payment_date      = date
-          , _payment_category  = category
-          , _payment_frequency = frequency
-          , _payment_createdAt = _payment_createdAt payment
-          , _payment_editedAt  = Just now
-          , _payment_deletedAt = Nothing
-          }
-      Nothing ->
-        return Nothing
+        return True
+    else
+      return False
   )
 
 delete :: UserId -> PaymentId -> Query ()
diff --git a/server/src/Validation/Category.hs b/server/src/Validation/Category.hs
new file mode 100644
index 0000000..12f2117
--- /dev/null
+++ b/server/src/Validation/Category.hs
@@ -0,0 +1,27 @@
+module Validation.Category
+  ( createCategory
+  , editCategory
+  ) where
+
+import           Data.Text                  (Text)
+import           Data.Validation            (Validation)
+import qualified Data.Validation            as V
+
+import           Common.Model               (CreateCategoryForm (..),
+                                             EditCategoryForm (..))
+import qualified Common.Validation.Category as CategoryValidation
+import           Model.CreateCategory       (CreateCategory (..))
+import           Model.EditCategory         (EditCategory (..))
+
+createCategory :: CreateCategoryForm -> Validation Text CreateCategory
+createCategory form =
+  CreateCategory
+    <$> CategoryValidation.name (_createCategoryForm_name form)
+    <*> CategoryValidation.color (_createCategoryForm_color form)
+
+editCategory :: EditCategoryForm -> Validation Text EditCategory
+editCategory form =
+  EditCategory
+    <$> V.Success (_editCategoryForm_id form)
+    <*> CategoryValidation.name (_editCategoryForm_name form)
+    <*> CategoryValidation.color (_editCategoryForm_color form)