module View.Payment.Header ( view , In(..) , Out(..) ) where import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) import qualified Data.List as L hiding (groupBy) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Time (NominalDiffTime) import qualified Data.Time as Time import qualified Data.Validation as V import Prelude hiding (init) import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) import qualified Reflex.Dom as R import Common.Model (Category, Currency, ExceedingPayer (..), Frequency (..), Income (..), Payment (..), PaymentCategory, SavedPayment (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format import qualified Component.Button as Button import qualified Component.Input as Input import qualified Component.Modal as Modal import qualified Component.Select as Select import qualified Util.List as L import qualified View.Payment.Form as Form import View.Payment.Init (Init (..)) data In t = In { _in_init :: Init , _in_currency :: Currency , _in_payments :: Dynamic t [Payment] , _in_searchPayments :: Dynamic t [Payment] , _in_paymentCategories :: Dynamic t [PaymentCategory] } data Out t = Out { _out_searchName :: Dynamic t Text , _out_searchFrequency :: Dynamic t Frequency , _out_addPayment :: Event t SavedPayment } view :: forall t m. MonadWidget t m => In t -> m (Out t) view input = R.divClass "header" $ do rec addPayment <- payerAndAdd incomes payments users categories paymentCategories currency searchFrequency let resetSearchName = fmap (const ()) $ addPayment (searchName, searchFrequency) <- searchLine resetSearchName infos (_in_searchPayments input) users currency return $ Out { _out_searchName = searchName , _out_searchFrequency = searchFrequency , _out_addPayment = addPayment } where init = _in_init input incomes = _init_incomes init initPayments = _init_payments init payments = _in_payments input users = _init_users init categories = _init_categories init currency = _in_currency input paymentCategories = _in_paymentCategories input payerAndAdd :: forall t m. MonadWidget t m => [Income] -> Dynamic t [Payment] -> [User] -> [Category] -> Dynamic t [PaymentCategory] -> Currency -> Dynamic t Frequency -> m (Event t SavedPayment) payerAndAdd incomes payments users categories paymentCategories currency frequency = do time <- liftIO Time.getCurrentTime R.divClass "payerAndAdd" $ do let exceedingPayers = R.ffor payments $ \ps -> CM.getExceedingPayers time users incomes $ filter ((==) Punctual . _payment_frequency) ps R.divClass "exceedingPayers" $ R.simpleList exceedingPayers $ \exceedingPayer -> R.elClass "span" "exceedingPayer" $ do R.elClass "span" "userName" $ R.dynText . R.ffor exceedingPayer $ \ep -> fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId ep) users R.elClass "span" "amount" $ do R.text "+ " R.dynText . R.ffor exceedingPayer $ \ep -> Format.price currency $ _exceedingPayer_amount ep addPayment <- Button._out_clic <$> (Button.view $ (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add)) { Button._in_class = R.constDyn "addPayment" }) Modal.view $ Modal.In { Modal._in_show = addPayment , Modal._in_content = \_ -> return (R.never, R.never) -- TODO } searchLine :: forall t m. MonadWidget t m => Event t () -> m (Dynamic t Text, Dynamic t Frequency) searchLine reset = do R.divClass "searchLine" $ do searchName <- Input._out_raw <$> (Input.view ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name }) ("" <$ reset) R.never) let frequencies = M.fromList [ (Punctual, Msg.get Msg.Payment_PunctualMale) , (Monthly, Msg.get Msg.Payment_MonthlyMale) ] searchFrequency <- Select._out_raw <$> (Select.view $ Select.In { Select._in_label = "" , Select._in_initialValue = Punctual , Select._in_value = R.never , Select._in_values = R.constDyn frequencies , Select._in_reset = R.never , Select._in_isValid = V.Success , Select._in_validate = R.never }) return (searchName, searchFrequency) infos :: forall t m. MonadWidget t m => Dynamic t [Payment] -> [User] -> Currency -> m () infos payments users currency = R.divClass "infos" $ do R.elClass "span" "total" $ do R.dynText $ do ps <- payments let paymentCount = length ps total = sum . map _payment_cost $ ps pure . Msg.get $ Msg.Payment_Worth (T.intercalate " " [ (Format.number paymentCount) , if paymentCount > 1 then Msg.get Msg.Payment_Many else Msg.get Msg.Payment_One ]) (Format.price currency total) R.elClass "span" "partition" . R.dynText $ do ps <- payments let totalByUser = L.sortBy (\(_, t1) (_, t2) -> compare t2 t1) . map (\(u, xs) -> (u, sum . map snd $ xs)) . L.groupBy fst . map (\p -> (_payment_user p, _payment_cost p)) $ ps pure . T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) -> Msg.get $ Msg.Payment_By (fromMaybe "" . fmap _user_name $ CM.findUser userId users) (Format.price currency userTotal)