diff options
Diffstat (limited to 'client/src/View/Income')
| -rw-r--r-- | client/src/View/Income/Income.hs | 101 | ||||
| -rw-r--r-- | client/src/View/Income/Reducer.hs | 66 | ||||
| -rw-r--r-- | client/src/View/Income/Table.hs | 13 | 
3 files changed, 120 insertions, 60 deletions
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index 2f0b8f5..c48f325 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -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)) -    ] diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs new file mode 100644 index 0000000..5b346cb --- /dev/null +++ b/client/src/View/Income/Reducer.hs @@ -0,0 +1,66 @@ +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) diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index d089d9f..6d69c19 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -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  | 
