{- | UIState operations. -}

module Hledger.UI.UIState
(uiState
,uiShowStatus
,setFilter
,setMode
,setReportPeriod
,showMinibuffer
,closeMinibuffer
,toggleCleared
,toggleConversionOp
,toggleIgnoreBalanceAssertions
,toggleEmpty
,toggleForecast
,toggleHistorical
,togglePending
,toggleUnmarked
,toggleReal
,toggleTree
,setTree
,setList
,toggleValue
,reportPeriod
,shrinkReportPeriod
,growReportPeriod
,nextReportPeriod
,previousReportPeriod
,resetReportPeriod
,moveReportPeriodToDate
,getDepth
,setDepth
,decDepth
,incDepth
,resetDepth
,popScreen
,pushScreen
,enableForecastPreservingPeriod
,resetFilter
,resetScreens
,regenerateScreens
)
where

import Brick.Widgets.Edit
import Data.Bifunctor (first)
import Data.Foldable (asum)
import Data.Either (fromRight)
import Data.List ((\\), sort)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Max(..))
import qualified Data.Text as T
import Data.Text.Zipper (gotoEOL)
import Data.Time.Calendar (Day)
import Lens.Micro ((^.), over, set)
import Safe

import Hledger
import Hledger.Cli.CliOptions
import Hledger.UI.UITypes
import Hledger.UI.UIOptions (UIOpts(uoCliOpts))
import Hledger.UI.UIScreens (screenUpdate)

-- | Make an initial UI state with the given options, journal,
-- parent screen stack if any, and starting screen.
uiState :: UIOpts -> Journal -> [Screen] -> Screen -> UIState
uiState :: UIOpts -> Journal -> [Screen] -> Screen -> UIState
uiState UIOpts
uopts Journal
j [Screen]
prevscrs Screen
scr = UIState {
   astartupopts :: UIOpts
astartupopts  = UIOpts
uopts
  ,aopts :: UIOpts
aopts         = UIOpts
uopts
  ,ajournal :: Journal
ajournal      = Journal
j
  ,aMode :: Mode
aMode         = Mode
Normal
  ,aScreen :: Screen
aScreen      = Screen
scr
  ,aPrevScreens :: [Screen]
aPrevScreens = [Screen]
prevscrs
  }

-- | Toggle between showing only unmarked items or all items.
toggleUnmarked :: UIState -> UIState
toggleUnmarked :: UIState -> UIState
toggleUnmarked = ASetter UIState UIState [Status] [Status]
-> ([Status] -> [Status]) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState [Status] [Status]
forall a. HasReportOpts a => ReportableLens' a [Status]
ReportableLens' UIState [Status]
statuses (Status -> [Status] -> [Status]
toggleStatus1 Status
Unmarked)

-- | Toggle between showing only pending items or all items.
togglePending :: UIState -> UIState
togglePending :: UIState -> UIState
togglePending = ASetter UIState UIState [Status] [Status]
-> ([Status] -> [Status]) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState [Status] [Status]
forall a. HasReportOpts a => ReportableLens' a [Status]
ReportableLens' UIState [Status]
statuses (Status -> [Status] -> [Status]
toggleStatus1 Status
Pending)

-- | Toggle between showing only cleared items or all items.
toggleCleared :: UIState -> UIState
toggleCleared :: UIState -> UIState
toggleCleared = ASetter UIState UIState [Status] [Status]
-> ([Status] -> [Status]) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState [Status] [Status]
forall a. HasReportOpts a => ReportableLens' a [Status]
ReportableLens' UIState [Status]
statuses (Status -> [Status] -> [Status]
toggleStatus1 Status
Cleared)

-- TODO testing different status toggle styles

-- | Generate zero or more indicators of the status filters currently active,
-- which will be shown comma-separated as part of the indicators list.
uiShowStatus :: CliOpts -> [Status] -> [String]
uiShowStatus :: CliOpts -> [Status] -> [String]
uiShowStatus CliOpts
copts [Status]
ss =
  case Maybe Int
style of
    -- in style 2, instead of "Y, Z" show "not X"
    Just Int
2 | [Status] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Status]
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numstatusesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
      -> (Status -> String) -> [Status] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"not "String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (Status -> String) -> Status -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
showstatus) ([Status] -> [String]) -> [Status] -> [String]
forall a b. (a -> b) -> a -> b
$ [Status] -> [Status]
forall a. Ord a => [a] -> [a]
sort ([Status] -> [Status]) -> [Status] -> [Status]
forall a b. (a -> b) -> a -> b
$ [Status] -> [Status]
forall a. (Bounded a, Enum a, Eq a) => [a] -> [a]
complement [Status]
ss  -- should be just one
    Maybe Int
_ -> (Status -> String) -> [Status] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Status -> String
showstatus ([Status] -> [String]) -> [Status] -> [String]
forall a b. (a -> b) -> a -> b
$ [Status] -> [Status]
forall a. Ord a => [a] -> [a]
sort [Status]
ss
  where
    numstatuses :: Int
numstatuses = [Status] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Status
forall a. Bounded a => a
minBound..Status
forall a. Bounded a => a
maxBound::Status]
    style :: Maybe Int
style = String -> RawOpts -> Maybe Int
maybeposintopt String
"status-toggles" (RawOpts -> Maybe Int) -> RawOpts -> Maybe Int
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
copts
    showstatus :: Status -> String
showstatus Status
Cleared  = String
"cleared"
    showstatus Status
Pending  = String
"pending"
    showstatus Status
Unmarked = String
"unmarked"

-- various toggle behaviours:

-- 1 UPC toggles only X/all
toggleStatus1 :: Status -> [Status] -> [Status]
toggleStatus1 :: Status -> [Status] -> [Status]
toggleStatus1 Status
s [Status]
ss = if [Status]
ss [Status] -> [Status] -> Bool
forall a. Eq a => a -> a -> Bool
== [Status
s] then [] else [Status
s]

-- 2 UPC cycles X/not-X/all
-- repeatedly pressing X cycles:
-- [] U [u]
-- [u] U [pc]
-- [pc] U []
-- pressing Y after first or second step starts new cycle:
-- [u] P [p]
-- [pc] P [p]
-- toggleStatus s ss
--   | ss == [s]            = complement [s]
--   | ss == complement [s] = []
--   | otherwise            = [s]  -- XXX assume only three values

-- 3 UPC toggles each X
-- toggleStatus3 s ss
--   | s `elem` ss = filter (/= s) ss
--   | otherwise   = simplifyStatuses (s:ss)

-- 4 upc sets X, UPC sets not-X
-- toggleStatus4 s ss
--  | s `elem` ss = filter (/= s) ss
--  | otherwise   = simplifyStatuses (s:ss)

-- 5 upc toggles X, UPC toggles not-X
-- toggleStatus5 s ss
--  | s `elem` ss = filter (/= s) ss
--  | otherwise   = simplifyStatuses (s:ss)

-- | Given a list of unique enum values, list the other possible values of that enum.
complement :: (Bounded a, Enum a, Eq a) => [a] -> [a]
complement :: forall a. (Bounded a, Enum a, Eq a) => [a] -> [a]
complement = ([a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\)

--

-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
toggleEmpty :: UIState -> UIState
toggleEmpty :: UIState -> UIState
toggleEmpty = ASetter UIState UIState Bool Bool
-> (Bool -> Bool) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState Bool Bool
forall c. HasReportOptsNoUpdate c => Lens' c Bool
Lens' UIState Bool
empty__ Bool -> Bool
not

-- | Toggle between showing the primary amounts or costs.
toggleConversionOp :: UIState -> UIState
toggleConversionOp :: UIState -> UIState
toggleConversionOp = ASetter UIState UIState (Maybe ConversionOp) (Maybe ConversionOp)
-> (Maybe ConversionOp -> Maybe ConversionOp) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState (Maybe ConversionOp) (Maybe ConversionOp)
forall c. HasReportOptsNoUpdate c => Lens' c (Maybe ConversionOp)
Lens' UIState (Maybe ConversionOp)
conversionop Maybe ConversionOp -> Maybe ConversionOp
toggleCostMode
  where
    toggleCostMode :: Maybe ConversionOp -> Maybe ConversionOp
toggleCostMode Maybe ConversionOp
Nothing               = ConversionOp -> Maybe ConversionOp
forall a. a -> Maybe a
Just ConversionOp
ToCost
    toggleCostMode (Just ConversionOp
NoConversionOp) = ConversionOp -> Maybe ConversionOp
forall a. a -> Maybe a
Just ConversionOp
ToCost
    toggleCostMode (Just ConversionOp
ToCost)         = ConversionOp -> Maybe ConversionOp
forall a. a -> Maybe a
Just ConversionOp
NoConversionOp

-- | Toggle between showing primary amounts or values (using valuation specified at startup, or a default).
toggleValue :: UIState -> UIState
toggleValue :: UIState -> UIState
toggleValue UIState
ui = ASetter UIState UIState (Maybe ValuationType) (Maybe ValuationType)
-> (Maybe ValuationType -> Maybe ValuationType)
-> UIState
-> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState (Maybe ValuationType) (Maybe ValuationType)
forall c. HasReportOptsNoUpdate c => Lens' c (Maybe ValuationType)
Lens' UIState (Maybe ValuationType)
value (Maybe ValuationType -> Maybe ValuationType -> Maybe ValuationType
forall {a}. Maybe ValuationType -> Maybe a -> Maybe ValuationType
valuationToggleValue Maybe ValuationType
mstartupvaluation0) UIState
ui
  where
    mstartupvaluation0 :: Maybe ValuationType
mstartupvaluation0 = ReportOpts -> Maybe ValuationType
value_ (ReportOpts -> Maybe ValuationType)
-> ReportOpts -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ 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
astartupopts UIState
ui
    mdefvaluation :: Maybe ValuationType
mdefvaluation = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (Maybe CommoditySymbol -> ValuationType
AtEnd Maybe CommoditySymbol
forall a. Maybe a
Nothing)
    -- valuationToggleValue (maybe startupvaluation) (maybe currentvaluation) = ...
    valuationToggleValue :: Maybe ValuationType -> Maybe a -> Maybe ValuationType
valuationToggleValue Maybe ValuationType
Nothing           Maybe a
Nothing  = Maybe ValuationType
mdefvaluation
    valuationToggleValue Maybe ValuationType
Nothing           (Just a
_) = Maybe ValuationType
forall a. Maybe a
Nothing
    valuationToggleValue Maybe ValuationType
mstartupvaluation Maybe a
Nothing  = Maybe ValuationType
mstartupvaluation
    valuationToggleValue Maybe ValuationType
_                 (Just a
_) = Maybe ValuationType
forall a. Maybe a
Nothing

-- | Set hierarchic account tree mode.
setTree :: UIState -> UIState
setTree :: UIState -> UIState
setTree = ASetter UIState UIState AccountListMode AccountListMode
-> AccountListMode -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState AccountListMode AccountListMode
forall c. HasReportOptsNoUpdate c => Lens' c AccountListMode
Lens' UIState AccountListMode
accountlistmode AccountListMode
ALTree

-- | Set flat account list mode.
setList :: UIState -> UIState
setList :: UIState -> UIState
setList = ASetter UIState UIState AccountListMode AccountListMode
-> AccountListMode -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState AccountListMode AccountListMode
forall c. HasReportOptsNoUpdate c => Lens' c AccountListMode
Lens' UIState AccountListMode
accountlistmode AccountListMode
ALFlat

-- | Toggle between flat and tree mode. If current mode is unspecified/default, assume it's flat.
toggleTree :: UIState -> UIState
toggleTree :: UIState -> UIState
toggleTree = ASetter UIState UIState AccountListMode AccountListMode
-> (AccountListMode -> AccountListMode) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState AccountListMode AccountListMode
forall c. HasReportOptsNoUpdate c => Lens' c AccountListMode
Lens' UIState AccountListMode
accountlistmode AccountListMode -> AccountListMode
toggleTreeMode
  where
    toggleTreeMode :: AccountListMode -> AccountListMode
toggleTreeMode AccountListMode
ALTree = AccountListMode
ALFlat
    toggleTreeMode AccountListMode
ALFlat = AccountListMode
ALTree

-- | Toggle between historical balances and period balances.
toggleHistorical :: UIState -> UIState
toggleHistorical :: UIState -> UIState
toggleHistorical = ASetter UIState UIState BalanceAccumulation BalanceAccumulation
-> (BalanceAccumulation -> BalanceAccumulation)
-> UIState
-> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState BalanceAccumulation BalanceAccumulation
forall c. HasReportOptsNoUpdate c => Lens' c BalanceAccumulation
Lens' UIState BalanceAccumulation
balanceaccum BalanceAccumulation -> BalanceAccumulation
toggleBalanceAccum
  where
    toggleBalanceAccum :: BalanceAccumulation -> BalanceAccumulation
toggleBalanceAccum BalanceAccumulation
Historical = BalanceAccumulation
PerPeriod
    toggleBalanceAccum BalanceAccumulation
_          = BalanceAccumulation
Historical

-- | Toggle hledger-ui's "forecast/future mode". When this mode is enabled,
-- hledger-shows regular transactions which have future dates, and
-- "forecast" transactions generated by periodic transaction rules
-- (which are usually but not necessarily future-dated).
-- In normal mode, both of these are hidden.
toggleForecast :: Day -> UIState -> UIState
toggleForecast :: Day -> UIState -> UIState
toggleForecast Day
_d UIState
ui = ASetter UIState UIState (Maybe DateSpan) (Maybe DateSpan)
-> Maybe DateSpan -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState (Maybe DateSpan) (Maybe DateSpan)
forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
Lens' UIState (Maybe DateSpan)
forecast Maybe DateSpan
newForecast UIState
ui
  where
    newForecast :: Maybe DateSpan
newForecast = case UIState
uiUIState
-> Getting (Maybe DateSpan) UIState (Maybe DateSpan)
-> Maybe DateSpan
forall s a. s -> Getting a s a -> a
^.Getting (Maybe DateSpan) UIState (Maybe DateSpan)
forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
Lens' UIState (Maybe DateSpan)
forecast of
      Just DateSpan
_  -> Maybe DateSpan
forall a. Maybe a
Nothing
      Maybe DateSpan
Nothing -> UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod UIState
ui (UIState
uiUIState -> Getting CliOpts UIState CliOpts -> CliOpts
forall s a. s -> Getting a s a -> a
^.Getting CliOpts UIState CliOpts
forall c. HasCliOpts c => Lens' c CliOpts
Lens' UIState CliOpts
cliOpts) CliOpts
-> Getting (Maybe DateSpan) CliOpts (Maybe DateSpan)
-> Maybe DateSpan
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DateSpan) CliOpts (Maybe DateSpan)
forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
Lens' CliOpts (Maybe DateSpan)
forecast

-- | Ensure this CliOpts enables forecasted transactions.
-- If a forecast period was specified in the old CliOpts,
-- or in the provided UIState's startup options,
-- it is preserved.
enableForecastPreservingPeriod :: UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod :: UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod UIState
ui CliOpts
copts = ASetter CliOpts CliOpts (Maybe DateSpan) (Maybe DateSpan)
-> Maybe DateSpan -> CliOpts -> CliOpts
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter CliOpts CliOpts (Maybe DateSpan) (Maybe DateSpan)
forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
Lens' CliOpts (Maybe DateSpan)
forecast Maybe DateSpan
mforecast CliOpts
copts
  where
    mforecast :: Maybe DateSpan
mforecast = [Maybe DateSpan] -> Maybe DateSpan
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe DateSpan
mprovidedforecastperiod, Maybe DateSpan
mstartupforecastperiod, Maybe DateSpan
mdefaultforecastperiod]
      where
        mprovidedforecastperiod :: Maybe DateSpan
mprovidedforecastperiod = CliOpts
copts CliOpts
-> Getting (Maybe DateSpan) CliOpts (Maybe DateSpan)
-> Maybe DateSpan
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DateSpan) CliOpts (Maybe DateSpan)
forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
Lens' CliOpts (Maybe DateSpan)
forecast
        mstartupforecastperiod :: Maybe DateSpan
mstartupforecastperiod  = UIState -> UIOpts
astartupopts UIState
ui UIOpts
-> Getting (Maybe DateSpan) UIOpts (Maybe DateSpan)
-> Maybe DateSpan
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DateSpan) UIOpts (Maybe DateSpan)
forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
Lens' UIOpts (Maybe DateSpan)
forecast
        mdefaultforecastperiod :: Maybe DateSpan
mdefaultforecastperiod  = DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just DateSpan
nulldatespan

-- | Toggle between showing all and showing only real (non-virtual) items.
toggleReal :: UIState -> UIState
toggleReal :: UIState -> UIState
toggleReal = UIState -> Either String UIState -> UIState
forall b a. b -> Either a b -> b
fromRight UIState
forall {a}. a
err (Either String UIState -> UIState)
-> (UIState -> Either String UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Either String Bool) -> UIState -> Either String UIState)
-> (Bool -> Bool) -> UIState -> Either String UIState
forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither (Bool -> Either String Bool) -> UIState -> Either String UIState
forall a. HasReportOpts a => ReportableLens' a Bool
ReportableLens' UIState Bool
real Bool -> Bool
not  -- PARTIAL:
  where err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"toggleReal: updating Real should not result in an error"

-- | Toggle the ignoring of balance assertions.
toggleIgnoreBalanceAssertions :: UIState -> UIState
toggleIgnoreBalanceAssertions :: UIState -> UIState
toggleIgnoreBalanceAssertions = ASetter UIState UIState Bool Bool
-> (Bool -> Bool) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState Bool Bool
forall c. HasBalancingOpts c => Lens' c Bool
Lens' UIState Bool
ignore_assertions Bool -> Bool
not

-- | Step through larger report periods, up to all.
growReportPeriod :: Day -> UIState -> UIState
growReportPeriod :: Day -> UIState -> UIState
growReportPeriod Day
_d = (Period -> Period) -> UIState -> UIState
updateReportPeriod Period -> Period
periodGrow

-- | Step through smaller report periods, down to a day.
shrinkReportPeriod :: Day -> UIState -> UIState
shrinkReportPeriod :: Day -> UIState -> UIState
shrinkReportPeriod Day
d = (Period -> Period) -> UIState -> UIState
updateReportPeriod (Day -> Period -> Period
periodShrink Day
d)

-- | Step the report start/end dates to the next period of same duration,
-- remaining inside the given enclosing span.
nextReportPeriod :: DateSpan -> UIState -> UIState
nextReportPeriod :: DateSpan -> UIState -> UIState
nextReportPeriod DateSpan
enclosingspan = (Period -> Period) -> UIState -> UIState
updateReportPeriod (DateSpan -> Period -> Period
periodNextIn DateSpan
enclosingspan)

-- | Step the report start/end dates to the next period of same duration,
-- remaining inside the given enclosing span.
previousReportPeriod :: DateSpan -> UIState -> UIState
previousReportPeriod :: DateSpan -> UIState -> UIState
previousReportPeriod DateSpan
enclosingspan = (Period -> Period) -> UIState -> UIState
updateReportPeriod (DateSpan -> Period -> Period
periodPreviousIn DateSpan
enclosingspan)

-- | If a standard report period is set, step it forward/backward if needed so that
-- it encloses the given date.
moveReportPeriodToDate :: Day -> UIState -> UIState
moveReportPeriodToDate :: Day -> UIState -> UIState
moveReportPeriodToDate Day
d = (Period -> Period) -> UIState -> UIState
updateReportPeriod (Day -> Period -> Period
periodMoveTo Day
d)

-- | Clear any report period limits.
resetReportPeriod :: UIState -> UIState
resetReportPeriod :: UIState -> UIState
resetReportPeriod = Period -> UIState -> UIState
setReportPeriod Period
PeriodAll

-- | Get the report period.
reportPeriod :: UIState -> Period
reportPeriod :: UIState -> Period
reportPeriod = (UIState -> Getting Period UIState Period -> Period
forall s a. s -> Getting a s a -> a
^.Getting Period UIState Period
forall a. HasReportOpts a => ReportableLens' a Period
ReportableLens' UIState Period
period)

-- | Set the report period.
setReportPeriod :: Period -> UIState -> UIState
setReportPeriod :: Period -> UIState -> UIState
setReportPeriod Period
p = (Period -> Period) -> UIState -> UIState
updateReportPeriod (Period -> Period -> Period
forall a b. a -> b -> a
const Period
p)

-- | Update report period by a applying a function.
updateReportPeriod :: (Period -> Period) -> UIState -> UIState
updateReportPeriod :: (Period -> Period) -> UIState -> UIState
updateReportPeriod Period -> Period
updatePeriod = UIState -> Either String UIState -> UIState
forall b a. b -> Either a b -> b
fromRight UIState
forall {a}. a
err (Either String UIState -> UIState)
-> (UIState -> Either String UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Period -> Either String Period)
 -> UIState -> Either String UIState)
-> (Period -> Period) -> UIState -> Either String UIState
forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither (Period -> Either String Period)
-> UIState -> Either String UIState
forall a. HasReportOpts a => ReportableLens' a Period
ReportableLens' UIState Period
period Period -> Period
updatePeriod  -- PARTIAL:
  where err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"updateReportPeriod: updating period should not result in an error"

-- | Apply a new filter query, or return the failing query.
setFilter :: String -> UIState -> Either String UIState
setFilter :: String -> UIState -> Either String UIState
setFilter String
s = (String -> String)
-> Either String UIState -> Either String UIState
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> String -> String
forall a b. a -> b -> a
const String
s) (Either String UIState -> Either String UIState)
-> (UIState -> Either String UIState)
-> UIState
-> Either String UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([CommoditySymbol] -> Either String [CommoditySymbol])
 -> UIState -> Either String UIState)
-> [CommoditySymbol] -> UIState -> Either String UIState
forall a e b s t.
((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t
setEither ([CommoditySymbol] -> Either String [CommoditySymbol])
-> UIState -> Either String UIState
forall a. HasReportOpts a => ReportableLens' a [CommoditySymbol]
ReportableLens' UIState [CommoditySymbol]
querystring ([CommoditySymbol] -> CommoditySymbol -> [CommoditySymbol]
words'' [CommoditySymbol]
queryprefixes (CommoditySymbol -> [CommoditySymbol])
-> CommoditySymbol -> [CommoditySymbol]
forall a b. (a -> b) -> a -> b
$ String -> CommoditySymbol
T.pack String
s)

-- | Reset some filters & toggles.
resetFilter :: UIState -> UIState
resetFilter :: UIState -> UIState
resetFilter = ASetter UIState UIState [CommoditySymbol] [CommoditySymbol]
-> [CommoditySymbol] -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState [CommoditySymbol] [CommoditySymbol]
forall c. HasReportOptsNoUpdate c => Lens' c [CommoditySymbol]
Lens' UIState [CommoditySymbol]
querystringNoUpdate [] (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter UIState UIState Bool Bool -> Bool -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState Bool Bool
forall c. HasReportOptsNoUpdate c => Lens' c Bool
Lens' UIState Bool
realNoUpdate Bool
False (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter UIState UIState [Status] [Status]
-> [Status] -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState [Status] [Status]
forall c. HasReportOptsNoUpdate c => Lens' c [Status]
Lens' UIState [Status]
statusesNoUpdate []
            (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter UIState UIState Bool Bool -> Bool -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState Bool Bool
forall c. HasReportOptsNoUpdate c => Lens' c Bool
Lens' UIState Bool
empty__ Bool
True  -- set period PeriodAll
            (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter UIState UIState Query Query -> Query -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState Query Query
forall c. HasReportSpec c => Lens' c Query
Lens' UIState Query
rsQuery Query
Any (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter UIState UIState [QueryOpt] [QueryOpt]
-> [QueryOpt] -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UIState UIState [QueryOpt] [QueryOpt]
forall c. HasReportSpec c => Lens' c [QueryOpt]
Lens' UIState [QueryOpt]
rsQueryOpts []

-- -- | Reset all options state to exactly what it was at startup
-- -- (preserving any command-line options/arguments).
-- resetOpts :: UIState -> UIState
-- resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts}

resetDepth :: UIState -> UIState
resetDepth :: UIState -> UIState
resetDepth = (Maybe Int -> Maybe Int) -> UIState -> UIState
updateReportDepth (Maybe Int -> Maybe Int -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing)

-- | Get the maximum account depth in the current journal.
maxDepth :: UIState -> Int
maxDepth :: UIState -> Int
maxDepth UIState{ajournal :: UIState -> Journal
ajournal=Journal
j} = Max Int -> Int
forall a. Max a -> a
getMax (Max Int -> Int)
-> ([CommoditySymbol] -> Max Int) -> [CommoditySymbol] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommoditySymbol -> Max Int) -> [CommoditySymbol] -> Max Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Max Int
forall a. a -> Max a
Max (Int -> Max Int)
-> (CommoditySymbol -> Int) -> CommoditySymbol -> Max Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Int
accountNameLevel) ([CommoditySymbol] -> Int) -> [CommoditySymbol] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [CommoditySymbol]
journalAccountNamesDeclaredOrImplied Journal
j

-- | Decrement the current depth limit towards 0. If there was no depth limit,
-- set it to one less than the maximum account depth.
decDepth :: UIState -> UIState
decDepth :: UIState -> UIState
decDepth UIState
ui = (Maybe Int -> Maybe Int) -> UIState -> UIState
updateReportDepth Maybe Int -> Maybe Int
dec UIState
ui
  where
    dec :: Maybe Int -> Maybe Int
dec (Just Int
d) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    dec Maybe Int
Nothing  = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ UIState -> Int
maxDepth UIState
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Increment the current depth limit. If this makes it equal to the
-- the maximum account depth, remove the depth limit.
incDepth :: UIState -> UIState
incDepth :: UIState -> UIState
incDepth = (Maybe Int -> Maybe Int) -> UIState -> UIState
updateReportDepth ((Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Enum a => a -> a
succ)

-- | Set the current depth limit to the specified depth, or remove the depth limit.
-- Also remove the depth limit if the specified depth is greater than the current
-- maximum account depth. If the specified depth is negative, reset the depth limit
-- to whatever was specified at uiartup.
setDepth :: Maybe Int -> UIState -> UIState
setDepth :: Maybe Int -> UIState -> UIState
setDepth Maybe Int
mdepth = (Maybe Int -> Maybe Int) -> UIState -> UIState
updateReportDepth (Maybe Int -> Maybe Int -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
mdepth)

getDepth :: UIState -> Maybe Int
getDepth :: UIState -> Maybe Int
getDepth = (UIState -> Getting (Maybe Int) UIState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) UIState (Maybe Int)
forall a. HasReportOpts a => ReportableLens' a (Maybe Int)
ReportableLens' UIState (Maybe Int)
depth)

-- | Update report depth by a applying a function. If asked to set a depth less
-- than zero, it will leave it unchanged.
updateReportDepth :: (Maybe Int -> Maybe Int) -> UIState -> UIState
updateReportDepth :: (Maybe Int -> Maybe Int) -> UIState -> UIState
updateReportDepth Maybe Int -> Maybe Int
updateDepth UIState
ui = ASetter UIState UIState ReportSpec ReportSpec
-> (ReportSpec -> ReportSpec) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UIState UIState ReportSpec ReportSpec
forall c. HasReportSpec c => Lens' c ReportSpec
Lens' UIState ReportSpec
reportSpec ReportSpec -> ReportSpec
update UIState
ui
  where
    update :: ReportSpec -> ReportSpec
update = ReportSpec -> Either String ReportSpec -> ReportSpec
forall b a. b -> Either a b -> b
fromRight (String -> ReportSpec
forall a. HasCallStack => String -> a
error String
"updateReportDepth: updating depth should not result in an error")  -- PARTIAL:
           (Either String ReportSpec -> ReportSpec)
-> (ReportSpec -> Either String ReportSpec)
-> ReportSpec
-> ReportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReportOpts -> ReportOpts)
-> ReportSpec -> Either String ReportSpec
updateReportSpecWith (\ReportOpts
ropts -> ReportOpts
ropts{depth_=updateDepth (depth_ ropts) >>= clipDepth ropts})
    clipDepth :: ReportOpts -> Int -> Maybe Int
clipDepth ReportOpts
ropts Int
d | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0            = ReportOpts -> Maybe Int
depth_ ReportOpts
ropts
                      | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= UIState -> Int
maxDepth UIState
ui = Maybe Int
forall a. Maybe a
Nothing
                      | Bool
otherwise        = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d

-- | Open the minibuffer, setting its content to the current query with the cursor at the end.
showMinibuffer :: T.Text -> Maybe String -> UIState -> UIState
showMinibuffer :: CommoditySymbol -> Maybe String -> UIState -> UIState
showMinibuffer CommoditySymbol
label Maybe String
moldq UIState
ui = Mode -> UIState -> UIState
setMode (CommoditySymbol -> Editor String Name -> Mode
Minibuffer CommoditySymbol
label Editor String Name
e) UIState
ui
  where
    e :: Editor String Name
e = (TextZipper String -> TextZipper String)
-> Editor String Name -> Editor String Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper String -> TextZipper String
forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL (Editor String Name -> Editor String Name)
-> Editor String Name -> Editor String Name
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Int -> String -> Editor String Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor Name
MinibufferEditor (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) String
oldq
    oldq :: String
oldq = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (CommoditySymbol -> String
T.unpack (CommoditySymbol -> String)
-> ([CommoditySymbol] -> CommoditySymbol)
-> [CommoditySymbol]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommoditySymbol] -> CommoditySymbol
T.unwords ([CommoditySymbol] -> CommoditySymbol)
-> ([CommoditySymbol] -> [CommoditySymbol])
-> [CommoditySymbol]
-> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommoditySymbol -> CommoditySymbol)
-> [CommoditySymbol] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map CommoditySymbol -> CommoditySymbol
textQuoteIfNeeded ([CommoditySymbol] -> String) -> [CommoditySymbol] -> String
forall a b. (a -> b) -> a -> b
$ UIState
uiUIState
-> Getting [CommoditySymbol] UIState [CommoditySymbol]
-> [CommoditySymbol]
forall s a. s -> Getting a s a -> a
^.Getting [CommoditySymbol] UIState [CommoditySymbol]
forall a. HasReportOpts a => ReportableLens' a [CommoditySymbol]
ReportableLens' UIState [CommoditySymbol]
querystring) Maybe String
moldq

-- | Close the minibuffer, discarding any edit in progress.
closeMinibuffer :: UIState -> UIState
closeMinibuffer :: UIState -> UIState
closeMinibuffer = Mode -> UIState -> UIState
setMode Mode
Normal

setMode :: Mode -> UIState -> UIState
setMode :: Mode -> UIState -> UIState
setMode Mode
m UIState
ui = UIState
ui{aMode=m}

pushScreen :: Screen -> UIState -> UIState
pushScreen :: Screen -> UIState -> UIState
pushScreen Screen
scr UIState
ui = UIState
ui{aPrevScreens=(aScreen ui:aPrevScreens ui)
                      ,aScreen=scr
                      }

popScreen :: UIState -> UIState
popScreen :: UIState -> UIState
popScreen ui :: UIState
ui@UIState{aPrevScreens :: UIState -> [Screen]
aPrevScreens=Screen
s:[Screen]
ss} = UIState
ui{aScreen=s, aPrevScreens=ss}
popScreen UIState
ui = UIState
ui

-- | Reset options to their startup values, discard screen navigation history,
-- and return to the top screen, regenerating it with the startup options 
-- and the provided reporting date.
resetScreens :: Day -> UIState -> UIState
resetScreens :: Day -> UIState -> UIState
resetScreens Day
d ui :: UIState
ui@UIState{astartupopts :: UIState -> UIOpts
astartupopts=UIOpts
origopts, ajournal :: UIState -> Journal
ajournal=Journal
j, aScreen :: UIState -> Screen
aScreen=Screen
s,aPrevScreens :: UIState -> [Screen]
aPrevScreens=[Screen]
ss} =
  UIState
ui{aopts=origopts, aPrevScreens=[], aScreen=topscreen', aMode=Normal}
  where
    topscreen' :: Screen
topscreen' = UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate UIOpts
origopts Day
d Journal
j (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$ Screen -> [Screen] -> Screen
forall a. a -> [a] -> a
lastDef Screen
s [Screen]
ss

-- | Given a new journal and reporting date, save the new journal in the ui state,
-- then regenerate the content of all screens in the stack
-- (using the ui state's current options), preserving the screen navigation history.
-- Note, does not save the reporting date.
regenerateScreens :: Journal -> Day -> UIState -> UIState
regenerateScreens :: Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d ui :: UIState
ui@UIState{aopts :: UIState -> UIOpts
aopts=UIOpts
opts, aScreen :: UIState -> Screen
aScreen=Screen
s,aPrevScreens :: UIState -> [Screen]
aPrevScreens=[Screen]
ss} =
  UIState
ui{ajournal=j, aScreen=screenUpdate opts d j s, aPrevScreens=map (screenUpdate opts d j) ss}