Commit 9dbb4e6f authored by Joris's avatar Joris

Show income header

parent a267f0bb
......@@ -5,13 +5,15 @@ module View.Income.Header
) where
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import qualified Data.Time.Clock as Clock
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Currency, Income (..), User (..))
import Common.Model (Currency, Income (..),
IncomeHeader (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
......@@ -23,9 +25,9 @@ import qualified View.Income.Form as Form
import View.Income.Init (Init (..))
data In t = In
{ _in_init :: Init
{ _in_users :: [User]
, _in_header :: IncomeHeader
, _in_currency :: Currency
, _in_incomes :: Dynamic t [Income]
}
data Out t = Out
......@@ -38,11 +40,11 @@ view input =
currentTime <- liftIO Clock.getCurrentTime
R.dyn . R.ffor useIncomesFrom $ \case
(Nothing, _) ->
case _incomeHeader_since $ _in_header input of
Nothing ->
R.blank
(Just since, incomes) ->
Just since ->
R.el "div" $ do
R.el "h1" $ do
......@@ -50,15 +52,13 @@ view input =
R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day))
R.el "ul" $
flip mapM_ (_init_users init) $ \user ->
flip mapM_ (M.toList . _incomeHeader_byUser $ _in_header input) $ \(userId, amount) ->
R.el "li" $
R.text $ do
let userIncomes = filter ((==) (_user_id user) . _income_userId) incomes
R.text $
T.intercalate " "
[ _user_name user
[ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser userId (_in_users input)
, "−"
, Format.price (_in_currency input) $
CM.cumulativeIncomesSince currentTime since userIncomes
, Format.price (_in_currency input) amount
]
R.divClass "titleButton" $ do
......@@ -78,14 +78,3 @@ view input =
return $ Out
{ _out_add = addIncome
}
where
init = _in_init input
useIncomesFrom = R.ffor (_in_incomes input) $ \incomes ->
( CM.useIncomesFrom
(map _user_id $_init_users init)
incomes
(_init_payments init)
, incomes
)
......@@ -11,15 +11,15 @@ import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Currency, Income (..),
IncomesAndCount (..), User, UserId)
import Common.Model (Currency, Income (..), IncomePage (..),
User, UserId)
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 View.Income.Header as Header
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
......@@ -36,22 +36,29 @@ view input = do
incomes <- Reducer.reducer $ Reducer.In
{ Reducer._in_newPage = newPage
, Reducer._in_currentPage = currentPage
, Reducer._in_addIncome = addIncome
, Reducer._in_addIncome = R.leftmost [headerAddIncome, tableAddIncome]
, Reducer._in_editIncome = editIncome
, Reducer._in_deleteIncome = deleteIncome
}
let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
let eventFromResult :: forall a. ((Header.Out t, Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
newPage <- eventFromResult $ Pages._out_newPage . snd
newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
currentPage <- R.holdDyn 1 newPage
addIncome <- eventFromResult $ Table._out_add . fst
editIncome <- eventFromResult $ Table._out_edit . fst
deleteIncome <- eventFromResult $ Table._out_delete . fst
headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a)
tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) ->
flip Loadable.view is $ \(IncomesAndCount incomes count) -> do
flip Loadable.view is $ \(IncomePage header incomes count) -> do
header <- Header.view $ Header.In
{ Header._in_users = _in_users input
, Header._in_header = header
, Header._in_currency = _in_currency input
}
table <- Table.view $ Table.In
{ Table._in_currentUser = _in_currentUser input
, Table._in_currency = _in_currency input
......@@ -65,6 +72,6 @@ view input = do
, Pages._in_page = p
}
return (table, pages)
return (header, table, pages)
return ()
......@@ -9,7 +9,7 @@ import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (IncomesAndCount)
import Common.Model (IncomePage)
import Loadable (Loadable (..))
import qualified Loadable as Loadable
......@@ -28,9 +28,9 @@ data In t a b c = In
data Action
= LoadPage Int
| GetResult (Either Text IncomesAndCount)
| GetResult (Either Text IncomePage)
reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount))
reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage))
reducer input = do
postBuild <- R.getPostBuild
......@@ -60,7 +60,7 @@ reducer input = do
where
pageUrl p =
"api/v2/incomes?page="
"api/incomes?page="
<> (T.pack . show $ p)
<> "&perPage="
<> (T.pack . show $ perPage)
......@@ -24,6 +24,7 @@ Library
Build-depends:
aeson
, base >= 4.11 && < 5
, containers
, text
, time
, validation
......@@ -60,7 +61,8 @@ Library
Common.Model.EditPaymentForm
Common.Model.Frequency
Common.Model.Income
Common.Model.IncomesAndCount
Common.Model.IncomeHeader
Common.Model.IncomePage
Common.Model.Init
Common.Model.InitResult
Common.Model.Payer
......
......@@ -12,7 +12,8 @@ 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.IncomeHeader as X
import Common.Model.IncomePage as X
import Common.Model.Init as X
import Common.Model.InitResult as X
import Common.Model.Payer as X
......
module Common.Model.IncomeHeader
( IncomeHeader(..)
) where
import Data.Aeson (FromJSON, ToJSON)
import Data.Map (Map)
import Data.Time.Clock (UTCTime)
import GHC.Generics (Generic)
import Common.Model.User (UserId)
data IncomeHeader = IncomeHeader
{ _incomeHeader_since :: Maybe UTCTime
, _incomeHeader_byUser :: Map UserId Int
} deriving (Show, Generic)
instance FromJSON IncomeHeader
instance ToJSON IncomeHeader
module Common.Model.IncomePage
( IncomePage(..)
) where
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Common.Model.Income (Income)
import Common.Model.IncomeHeader (IncomeHeader)
data IncomePage = IncomePage
{ _incomePage_header :: IncomeHeader
, _incomePage_incomes :: [Income]
, _incomePage_totalCount :: Int
} deriving (Show, Generic)
instance FromJSON IncomePage
instance ToJSON IncomePage
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
) where
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 qualified Network.HTTP.Types.Status as Status
import Web.Scotty hiding (delete)
import Common.Model (CreateIncomeForm (..),
EditIncomeForm (..), IncomeId,
IncomesAndCount (..), User (..))
EditIncomeForm (..), Income (..),
IncomeHeader (..), IncomeId,
IncomePage (..), User (..))
import qualified Common.Model as CM
import qualified Controller.Helper as ControllerHelper
import Model.CreateIncome (CreateIncome (..))
import Model.EditIncome (EditIncome (..))
import qualified Model.Query as Query
import qualified Persistence.Income as IncomePersistence
import qualified Persistence.Payment as PaymentPersistence
import qualified Persistence.User as UserPersistence
import qualified Secure
import qualified Validation.Income as IncomeValidation
list :: ActionM ()
list =
Secure.loggedAction (\_ ->
(liftIO . Query.run $ IncomePersistence.list) >>= json
)
listv2 :: Int -> Int -> ActionM ()
listv2 page perPage =
Secure.loggedAction (\_ ->
list :: Int -> Int -> ActionM ()
list page perPage =
Secure.loggedAction (\_ -> do
currentTime <- liftIO Clock.getCurrentTime
(liftIO . Query.run $ do
count <- IncomePersistence.count
incomes <- IncomePersistence.listv2 page perPage
return $ IncomesAndCount incomes count
) >>= json
users <- UserPersistence.list
allPayments <- PaymentPersistence.listPunctual -- TODO: get first payment defined for all
allIncomes <- IncomePersistence.listAll
let since =
CM.useIncomesFrom (map _user_id users) allIncomes allPayments
let byUser =
case since of
Just s ->
M.fromList . flip map users $ \user ->
( _user_id user
, CM.cumulativeIncomesSince currentTime s $
filter ((==) (_user_id user) . _income_userId) allIncomes
)
Nothing ->
M.empty
incomes <- IncomePersistence.list page perPage
return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json
)
create :: CreateIncomeForm -> ActionM ()
......
......@@ -19,7 +19,7 @@ weeklyReport conf mbLastExecution = do
Nothing -> return ()
Just lastExecution -> do
(payments, incomes, users) <- Query.run $
(,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.list <*> UserPersistence.list
(,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.listAll <*> UserPersistence.list
_ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now)
return ()
return now
......@@ -54,13 +54,10 @@ main = do
paymentId <- S.param "id"
Payment.delete paymentId
S.get "/api/v2/incomes" $ do
S.get "/api/incomes" $ do
page <- S.param "page"
perPage <- S.param "perPage"
Income.listv2 page perPage
S.get "/api/incomes" $
Income.list
Income.list page perPage
S.post "/api/income" $
S.jsonData >>= Income.create
......
module Persistence.Income
( count
, list
, listv2
, listAll
, create
, edit
, delete
......@@ -43,15 +43,8 @@ count =
SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
)
list :: Query [Income]
list =
Query (\conn ->
map (\(Row i) -> i) <$>
SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
)
listv2 :: Int -> Int -> Query [Income]
listv2 page perPage =
list :: Int -> Int -> Query [Income]
list page perPage =
Query (\conn ->
map (\(Row i) -> i) <$>
SQLite.query
......@@ -60,6 +53,16 @@ listv2 page perPage =
(perPage, (page - 1) * perPage)
)
listAll :: Query [Income]
listAll =
Query (\conn ->
map (\(Row i) -> i) <$>
SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
)
-- firstIncomeByUser
-- SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;
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