-- The income statement accounts screen, like the accounts screen but restricted to income statement accounts.

module Hledger.UI.IncomestatementScreen
 (isNew
 ,isUpdate
 ,isDraw
 ,isHandle
 )
where

import Brick

import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.AccountsScreen (asHandle, asDrawHelper)


isDraw :: UIState -> [Widget Name]
isDraw :: UIState -> [Widget Name]
isDraw UIState
ui = String -> [Widget Name] -> [Widget Name]
forall a. String -> a -> a
dbgui String
"isDraw" ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ UIState -> ReportOpts -> String -> [Widget Name]
asDrawHelper UIState
ui ReportOpts
ropts' String
scrname
  where
    scrname :: String
scrname = String
"income statement changes"
    ropts' :: ReportOpts
ropts' = (ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ (CliOpts -> ReportSpec) -> CliOpts -> ReportSpec
forall a b. (a -> b) -> a -> b
$ UIOpts -> CliOpts
uoCliOpts (UIOpts -> CliOpts) -> UIOpts -> CliOpts
forall a b. (a -> b) -> a -> b
$ UIState -> UIOpts
aopts UIState
ui){balanceaccum_=PerPeriod}

isHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
isHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
isHandle = BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle (BrickEvent Name AppEvent -> EventM Name UIState ())
-> (BrickEvent Name AppEvent -> BrickEvent Name AppEvent)
-> BrickEvent Name AppEvent
-> EventM Name UIState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BrickEvent Name AppEvent -> BrickEvent Name AppEvent
forall a. String -> a -> a
dbgui String
"isHandle"