Commit b97ad942 authored by Joris's avatar Joris

WIP Set up server side paging for incomes

parent 8ef4d966
# MVP
## Income
- Implement server side paging
## Payment
- Use income table factorizations
- Implement server side paging
## Category view
......@@ -12,10 +17,6 @@
- Edit a category
- Remove a category
## Low speed
- Implement server side paging
## Bugs
- After modal close, it is still on the DOM, preventing any click
......@@ -48,6 +49,7 @@
- Move the CSS out from the index page
- Test exceedingPayers
- try DuplicateRecordFields (https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields)
- ajax query parameters
## DB
......
......@@ -72,6 +72,7 @@ Executable client
View.Income.Form
View.Income.Header
View.Income.Income
View.Income.Reducer
View.Income.Table
View.NotFound
View.Payment.Add
......
......@@ -16,38 +16,43 @@ import qualified View.Icon as Icon
data In t = In
{ _in_total :: Dynamic t Int
, _in_perPage :: Int
, _in_reset :: Event t ()
}
data Out t = Out
{ _out_currentPage :: Dynamic t Int
{ _out_newPage :: Event t Int
, _out_currentPage :: Dynamic t Int
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
view input = do
currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
(newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage
return $ Out
{ _out_currentPage = currentPage
{ _out_newPage = newPage
, _out_currentPage = currentPage
}
where
total = _in_total input
perPage = _in_perPage input
reset = _in_reset input
pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
pageButtons total perPage reset = do
pageButtons
:: forall t m. MonadWidget t m
=> Dynamic t Int
-> Int
-> m (Event t Int, Dynamic t Int)
pageButtons total perPage = do
R.divClass "pages" $ do
rec
currentPage <- R.holdDyn 1 . R.leftmost $
[ firstPageClic
, previousPageClic
, pageClic
, nextPageClic
, lastPageClic
, 1 <$ reset
]
let newPage = R.leftmost
[ firstPageClic
, previousPageClic
, pageClic
, nextPageClic
, lastPageClic
]
currentPage <- R.holdDyn 1 newPage
firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
......@@ -60,7 +65,7 @@ pageButtons total perPage reset = do
lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
return currentPage
return (newPage, currentPage)
where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
pageEvent = R.switch . R.current . fmap R.leftmost
......
......@@ -10,7 +10,6 @@ import qualified Reflex.Dom as R
import qualified Component.Button as Button
import qualified Component.Modal as Modal
import qualified Component.Pages as Pages
import qualified Util.Reflex as ReflexUtil
import qualified View.Icon as Icon
......@@ -18,8 +17,6 @@ data In m t h r a = In
{ _in_headerLabel :: h -> Text
, _in_rows :: Dynamic t [r]
, _in_cell :: h -> r -> Text
, _in_perPage :: Int
, _in_resetPage :: Event t ()
, _in_cloneModal :: r -> Modal.Content t m a
, _in_editModal :: r -> Modal.Content t m a
, _in_deleteModal :: r -> Modal.Content t m a
......@@ -47,12 +44,7 @@ view input =
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
let rows = getRange
(_in_perPage input)
<$> (Pages._out_currentPage pages)
<*> (_in_rows input)
R.simpleList rows $ \r ->
R.simpleList (_in_rows input) $ \r ->
R.divClass "row" $ do
flip mapM_ [minBound..] $ \h ->
R.divClass "cell" $
......@@ -104,12 +96,6 @@ view input =
return (cloned, edited, deleted)
pages <- Pages.view $ Pages.In
{ Pages._in_total = length <$> _in_rows input
, Pages._in_perPage = _in_perPage input
, Pages._in_reset = _in_resetPage input
}
let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
......@@ -119,7 +105,3 @@ view input =
, _out_edit = edit
, _out_delete = delete
}
getRange :: forall a. Int -> Int -> [a] -> [a]
getRange perPage currentPage =
take perPage . drop ((currentPage - 1) * perPage)
......@@ -49,3 +49,12 @@ view :: forall t m a. MonadWidget t m => (a -> m ()) -> Loadable a -> m ()
view _ (Loading) = R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
view _ (Error e) = R.text e
view f (Loaded x) = f x
-- view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
-- view _ (Loading) = do
-- R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
-- return Nothing
-- view _ (Error e) = do
-- R.text e
-- return Nothing
-- view f (Loaded x) = Just <$> (f x)
......@@ -4,19 +4,23 @@ module View.Income.Income
, In(..)
) where
import Data.Aeson (FromJSON)
import Prelude hiding (init)
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Data.Aeson (FromJSON)
import Prelude hiding (init)
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Currency, Income (..), UserId)
import Common.Model (Currency, Income (..),
IncomesAndCount (..), UserId)
import Loadable (Loadable (..))
import qualified Component.Pages as Pages
import Loadable (Loadable (..))
import qualified Loadable
import qualified Util.Ajax as AjaxUtil
import qualified View.Income.Header as Header
import View.Income.Init (Init (..))
import qualified View.Income.Table as Table
import qualified Util.Ajax as AjaxUtil
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
data In t = In
{ _in_currentUser :: UserId
......@@ -37,50 +41,45 @@ init = do
view :: forall t m. MonadWidget t m => In t -> m ()
view input = do
R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
-- rec
-- incomes <- Reducer.reducer
-- { Reducer._in_newPage = ReflexUtil.flatten (Table._out_newPage <$> table)
-- , Reducer._in_currentPage = ReflexUtil.flatten (Table._out_currentPage <$> table)
-- , Reducer._in_addIncome = ReflexUtil.flatten (Table._out_add <$> table)
-- , Reducer._in_editIncome = ReflexUtil.flatten (Table._out_edit <$> table)
-- , Reducer._in_deleteIncome = ReflexUtil.flatten (Table._out_delete <$> table)
-- }
R.elClass "main" "income" $ do
rec
incomes <- Reducer.reducer $ Reducer.In
{ Reducer._in_newPage = Pages._out_newPage pages
, Reducer._in_currentPage = Pages._out_currentPage pages
, Reducer._in_addIncome = Table._out_add table
, Reducer._in_editIncome = Table._out_edit table
, Reducer._in_deleteIncome = Table._out_delete table
}
rec
let addIncome = R.leftmost
[ Header._out_add header
, Table._out_add table
]
table <- Table.view $ Table.In
{ Table._in_currentUser = _in_currentUser input
, Table._in_currency = _in_currency input
, Table._in_incomes = R.ffor incomes $ \case
Loaded (IncomesAndCount xs _) -> xs
_ -> []
}
incomes <- reduceIncomes
(_init_incomes init)
addIncome
(Table._out_edit table)
(Table._out_delete table)
pages <- Pages.view $ Pages.In
{ Pages._in_total = R.ffor incomes $ \case
Loaded (IncomesAndCount _ n) -> n
_ -> 0
, Pages._in_perPage = Reducer.perPage
}
header <- Header.view $ Header.In
{ Header._in_init = init
, Header._in_currency = _in_currency input
, Header._in_incomes = incomes
}
table <- Table.view $ Table.In
{ Table._in_currentUser = _in_currentUser input
, Table._in_init = init
, Table._in_currency = _in_currency input
, Table._in_incomes = incomes
, Table._in_resetPage = () <$ addIncome
}
return ()
-- -- table :: Event t (Maybe (Table.Out t))
-- table <- R.dyn . R.ffor incomes . Loadable.view $ \incomes ->
-- Table.view $ Table.In
-- { Table._in_currentUser = _in_currentUser input
-- , Table._in_currency = _in_currency input
-- , Table._in_incomes = incomes
-- }
return ()
reduceIncomes
:: forall t m. MonadWidget t m
=> [Income]
-> Event t Income -- add
-> Event t Income -- edit
-> Event t Income -- delete
-> m (Dynamic t [Income])
reduceIncomes initIncomes add edit delete =
R.foldDyn id initIncomes $ R.leftmost
[ (:) <$> add
, R.ffor edit (\p -> (p:) . filter ((/= (_income_id p)) . _income_id))
, R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id))
]
module View.Income.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 (IncomesAndCount)
import Loadable (Loadable (..))
import qualified Loadable as Loadable
import qualified Util.Ajax as AjaxUtil
perPage :: Int
perPage = 7
data In t a b c = In
{ _in_newPage :: Event t Int
, _in_currentPage :: Dynamic t Int
, _in_addIncome :: Event t a
, _in_editIncome :: Event t b
, _in_deleteIncome :: Event t c
}
data Action
= LoadPage Int
| GetResult (Either Text IncomesAndCount)
reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount))
reducer input = do
postBuild <- R.getPostBuild
let loadPage =
R.leftmost
[ 1 <$ postBuild
, _in_newPage input
, 1 <$ _in_addIncome input
, R.tag (R.current $ _in_currentPage input) (_in_editIncome input)
, R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input)
]
getResult <- AjaxUtil.get $ fmap pageUrl loadPage
R.foldDyn
(\action _ -> case action of
LoadPage _ -> Loading
GetResult (Left err) -> Error err
GetResult (Right incomes) -> Loaded incomes
)
Loading
(R.leftmost
[ LoadPage <$> loadPage
, GetResult <$> getResult
])
where
pageUrl p =
"api/v2/incomes?page="
<> (T.pack . show $ p)
<> "&perPage="
<> (T.pack . show $ perPage)
......@@ -22,14 +22,11 @@ import qualified Component.Table as Table
import qualified Util.Ajax as Ajax
import qualified Util.Either as EitherUtil
import qualified View.Income.Form as Form
import View.Income.Init (Init (..))
data In t = In
{ _in_currentUser :: UserId
, _in_init :: Init
, _in_currency :: Currency
, _in_incomes :: Dynamic t [Income]
, _in_resetPage :: Event t ()
}
data Out t = Out
......@@ -44,9 +41,7 @@ view input = do
table <- Table.view $ Table.In
{ Table._in_headerLabel = headerLabel
, Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
, Table._in_cell = cell (_in_init input) (_in_currency input)
, Table._in_perPage = 7
, Table._in_resetPage = _in_resetPage input
, Table._in_cell = cell [] (_in_currency input)
, Table._in_cloneModal = \income ->
Form.view $ Form.In
{ Form._in_operation = Form.Clone income
......@@ -84,11 +79,11 @@ headerLabel UserHeader = Msg.get Msg.Income_Name
headerLabel DateHeader = Msg.get Msg.Income_Date
headerLabel AmountHeader = Msg.get Msg.Income_Amount
cell :: Init -> Currency -> Header -> Income -> Text
cell init currency header income =
cell :: [User] -> Currency -> Header -> Income -> Text
cell users currency header income =
case header of
UserHeader ->
Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
DateHeader ->
Format.longDay . _income_date $ income
......
......@@ -60,6 +60,7 @@ Library
Common.Model.EditPaymentForm
Common.Model.Frequency
Common.Model.Income
Common.Model.IncomesAndCount
Common.Model.Init
Common.Model.InitResult
Common.Model.Payer
......
......@@ -12,6 +12,7 @@ import Common.Model.EditPaymentForm as X
import Common.Model.Email as X
import Common.Model.Frequency as X
import Common.Model.Income as X
import Common.Model.IncomesAndCount as X
import Common.Model.Init as X
import Common.Model.InitResult as X
import Common.Model.Payer as X
......
module Common.Model.IncomesAndCount
( IncomesAndCount(..)
) where
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Common.Model.Income (Income)
data IncomesAndCount = IncomesAndCount
{ _incomesAndCount_incomes :: [Income]
, _incomesAndCount_count :: Int
} deriving (Show, Generic)
instance FromJSON IncomesAndCount
instance ToJSON IncomesAndCount
module Controller.Income
( list
, listv2
, create
, edit
, delete
......@@ -12,7 +13,7 @@ import Web.Scotty hiding (delete)
import Common.Model (CreateIncomeForm (..),
EditIncomeForm (..), IncomeId,
User (..))
IncomesAndCount (..), User (..))
import qualified Controller.Helper as ControllerHelper
import Model.CreateIncome (CreateIncome (..))
......@@ -28,6 +29,16 @@ list =
(liftIO . Query.run $ IncomePersistence.list) >>= json
)
listv2 :: Int -> Int -> ActionM ()
listv2 page perPage =
Secure.loggedAction (\_ ->
(liftIO . Query.run $ do
count <- IncomePersistence.count
incomes <- IncomePersistence.listv2 page perPage
return $ IncomesAndCount incomes count
) >>= json
)
create :: CreateIncomeForm -> ActionM ()
create form =
Secure.loggedAction (\user ->
......
......@@ -54,6 +54,11 @@ main = do
paymentId <- S.param "id"
Payment.delete paymentId
S.get "/api/v2/incomes" $ do
page <- S.param "page"
perPage <- S.param "perPage"
Income.listv2 page perPage
S.get "/api/incomes" $
Income.list
......
module Persistence.Income
( list
( count
, list
, listv2
, create
, edit
, delete
......@@ -29,6 +31,18 @@ instance FromRow Row where
SQLite.field <*>
SQLite.field)
data Count = Count Int
instance FromRow Count where
fromRow = Count <$> SQLite.field
count :: Query Int
count =
Query (\conn ->
(\[Count n] -> n) <$>
SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
)
list :: Query [Income]
list =
Query (\conn ->
......@@ -36,6 +50,16 @@ list =
SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
)
listv2 :: Int -> Int -> Query [Income]
listv2 page perPage =
Query (\conn ->
map (\(Row i) -> i) <$>
SQLite.query
conn
"SELECT * FROM income WHERE deleted_at IS NULL ORDER BY date DESC LIMIT ? OFFSET ?"
(perPage, (page - 1) * perPage)
)
create :: UserId -> Day -> Int -> Query Income
create userId date amount =
Query (\conn -> do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment