From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 8 Dec 2019 11:39:37 +0100
Subject: Add category page

---
 client/client.cabal                           |   5 ++
 client/src/Component/ConfirmDialog.hs         |   6 +-
 client/src/Component/Modal.hs                 |   8 +-
 client/src/Component/ModalForm.hs             |  10 +--
 client/src/Component/Table.hs                 |  18 ++--
 client/src/Component/Tag.hs                   |  27 ++++++
 client/src/Model/Route.hs                     |   1 +
 client/src/Util/Ajax.hs                       |  28 +++++-
 client/src/View/App.hs                        |  43 ++++++----
 client/src/View/Category/Category.hs          |  92 ++++++++++++++++++++
 client/src/View/Category/Form.hs              | 117 ++++++++++++++++++++++++++
 client/src/View/Category/Reducer.hs           |  59 +++++++++++++
 client/src/View/Category/Table.hs             |  91 ++++++++++++++++++++
 client/src/View/Header.hs                     |   5 ++
 client/src/View/Income/Form.hs                |   2 +-
 client/src/View/Income/Header.hs              |   3 +-
 client/src/View/Income/Income.hs              |   1 -
 client/src/View/Income/Init.hs                |  11 ---
 client/src/View/Income/Table.hs               |  11 ++-
 client/src/View/Payment/Form.hs               |   2 +-
 client/src/View/Payment/HeaderForm.hs         |   2 +-
 client/src/View/Payment/Payment.hs            |   2 +-
 client/src/View/Payment/Table.hs              |  30 +++----
 client/src/View/SignIn.hs                     |   2 +-
 common/common.cabal                           |   6 +-
 common/src/Common/Model.hs                    |  45 +++++-----
 common/src/Common/Model/Category.hs           |   2 +-
 common/src/Common/Model/CategoryPage.hs       |  17 ++++
 common/src/Common/Model/CreateCategory.hs     |  14 ---
 common/src/Common/Model/CreateCategoryForm.hs |  15 ++++
 common/src/Common/Model/EditCategory.hs       |  17 ----
 common/src/Common/Model/EditCategoryForm.hs   |  18 ++++
 common/src/Common/Validation/Atomic.hs        |   5 ++
 common/src/Common/Validation/Category.hs      |  15 ++++
 server/server.cabal                           |   4 +-
 server/src/Controller/Category.hs             |  66 +++++++++++----
 server/src/Controller/Helper.hs               |  11 ++-
 server/src/Controller/Income.hs               |  16 ++--
 server/src/Controller/Payment.hs              |  17 ++--
 server/src/Json.hs                            |  16 ----
 server/src/Main.hs                            |   9 +-
 server/src/Model/CreateCategory.hs            |  10 +++
 server/src/Model/EditCategory.hs              |  13 +++
 server/src/Persistence/Category.hs            |  34 ++++++--
 server/src/Persistence/Income.hs              |  45 +++-------
 server/src/Persistence/Payment.hs             |  48 +++--------
 server/src/Validation/Category.hs             |  27 ++++++
 47 files changed, 778 insertions(+), 268 deletions(-)
 create mode 100644 client/src/Component/Tag.hs
 create mode 100644 client/src/View/Category/Category.hs
 create mode 100644 client/src/View/Category/Form.hs
 create mode 100644 client/src/View/Category/Reducer.hs
 create mode 100644 client/src/View/Category/Table.hs
 delete mode 100644 client/src/View/Income/Init.hs
 create mode 100644 common/src/Common/Model/CategoryPage.hs
 delete mode 100644 common/src/Common/Model/CreateCategory.hs
 create mode 100644 common/src/Common/Model/CreateCategoryForm.hs
 delete mode 100644 common/src/Common/Model/EditCategory.hs
 create mode 100644 common/src/Common/Model/EditCategoryForm.hs
 create mode 100644 common/src/Common/Validation/Category.hs
 delete mode 100644 server/src/Json.hs
 create mode 100644 server/src/Model/CreateCategory.hs
 create mode 100644 server/src/Model/EditCategory.hs
 create mode 100644 server/src/Validation/Category.hs

diff --git a/client/client.cabal b/client/client.cabal
index 78ea7d3..227aed2 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -56,6 +56,7 @@ Executable client
     Component.Pages
     Component.Select
     Component.Table
+    Component.Tag
     Loadable
     Model.Route
     Util.Ajax
@@ -73,6 +74,10 @@ Executable client
     View.Income.Income
     View.Income.Reducer
     View.Income.Table
+    View.Category.Form
+    View.Category.Category
+    View.Category.Reducer
+    View.Category.Table
     View.NotFound
     View.Payment.Form
     View.Payment.HeaderForm
diff --git a/client/src/Component/ConfirmDialog.hs b/client/src/Component/ConfirmDialog.hs
index 50e30ed..cf26593 100644
--- a/client/src/Component/ConfirmDialog.hs
+++ b/client/src/Component/ConfirmDialog.hs
@@ -13,12 +13,12 @@ import qualified Component.Modal  as Modal
 import qualified Util.Either      as EitherUtil
 import qualified Util.WaitFor     as WaitFor
 
-data In t m a = In
+data In t m = In
   { _in_header  :: Text
-  , _in_confirm :: Event t () -> m (Event t a)
+  , _in_confirm :: Event t () -> m (Event t ())
   }
 
-view :: forall t m a. MonadWidget t m => (In t m a) -> Modal.Content t m a
+view :: forall t m a. MonadWidget t m => (In t m) -> Modal.Content t m
 view input _ =
   R.divClass "confirm" $ do
     R.divClass "confirmHeader" $
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 08f2e74..46d3f64 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -20,14 +20,14 @@ import qualified Reflex.Dom.Class  as R
 import qualified Util.Reflex       as ReflexUtil
 
 -- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
-type Content t m a = Event t () -> m (Event t (), Event t a)
+type Content t m = Event t () -> m (Event t (), Event t ())
 
-data In t m a = In
+data In t m = In
   { _in_show    :: Event t ()
-  , _in_content :: Content t m a
+  , _in_content :: Content t m
   }
 
-view :: forall t m a. MonadWidget t m => In t m a -> m (Event t a)
+view :: forall t m a. MonadWidget t m => In t m -> m (Event t ())
 view input = do
   rec
     let show = Show <$ (_in_show input)
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
index f5bf287..c56ff88 100644
--- a/client/src/Component/ModalForm.hs
+++ b/client/src/Component/ModalForm.hs
@@ -20,20 +20,20 @@ import qualified Util.Either        as EitherUtil
 import qualified Util.Validation    as ValidationUtil
 import qualified Util.WaitFor       as WaitFor
 
-data In m t a b e = In
+data In m t a e = In
   { _in_headerLabel :: Text
   , _in_form        :: m (Dynamic t (Validation e a))
-  , _in_ajax        :: Event t a -> m (Event t (Either Text b))
+  , _in_ajax        :: Event t a -> m (Event t (Either Text ()))
   }
 
-data Out t a = Out
+data Out t = Out
   { _out_hide     :: Event t ()
   , _out_cancel   :: Event t ()
   , _out_confirm  :: Event t ()
-  , _out_validate :: Event t a
+  , _out_validate :: Event t ()
   }
 
-view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b)
+view :: forall t m a e. (MonadWidget t m, ToJSON a) => In m t a e -> m (Out t)
 view input =
   R.divClass "form" $ do
     R.divClass "formHeader" $
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 2869c2d..f82cfa6 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -14,23 +14,23 @@ import qualified Component.Modal  as Modal
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
-data In m t h r a b c = In
+data In m t h r = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: [r]
   , _in_cell        :: h -> r -> m ()
-  , _in_cloneModal  :: r -> Modal.Content t m a
-  , _in_editModal   :: r -> Modal.Content t m b
-  , _in_deleteModal :: r -> Modal.Content t m c
+  , _in_cloneModal  :: r -> Modal.Content t m
+  , _in_editModal   :: r -> Modal.Content t m
+  , _in_deleteModal :: r -> Modal.Content t m
   , _in_isOwner     :: r -> Bool
   }
 
-data Out t a b c = Out
-  { _out_add    :: Event t a
-  , _out_edit   :: Event t b
-  , _out_delete :: Event t c
+data Out t = Out
+  { _out_add    :: Event t ()
+  , _out_edit   :: Event t ()
+  , _out_delete :: Event t ()
   }
 
-view :: forall t m h r a b c. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a b c-> m (Out t a b c)
+view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => In m t h r -> m (Out t)
 view input =
   R.divClass "table" $ do
     rec
diff --git a/client/src/Component/Tag.hs b/client/src/Component/Tag.hs
new file mode 100644
index 0000000..f75b8d3
--- /dev/null
+++ b/client/src/Component/Tag.hs
@@ -0,0 +1,27 @@
+module Component.Tag
+  ( In(..)
+  , view
+  ) where
+
+import qualified Data.Map   as M
+import           Data.Text  (Text)
+import qualified Data.Text  as T
+import           Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+data In = In
+  { _in_text  :: Text
+  , _in_color :: Text
+  }
+
+view :: forall t m a. MonadWidget t m => In -> m ()
+view input =
+  R.elAttr "span" attrs $
+    R.text $ _in_text input
+
+  where
+    attrs =
+      M.fromList
+        [ ("class", "tag")
+        , ("style", T.concat [ "background-color: ", _in_color input ])
+        ]
diff --git a/client/src/Model/Route.hs b/client/src/Model/Route.hs
index 420fe05..63e5d10 100644
--- a/client/src/Model/Route.hs
+++ b/client/src/Model/Route.hs
@@ -5,5 +5,6 @@ module Model.Route
 data Route
   = RootRoute
   | IncomeRoute
+  | CategoryRoute
   | NotFoundRoute
   deriving (Eq, Show)
diff --git a/client/src/Util/Ajax.hs b/client/src/Util/Ajax.hs
index dc56701..dcfd402 100644
--- a/client/src/Util/Ajax.hs
+++ b/client/src/Util/Ajax.hs
@@ -2,7 +2,9 @@ module Util.Ajax
   ( getNow
   , get
   , post
+  , postAndParseResult
   , put
+  , putAndParseResult
   , delete
   ) where
 
@@ -42,20 +44,38 @@ get url =
     R.performRequestAsync (R.ffor url $ \u -> jsonRequest "GET" u (Aeson.String ""))
 
 post
+  :: forall t m a. (MonadWidget t m, ToJSON a)
+  => Text
+  -> Event t a
+  -> m (Event t (Either Text ()))
+post url input =
+  fmap checkResult <$>
+    R.performRequestAsync (jsonRequest "POST" url <$> input)
+
+postAndParseResult
   :: forall t m a b. (MonadWidget t m, ToJSON a, FromJSON b)
   => Text
   -> Event t a
   -> m (Event t (Either Text b))
-post url input =
+postAndParseResult url input =
   fmap getJsonResult <$>
     R.performRequestAsync (jsonRequest "POST" url <$> input)
 
 put
+  :: forall t m a. (MonadWidget t m, ToJSON a)
+  => Text
+  -> Event t a
+  -> m (Event t (Either Text ()))
+put url input =
+  fmap checkResult <$>
+    R.performRequestAsync (jsonRequest "PUT" url <$> input)
+
+putAndParseResult
   :: forall t m a b. (MonadWidget t m, ToJSON a, FromJSON b)
   => Text
   -> Event t a
   -> m (Event t (Either Text b))
-put url input =
+putAndParseResult url input =
   fmap getJsonResult <$>
     R.performRequestAsync (jsonRequest "PUT" url <$> input)
 
@@ -69,6 +89,10 @@ delete url fire = do
     (R.performRequestAsync $
       R.attachWith (\u _ -> request "DELETE" u ()) (R.current url) fire)
 
+checkResult :: XhrResponse -> Either Text ()
+checkResult response =
+  () <$ getResult response
+
 getJsonResult :: forall a. (FromJSON a) => XhrResponse -> Either Text a
 getJsonResult response =
   case getResult response of
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index 2b346af..460d499 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -2,22 +2,23 @@ module View.App
   ( widget
   ) where
 
-import qualified Data.Text            as T
-import           Prelude              hiding (error, init)
-import           Reflex.Dom           (Dynamic, MonadWidget)
-import qualified Reflex.Dom           as R
-
-import           Common.Model         (Currency, Init (..), InitResult (..),
-                                       UserId)
-import qualified Common.Msg           as Msg
-
-import           Model.Route          (Route (..))
-import qualified Util.Router          as Router
-import qualified View.Header          as Header
-import qualified View.Income.Income   as Income
-import qualified View.NotFound        as NotFound
-import qualified View.Payment.Payment as Payment
-import qualified View.SignIn          as SignIn
+import qualified Data.Text              as T
+import           Prelude                hiding (error, init)
+import           Reflex.Dom             (Dynamic, MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (Currency, Init (..), InitResult (..),
+                                         UserId)
+import qualified Common.Msg             as Msg
+
+import           Model.Route            (Route (..))
+import qualified Util.Router            as Router
+import qualified View.Category.Category as Category
+import qualified View.Header            as Header
+import qualified View.Income.Income     as Income
+import qualified View.NotFound          as NotFound
+import qualified View.Payment.Payment   as Payment
+import qualified View.SignIn            as SignIn
 
 widget :: InitResult -> IO ()
 widget initResult =
@@ -72,6 +73,13 @@ signedWidget init route = do
         , Income._in_users = _init_users init
         }
 
+    CategoryRoute ->
+      Category.view $ Category.In
+        { Category._in_currentUser = _init_currentUser init
+        , Category._in_currency = _init_currency init
+        , Category._in_users = _init_users init
+        }
+
     NotFoundRoute ->
       NotFound.view
 
@@ -87,5 +95,8 @@ getRoute = do
     ["income"] ->
       IncomeRoute
 
+    ["category"] ->
+      CategoryRoute
+
     _ ->
       NotFoundRoute
diff --git a/client/src/View/Category/Category.hs b/client/src/View/Category/Category.hs
new file mode 100644
index 0000000..77a331a
--- /dev/null
+++ b/client/src/View/Category/Category.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE ExplicitForAll #-}
+
+module View.Category.Category
+  ( view
+  , In(..)
+  ) where
+
+import           Data.Aeson            (FromJSON)
+import qualified Data.Maybe            as Maybe
+import qualified Data.Text             as T
+import           Reflex.Dom            (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom            as R
+
+import           Common.Model          (Category, CategoryPage (..), Currency,
+                                        User, UserId)
+import qualified Common.Msg            as Msg
+
+import qualified Component.Button      as Button
+import qualified Component.Modal       as Modal
+import qualified Component.Pages       as Pages
+import           Loadable              (Loadable (..))
+import qualified Loadable
+import qualified Util.Ajax             as AjaxUtil
+import qualified Util.Reflex           as ReflexUtil
+import qualified Util.Reflex           as ReflexUtil
+import qualified View.Category.Form    as Form
+import qualified View.Category.Reducer as Reducer
+import qualified View.Category.Table   as Table
+
+data In t = In
+  { _in_users       :: [User]
+  , _in_currentUser :: UserId
+  , _in_currency    :: Currency
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input = do
+  rec
+    categoryPage <- Reducer.reducer $ Reducer.In
+      { Reducer._in_page         = page
+      , Reducer._in_addCategory    = R.leftmost [ headerAddCategory, tableAddCategory ]
+      , Reducer._in_editCategory   = editCategory
+      , Reducer._in_deleteCategory = deleteCategory
+      }
+
+    let eventFromResult :: forall a. ((Event t (), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+        eventFromResult op = ReflexUtil.flatten $ (Maybe.fromMaybe R.never . fmap op) <$> result
+
+    page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
+    headerAddCategory <- eventFromResult $ (\(a, _, _) -> a)
+    tableAddCategory <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
+    editCategory <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
+    deleteCategory <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
+
+    result <- Loadable.viewShowValueWhileLoading categoryPage $
+      \(CategoryPage page categories count) -> do
+        header <- headerView
+
+        table <- Table.view $ Table.In
+          { Table._in_currentUser = _in_currentUser input
+          , Table._in_currency = _in_currency input
+          , Table._in_categories = categories
+          , Table._in_users = _in_users input
+          }
+
+        pages <- Pages.view $ Pages.In
+          { Pages._in_total = R.constDyn count
+          , Pages._in_perPage = Reducer.perPage
+          , Pages._in_page = page
+          }
+
+        return (header, table, pages)
+
+  return ()
+
+headerView :: forall t m. MonadWidget t m => m (Event t ())
+headerView =
+  R.divClass "titleButton" $ do
+    R.el "h1" $
+      R.text $
+        Msg.get Msg.Category_Title
+
+    addCategory <- Button._out_clic <$>
+      (Button.view . Button.defaultIn . R.text $
+        Msg.get Msg.Category_Add)
+
+    addCategory <- Modal.view $ Modal.In
+      { Modal._in_show    = addCategory
+      , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New }
+      }
+
+    return addCategory
diff --git a/client/src/View/Category/Form.hs b/client/src/View/Category/Form.hs
new file mode 100644
index 0000000..d91fc2e
--- /dev/null
+++ b/client/src/View/Category/Form.hs
@@ -0,0 +1,117 @@
+module View.Category.Form
+  ( view
+  , In(..)
+  , Operation(..)
+  ) where
+
+import           Control.Monad.IO.Class     (liftIO)
+import           Data.Aeson                 (Value)
+import qualified Data.Aeson                 as Aeson
+import qualified Data.Maybe                 as Maybe
+import           Data.Text                  (Text)
+import qualified Data.Text                  as T
+import qualified Data.Time.Calendar         as Calendar
+import qualified Data.Time.Clock            as Time
+import           Data.Validation            (Validation)
+import qualified Data.Validation            as V
+import           Reflex.Dom                 (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom                 as R
+
+import           Common.Model               (Category (..),
+                                             CreateCategoryForm (..),
+                                             EditCategoryForm (..))
+import qualified Common.Msg                 as Msg
+import qualified Common.Util.Time           as TimeUtil
+import qualified Common.Validation.Category as CategoryValidation
+import qualified Component.Input            as Input
+import qualified Component.Modal            as Modal
+import qualified Component.ModalForm        as ModalForm
+import qualified Util.Ajax                  as Ajax
+
+data In = In
+  { _in_operation :: Operation
+  }
+
+data Operation
+  = New
+  | Clone Category
+  | Edit Category
+
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
+view input cancel = do
+
+  rec
+    let reset = R.leftmost
+          [ "" <$ ModalForm._out_cancel modalForm
+          , "" <$ ModalForm._out_validate modalForm
+          , "" <$ cancel
+          ]
+
+    modalForm <- ModalForm.view $ ModalForm.In
+      { ModalForm._in_headerLabel = headerLabel
+      , ModalForm._in_ajax        = ajax "/api/category"
+      , ModalForm._in_form        = form reset (ModalForm._out_confirm modalForm)
+      }
+
+  return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
+
+  where
+
+    form
+      :: Event t String
+      -> Event t ()
+      -> m (Dynamic t (Validation Text Value))
+    form reset confirm = do
+      name <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Category_Name
+          , Input._in_initialValue = name
+          , Input._in_validation = CategoryValidation.name
+          })
+        (name <$ reset)
+        confirm)
+
+      color <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Category_Color
+          , Input._in_initialValue = color
+          , Input._in_inputType = "color"
+          , Input._in_hasResetButton = False
+          , Input._in_validation = CategoryValidation.color
+          })
+        (color <$ reset)
+        confirm)
+
+      return $ do
+        n <- name
+        c <- color
+        return . V.Success $ mkPayload n c
+
+    op = _in_operation input
+
+    name =
+      case op of
+        New     -> ""
+        Clone c -> _category_name c
+        Edit c  -> _category_name c
+
+    color =
+      case op of
+        New     -> ""
+        Clone c -> _category_color c
+        Edit c  -> _category_color c
+
+    ajax =
+      case op of
+        Edit _ -> Ajax.put
+        _      -> Ajax.post
+
+    headerLabel =
+      case op of
+        Edit _ -> Msg.get Msg.Category_Edit
+        _      -> Msg.get Msg.Category_Add
+
+    mkPayload =
+      case op of
+        Edit i -> \a b -> Aeson.toJSON $ EditCategoryForm (_category_id i) a b
+        _      -> \a b -> Aeson.toJSON $ CreateCategoryForm a b
diff --git a/client/src/View/Category/Reducer.hs b/client/src/View/Category/Reducer.hs
new file mode 100644
index 0000000..5ad0ddb
--- /dev/null
+++ b/client/src/View/Category/Reducer.hs
@@ -0,0 +1,59 @@
+module View.Category.Reducer
+  ( perPage
+  , reducer
+  , In(..)
+  ) where
+
+import           Data.Text    (Text)
+import qualified Data.Text    as T
+import           Reflex.Dom   (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom   as R
+
+import           Common.Model (CategoryPage)
+
+import           Loadable     (Loadable (..))
+import qualified Loadable     as Loadable
+import qualified Util.Ajax    as AjaxUtil
+import qualified Util.Either  as EitherUtil
+
+perPage :: Int
+perPage = 7
+
+data In t a b c = In
+  { _in_page           :: Event t Int
+  , _in_addCategory    :: Event t a
+  , _in_editCategory   :: Event t b
+  , _in_deleteCategory :: Event t c
+  }
+
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable CategoryPage))
+reducer input = do
+
+  postBuild <- R.getPostBuild
+
+  currentPage <- R.holdDyn 1 (_in_page input)
+
+  let loadPage =
+        R.leftmost
+          [ 1 <$ postBuild
+          , _in_page input
+          , 1 <$ _in_addCategory input
+          , R.tag (R.current currentPage) (_in_editCategory input)
+          , R.tag (R.current currentPage) (_in_deleteCategory input)
+          ]
+
+  getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+
+  R.holdDyn
+    Loading
+    (R.leftmost
+      [ Loading <$ loadPage
+      , Loadable.fromEither <$> getResult
+      ])
+
+  where
+    pageUrl p =
+      "api/categories?page="
+      <> (T.pack . show $ p)
+      <> "&perPage="
+      <> (T.pack . show $ perPage)
diff --git a/client/src/View/Category/Table.hs b/client/src/View/Category/Table.hs
new file mode 100644
index 0000000..fbe76e9
--- /dev/null
+++ b/client/src/View/Category/Table.hs
@@ -0,0 +1,91 @@
+module View.Category.Table
+  ( view
+  , In(..)
+  , Out(..)
+  ) where
+
+import qualified Data.Maybe              as Maybe
+import           Data.Text               (Text)
+import qualified Data.Text               as T
+import           Reflex.Dom              (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom              as R
+
+import           Common.Model            (Category (..), Currency, User (..),
+                                          UserId)
+import qualified Common.Model            as CM
+import qualified Common.Msg              as Msg
+import qualified Common.View.Format      as Format
+
+import qualified Component.ConfirmDialog as ConfirmDialog
+import qualified Component.Table         as Table
+import qualified Component.Tag           as Tag
+import qualified Util.Ajax               as Ajax
+import qualified Util.Either             as EitherUtil
+import qualified View.Category.Form      as Form
+
+data In t = In
+  { _in_currentUser :: UserId
+  , _in_currency    :: Currency
+  , _in_categories  :: [Category]
+  , _in_users       :: [User]
+  }
+
+data Out t = Out
+  { _out_add    :: Event t ()
+  , _out_edit   :: Event t ()
+  , _out_delete :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
+
+  table <- Table.view $ Table.In
+    { Table._in_headerLabel = headerLabel
+    , Table._in_rows = _in_categories input
+    , Table._in_cell = cell (_in_users input) (_in_currency input)
+    , Table._in_cloneModal = \category ->
+      Form.view $ Form.In
+        { Form._in_operation = Form.Clone category
+        }
+    , Table._in_editModal = \category ->
+      Form.view $ Form.In
+        { Form._in_operation = Form.Edit category
+        }
+    , Table._in_deleteModal = \category ->
+      ConfirmDialog.view $ ConfirmDialog.In
+        { ConfirmDialog._in_header  = Msg.get Msg.Category_DeleteConfirm
+        , ConfirmDialog._in_confirm = \e -> do
+          res <- Ajax.delete
+            (R.constDyn $ T.concat ["/api/category/", T.pack . show $ _category_id category])
+            e
+          return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+        }
+    , Table._in_isOwner = const True
+    }
+
+  return $ Out
+    { _out_add = Table._out_add table
+    , _out_edit = Table._out_edit table
+    , _out_delete = Table._out_delete table
+    }
+
+data Header
+  = NameHeader
+  | ColorHeader
+  deriving (Eq, Show, Bounded, Enum)
+
+headerLabel :: Header -> Text
+headerLabel NameHeader  = Msg.get Msg.Category_Name
+headerLabel ColorHeader = Msg.get Msg.Category_Color
+
+cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Category -> m ()
+cell users currency header category =
+  case header of
+    NameHeader ->
+      R.text $ _category_name category
+
+    ColorHeader ->
+      Tag.view $ Tag.In
+        { Tag._in_text = _category_name category
+        , Tag._in_color = _category_color category
+        }
diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs
index 3f58dd5..5910f52 100644
--- a/client/src/View/Header.hs
+++ b/client/src/View/Header.hs
@@ -63,6 +63,11 @@ links route = do
     (R.ffor route (attrs IncomeRoute))
     (Msg.get Msg.Income_Title)
 
+  Link.view
+    "/category"
+    (R.ffor route (attrs CategoryRoute))
+    (Msg.get Msg.Category_Title)
+
   where
     attrs linkRoute currentRoute =
       M.singleton "class" $
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index ff6e55e..59f6a0d 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -36,7 +36,7 @@ data Operation
   | Clone Income
   | Edit Income
 
-view :: forall t m a. MonadWidget t m => In -> Modal.Content t m Income
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
 view input cancel = do
 
   rec
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index 9e1c5b6..a26e16a 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -21,7 +21,6 @@ import qualified Common.View.Format     as Format
 import qualified Component.Button       as Button
 import qualified Component.Modal        as Modal
 import qualified View.Income.Form       as Form
-import           View.Income.Init       (Init (..))
 
 data In t = In
   { _in_users    :: [User]
@@ -30,7 +29,7 @@ data In t = In
   }
 
 data Out t = Out
-  { _out_add :: Event t Income
+  { _out_add :: Event t ()
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index e83ba80..7be8091 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -21,7 +21,6 @@ import qualified Util.Ajax           as AjaxUtil
 import qualified Util.Reflex         as ReflexUtil
 import qualified Util.Reflex         as ReflexUtil
 import qualified View.Income.Header  as Header
-import           View.Income.Init    (Init (..))
 import qualified View.Income.Reducer as Reducer
 import qualified View.Income.Table   as Table
 
diff --git a/client/src/View/Income/Init.hs b/client/src/View/Income/Init.hs
deleted file mode 100644
index 4f3ef99..0000000
--- a/client/src/View/Income/Init.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module View.Income.Init
-  ( Init(..)
-  ) where
-
-import           Common.Model (Income, Payment, User)
-
-data Init = Init
-  { _init_users    :: [User]
-  , _init_incomes  :: [Income]
-  , _init_payments :: [Payment]
-  } deriving (Show)
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index c623acb..c7f172b 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -4,7 +4,6 @@ module View.Income.Table
   , Out(..)
   ) where
 
-import qualified Data.List               as L
 import qualified Data.Maybe              as Maybe
 import           Data.Text               (Text)
 import qualified Data.Text               as T
@@ -31,9 +30,9 @@ data In t = In
   }
 
 data Out t = Out
-  { _out_add    :: Event t Income
-  , _out_edit   :: Event t Income
-  , _out_delete :: Event t Income
+  { _out_add    :: Event t ()
+  , _out_edit   :: Event t ()
+  , _out_delete :: Event t ()
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -41,7 +40,7 @@ view input = do
 
   table <- Table.view $ Table.In
     { Table._in_headerLabel = headerLabel
-    , Table._in_rows = reverse . L.sortOn _income_date $ _in_incomes input
+    , Table._in_rows = _in_incomes input
     , Table._in_cell = cell (_in_users input) (_in_currency input)
     , Table._in_cloneModal = \income ->
       Form.view $ Form.In
@@ -58,7 +57,7 @@ view input = do
           res <- Ajax.delete
             (R.constDyn $ T.concat ["/api/income/", T.pack . show $ _income_id income])
             e
-          return $ income <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+          return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
         }
     , Table._in_isOwner = (== (_in_currentUser input)) . _income_userId
     }
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 064b5b3..6c31fad 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -51,7 +51,7 @@ data Operation t
   | Clone Payment
   | Edit Payment
 
-view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Payment
+view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m
 view input cancel = do
   rec
     let reset = R.leftmost
diff --git a/client/src/View/Payment/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
index 0ee0cd3..1915841 100644
--- a/client/src/View/Payment/HeaderForm.hs
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -29,7 +29,7 @@ data In t = In
 data Out t = Out
   { _out_search     :: Event t Text
   , _out_frequency  :: Event t Frequency
-  , _out_addPayment :: Event t Payment
+  , _out_addPayment :: Event t ()
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index 8d0fee1..26444d7 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -36,7 +36,7 @@ data In t = In
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
 
-  categories <- AjaxUtil.getNow "api/categories"
+  categories <- AjaxUtil.getNow "api/allCategories"
 
   R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do
 
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index f9215bc..6744d3a 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -21,6 +21,7 @@ import qualified Common.View.Format      as Format
 
 import qualified Component.ConfirmDialog as ConfirmDialog
 import qualified Component.Table         as Table
+import qualified Component.Tag           as Tag
 import qualified Util.Ajax               as Ajax
 import qualified Util.Either             as EitherUtil
 import qualified View.Payment.Form       as Form
@@ -35,9 +36,9 @@ data In t = In
   }
 
 data Out t = Out
-  { _out_add    :: Event t Payment
-  , _out_edit   :: Event t Payment
-  , _out_delete :: Event t Payment
+  { _out_add    :: Event t ()
+  , _out_edit   :: Event t ()
+  , _out_delete :: Event t ()
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -45,7 +46,7 @@ view input = do
 
   table <- Table.view $ Table.In
     { Table._in_headerLabel = headerLabel (_in_frequency input)
-    , Table._in_rows = reverse . L.sortOn _payment_date $ _in_payments input
+    , Table._in_rows = _in_payments input
     , Table._in_cell =
       cell
         (_in_users input)
@@ -71,7 +72,7 @@ view input = do
           res <- Ajax.delete
             (R.constDyn $ T.concat ["/api/payment/", T.pack . show $ _payment_id payment])
             e
-          return $ payment <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+          return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
         }
     , Table._in_isOwner = (== (_in_currentUser input)) . _payment_user
     }
@@ -122,21 +123,12 @@ cell users categories frequency currency header payment =
       let
         category =
           L.find ((== (_payment_category payment)) . _category_id) categories
-
-        attrs =
-          case category of
-            Just c ->
-              M.fromList
-                [ ("class", "tag")
-                , ("style", T.concat [ "background-color: ", _category_color c ])
-                ]
-
-            Nothing ->
-              M.singleton "display" "none"
       in
-        R.elAttr "span" attrs $
-          R.text $
-            Maybe.fromMaybe "" (_category_name <$> category)
+        Maybe.fromMaybe R.blank . flip fmap category $ \c ->
+          Tag.view $ Tag.In
+            { Tag._in_text = _category_name c
+            , Tag._in_color = _category_color c
+            }
 
     DateHeader ->
       if frequency == Punctual then
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index a589fc3..0a3b576 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -50,7 +50,7 @@ view signInMessage =
         let form = SignInForm <$> Input._out_raw input
 
         (signInResult, waiting) <- WaitFor.waitFor
-          (Ajax.post "/api/askSignIn")
+          (Ajax.postAndParseResult "/api/askSignIn")
           (ValidationUtil.fireMaybe
             ((\f -> f <$ SignInValidation.signIn f) <$> form)
             validate)
diff --git a/common/common.cabal b/common/common.cabal
index 17a0ee1..fdede8f 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -31,6 +31,7 @@ Library
 
   Exposed-modules:
     Common.Model
+    Common.Model.CreateCategoryForm
     Common.Model.CreateIncomeForm
     Common.Model.CreatePaymentForm
     Common.Model.Email
@@ -42,6 +43,7 @@ Library
     Common.Util.Time
     Common.Util.Validation
     Common.Validation.Atomic
+    Common.Validation.Category
     Common.Validation.Income
     Common.Validation.Payment
     Common.Validation.SignIn
@@ -52,9 +54,9 @@ Library
     Common.Message.Lang
     Common.Message.Translation
     Common.Model.Category
-    Common.Model.CreateCategory
+    Common.Model.CategoryPage
     Common.Model.Currency
-    Common.Model.EditCategory
+    Common.Model.EditCategoryForm
     Common.Model.EditIncome
     Common.Model.EditIncomeForm
     Common.Model.EditPaymentForm
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index 00d30f6..73cbf6c 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -1,24 +1,25 @@
 module Common.Model (module X) where
 
-import           Common.Model.Category          as X
-import           Common.Model.CreateCategory    as X
-import           Common.Model.CreateIncomeForm  as X
-import           Common.Model.CreatePaymentForm as X
-import           Common.Model.Currency          as X
-import           Common.Model.EditCategory      as X
-import           Common.Model.EditIncome        as X
-import           Common.Model.EditIncomeForm    as X
-import           Common.Model.EditPaymentForm   as X
-import           Common.Model.Email             as X
-import           Common.Model.ExceedingPayer    as X
-import           Common.Model.Frequency         as X
-import           Common.Model.Income            as X
-import           Common.Model.IncomeHeader      as X
-import           Common.Model.IncomePage        as X
-import           Common.Model.Init              as X
-import           Common.Model.InitResult        as X
-import           Common.Model.Payment           as X
-import           Common.Model.PaymentHeader     as X
-import           Common.Model.PaymentPage       as X
-import           Common.Model.SignInForm        as X
-import           Common.Model.User              as X
+import           Common.Model.Category           as X
+import           Common.Model.CategoryPage       as X
+import           Common.Model.CreateCategoryForm as X
+import           Common.Model.CreateIncomeForm   as X
+import           Common.Model.CreatePaymentForm  as X
+import           Common.Model.Currency           as X
+import           Common.Model.EditCategoryForm   as X
+import           Common.Model.EditIncome         as X
+import           Common.Model.EditIncomeForm     as X
+import           Common.Model.EditPaymentForm    as X
+import           Common.Model.Email              as X
+import           Common.Model.ExceedingPayer     as X
+import           Common.Model.Frequency          as X
+import           Common.Model.Income             as X
+import           Common.Model.IncomeHeader       as X
+import           Common.Model.IncomePage         as X
+import           Common.Model.Init               as X
+import           Common.Model.InitResult         as X
+import           Common.Model.Payment            as X
+import           Common.Model.PaymentHeader      as X
+import           Common.Model.PaymentPage        as X
+import           Common.Model.SignInForm         as X
+import           Common.Model.User               as X
diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs
index db1da53..cc3f795 100644
--- a/common/src/Common/Model/Category.hs
+++ b/common/src/Common/Model/Category.hs
@@ -18,7 +18,7 @@ data Category = Category
   , _category_createdAt :: UTCTime
   , _category_editedAt  :: Maybe UTCTime
   , _category_deletedAt :: Maybe UTCTime
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 instance FromJSON Category
 instance ToJSON Category
diff --git a/common/src/Common/Model/CategoryPage.hs b/common/src/Common/Model/CategoryPage.hs
new file mode 100644
index 0000000..476b4ce
--- /dev/null
+++ b/common/src/Common/Model/CategoryPage.hs
@@ -0,0 +1,17 @@
+module Common.Model.CategoryPage
+  ( CategoryPage(..)
+  ) where
+
+import           Data.Aeson            (FromJSON, ToJSON)
+import           GHC.Generics          (Generic)
+
+import           Common.Model.Category (Category)
+
+data CategoryPage = CategoryPage
+  { _categoryPage_page       :: Int
+  , _categoryPage_categories :: [Category]
+  , _categoryPage_totalCount :: Int
+  } deriving (Eq, Show, Generic)
+
+instance FromJSON CategoryPage
+instance ToJSON CategoryPage
diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs
deleted file mode 100644
index 51bd2a0..0000000
--- a/common/src/Common/Model/CreateCategory.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Common.Model.CreateCategory
-  ( CreateCategory(..)
-  ) where
-
-import           Data.Aeson   (FromJSON)
-import           Data.Text    (Text)
-import           GHC.Generics (Generic)
-
-data CreateCategory = CreateCategory
-  { _createCategory_name  :: Text
-  , _createCategory_color :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON CreateCategory
diff --git a/common/src/Common/Model/CreateCategoryForm.hs b/common/src/Common/Model/CreateCategoryForm.hs
new file mode 100644
index 0000000..4668ef4
--- /dev/null
+++ b/common/src/Common/Model/CreateCategoryForm.hs
@@ -0,0 +1,15 @@
+module Common.Model.CreateCategoryForm
+  ( CreateCategoryForm(..)
+  ) where
+
+import           Data.Aeson   (FromJSON, ToJSON)
+import           Data.Text    (Text)
+import           GHC.Generics (Generic)
+
+data CreateCategoryForm = CreateCategoryForm
+  { _createCategoryForm_name  :: Text
+  , _createCategoryForm_color :: Text
+  } deriving (Show, Generic)
+
+instance FromJSON CreateCategoryForm
+instance ToJSON CreateCategoryForm
diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs
deleted file mode 100644
index 8b9d9eb..0000000
--- a/common/src/Common/Model/EditCategory.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Common.Model.EditCategory
-  ( EditCategory(..)
-  ) where
-
-import           Data.Aeson            (FromJSON)
-import           Data.Text             (Text)
-import           GHC.Generics          (Generic)
-
-import           Common.Model.Category (CategoryId)
-
-data EditCategory = EditCategory
-  { _editCategory_id    :: CategoryId
-  , _editCategory_name  :: Text
-  , _editCategory_color :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON EditCategory
diff --git a/common/src/Common/Model/EditCategoryForm.hs b/common/src/Common/Model/EditCategoryForm.hs
new file mode 100644
index 0000000..a2ceca0
--- /dev/null
+++ b/common/src/Common/Model/EditCategoryForm.hs
@@ -0,0 +1,18 @@
+module Common.Model.EditCategoryForm
+  ( EditCategoryForm(..)
+  ) where
+
+import           Data.Aeson            (FromJSON, ToJSON)
+import           Data.Text             (Text)
+import           GHC.Generics          (Generic)
+
+import           Common.Model.Category (CategoryId)
+
+data EditCategoryForm = EditCategoryForm
+  { _editCategoryForm_id    :: CategoryId
+  , _editCategoryForm_name  :: Text
+  , _editCategoryForm_color :: Text
+  } deriving (Show, Generic)
+
+instance FromJSON EditCategoryForm
+instance ToJSON EditCategoryForm
diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs
index 3516668..2a356df 100644
--- a/common/src/Common/Validation/Atomic.hs
+++ b/common/src/Common/Validation/Atomic.hs
@@ -4,6 +4,7 @@ module Common.Validation.Atomic
   , number
   , nonNullNumber
   , day
+  , color
   ) where
 
 import           Data.Text          (Text)
@@ -45,3 +46,7 @@ day str =
   case Time.parseDay str of
     Just d  -> V.Success d
     Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate
+
+-- TODO: validate
+color :: Text -> Validation Text Text
+color str = V.Success str
diff --git a/common/src/Common/Validation/Category.hs b/common/src/Common/Validation/Category.hs
new file mode 100644
index 0000000..f9e6ab4
--- /dev/null
+++ b/common/src/Common/Validation/Category.hs
@@ -0,0 +1,15 @@
+module Common.Validation.Category
+  ( name
+  , color
+  ) where
+
+import           Data.Text                (Text)
+import           Data.Validation          (Validation)
+
+import qualified Common.Validation.Atomic as Atomic
+
+name :: Text -> Validation Text Text
+name = Atomic.nonEmpty
+
+color :: Text -> Validation Text Text
+color = Atomic.color
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)
-- 
cgit v1.2.3