{- | 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasReportOpts a => ReportableLens' a [Status]
statuses (Status -> [Status] -> [Status]
toggleStatus1 Status
Unmarked)

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

-- | Toggle between showing only cleared items or all items.
toggleCleared :: UIState -> UIState
toggleCleared :: UIState -> UIState
toggleCleared = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasReportOpts a => ReportableLens' a [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 | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Status]
ss forall a. Eq a => a -> a -> Bool
== Int
numstatusesforall a. Num a => a -> a -> a
-Int
1
      -> forall a b. (a -> b) -> [a] -> [b]
map ((String
"not "forall a. [a] -> [a] -> [a]
++)forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
showstatus) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. (Bounded a, Enum a, Eq a) => [a] -> [a]
complement [Status]
ss  -- should be just one
    Maybe Int
_ -> forall a b. (a -> b) -> [a] -> [b]
map Status -> String
showstatus forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort [Status]
ss
  where
    numstatuses :: Int
numstatuses = forall (t :: * -> *) a. Foldable t => t a -> Int
length [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound::Status]
    style :: Maybe Int
style = String -> RawOpts -> Maybe Int
maybeposintopt String
"status-toggles" 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 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 = ([forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound] 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasReportOptsNoUpdate c => Lens' c Bool
empty__ Bool -> Bool
not

-- | Toggle between showing the primary amounts or costs.
toggleConversionOp :: UIState -> UIState
toggleConversionOp :: UIState -> UIState
toggleConversionOp = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasReportOptsNoUpdate c => Lens' c (Maybe ConversionOp)
conversionop Maybe ConversionOp -> Maybe ConversionOp
toggleCostMode
  where
    toggleCostMode :: Maybe ConversionOp -> Maybe ConversionOp
toggleCostMode Maybe ConversionOp
Nothing               = forall a. a -> Maybe a
Just ConversionOp
ToCost
    toggleCostMode (Just ConversionOp
NoConversionOp) = forall a. a -> Maybe a
Just ConversionOp
ToCost
    toggleCostMode (Just ConversionOp
ToCost)         = 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasReportOptsNoUpdate c => Lens' c (Maybe ValuationType)
value (forall {a}. Maybe ValuationType -> Maybe a -> Maybe ValuationType
valuationToggleValue Maybe ValuationType
mstartupvaluation0) UIState
ui
  where
    mstartupvaluation0 :: Maybe ValuationType
mstartupvaluation0 = ReportOpts -> Maybe ValuationType
value_ forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ forall a b. (a -> b) -> a -> b
$ UIOpts -> CliOpts
uoCliOpts forall a b. (a -> b) -> a -> b
$ UIState -> UIOpts
astartupopts UIState
ui
    mdefvaluation :: Maybe ValuationType
mdefvaluation = forall a. a -> Maybe a
Just (Maybe CommoditySymbol -> ValuationType
AtEnd 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
_) = forall a. Maybe a
Nothing
    valuationToggleValue Maybe ValuationType
mstartupvaluation Maybe a
Nothing  = Maybe ValuationType
mstartupvaluation
    valuationToggleValue Maybe ValuationType
_                 (Just a
_) = forall a. Maybe a
Nothing

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

-- | Set flat account list mode.
setList :: UIState -> UIState
setList :: UIState -> UIState
setList = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportOptsNoUpdate c => Lens' c 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasReportOptsNoUpdate c => Lens' c 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasReportOptsNoUpdate c => Lens' c 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 = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
forecast Maybe DateSpan
newForecast UIState
ui
  where
    newForecast :: Maybe DateSpan
newForecast = case UIState
uiforall s a. s -> Getting a s a -> a
^.forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
forecast of
      Just DateSpan
_  -> forall a. Maybe a
Nothing
      Maybe DateSpan
Nothing -> UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod UIState
ui (UIState
uiforall s a. s -> Getting a s a -> a
^.forall c. HasCliOpts c => Lens' c CliOpts
cliOpts) forall s a. s -> Getting a s a -> a
^. forall c. HasInputOpts c => Lens' c (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 = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
forecast Maybe DateSpan
mforecast CliOpts
copts
  where
    mforecast :: Maybe DateSpan
mforecast = 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 forall s a. s -> Getting a s a -> a
^. forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
forecast
        mstartupforecastperiod :: Maybe DateSpan
mstartupforecastperiod  = UIState -> UIOpts
astartupopts UIState
ui forall s a. s -> Getting a s a -> a
^. forall c. HasInputOpts c => Lens' c (Maybe DateSpan)
forecast
        mdefaultforecastperiod :: Maybe DateSpan
mdefaultforecastperiod  = 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 = forall b a. b -> Either a b -> b
fromRight forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither forall a. HasReportOpts a => ReportableLens' a Bool
real Bool -> Bool
not  -- PARTIAL:
  where err :: a
err = 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasBalancingOpts c => Lens' c 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 = (forall s a. s -> Getting a s a -> a
^.forall a. HasReportOpts a => ReportableLens' a Period
period)

-- | Set the report period.
setReportPeriod :: Period -> UIState -> UIState
setReportPeriod :: Period -> UIState -> UIState
setReportPeriod Period
p = (Period -> Period) -> UIState -> UIState
updateReportPeriod (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 = forall b a. b -> Either a b -> b
fromRight forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e b s t.
((a -> Either e b) -> s -> Either e t)
-> (a -> b) -> s -> Either e t
overEither forall a. HasReportOpts a => ReportableLens' a Period
period Period -> Period
updatePeriod  -- PARTIAL:
  where err :: a
err = 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 = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const String
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e b s t.
((a -> Either e b) -> s -> Either e t) -> b -> s -> Either e t
setEither forall a. HasReportOpts a => ReportableLens' a [CommoditySymbol]
querystring ([CommoditySymbol] -> CommoditySymbol -> [CommoditySymbol]
words'' [CommoditySymbol]
queryprefixes forall a b. (a -> b) -> a -> b
$ String -> CommoditySymbol
T.pack String
s)

-- | Reset some filters & toggles.
resetFilter :: UIState -> UIState
resetFilter :: UIState -> UIState
resetFilter = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportOptsNoUpdate c => Lens' c [CommoditySymbol]
querystringNoUpdate [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportOptsNoUpdate c => Lens' c Bool
realNoUpdate Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportOptsNoUpdate c => Lens' c [Status]
statusesNoUpdate []
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportOptsNoUpdate c => Lens' c Bool
empty__ Bool
True  -- set period PeriodAll
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportSpec c => Lens' c Query
rsQuery Query
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasReportSpec c => Lens' c [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 (forall a b. a -> b -> a
const 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} = forall a. Max a -> a
getMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Max a
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Int
accountNameLevel) 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) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 (Int
dforall a. Num a => a -> a -> a
-Int
1)
    dec Maybe Int
Nothing  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UIState -> Int
maxDepth UIState
ui 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 (forall a b. a -> b -> a
const Maybe Int
mdepth)

getDepth :: UIState -> Maybe Int
getDepth :: UIState -> Maybe Int
getDepth = (forall s a. s -> Getting a s a -> a
^.forall a. HasReportOpts a => ReportableLens' a (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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall c. HasReportSpec c => Lens' c ReportSpec
reportSpec ReportSpec -> ReportSpec
update UIState
ui
  where
    update :: ReportSpec -> ReportSpec
update = forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => String -> a
error String
"updateReportDepth: updating depth should not result in an error")  -- PARTIAL:
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReportOpts -> ReportOpts)
-> ReportSpec -> Either String ReportSpec
updateReportSpecWith (\ReportOpts
ropts -> ReportOpts
ropts{depth_ :: Maybe Int
depth_=Maybe Int -> Maybe Int
updateDepth (ReportOpts -> Maybe Int
depth_ ReportOpts
ropts) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReportOpts -> Int -> Maybe Int
clipDepth ReportOpts
ropts})
    clipDepth :: ReportOpts -> Int -> Maybe Int
clipDepth ReportOpts
ropts Int
d | Int
d forall a. Ord a => a -> a -> Bool
< Int
0            = ReportOpts -> Maybe Int
depth_ ReportOpts
ropts
                      | Int
d forall a. Ord a => a -> a -> Bool
>= UIState -> Int
maxDepth UIState
ui = forall a. Maybe a
Nothing
                      | Bool
otherwise        = 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 = forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL forall a b. (a -> b) -> a -> b
$ forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor Name
MinibufferEditor (forall a. a -> Maybe a
Just Int
1) String
oldq
    oldq :: String
oldq = forall a. a -> Maybe a -> a
fromMaybe (CommoditySymbol -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommoditySymbol] -> CommoditySymbol
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CommoditySymbol -> CommoditySymbol
textQuoteIfNeeded forall a b. (a -> b) -> a -> b
$ UIState
uiforall s a. s -> Getting a s a -> a
^.forall a. HasReportOpts a => ReportableLens' a [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 :: Mode
aMode=Mode
m}

pushScreen :: Screen -> UIState -> UIState
pushScreen :: Screen -> UIState -> UIState
pushScreen Screen
scr UIState
ui = UIState
ui{aPrevScreens :: [Screen]
aPrevScreens=(UIState -> Screen
aScreen UIState
uiforall a. a -> [a] -> [a]
:UIState -> [Screen]
aPrevScreens UIState
ui)
                      ,aScreen :: Screen
aScreen=Screen
scr
                      }

popScreen :: UIState -> UIState
popScreen :: UIState -> UIState
popScreen ui :: UIState
ui@UIState{aPrevScreens :: UIState -> [Screen]
aPrevScreens=Screen
s:[Screen]
ss} = UIState
ui{aScreen :: Screen
aScreen=Screen
s, aPrevScreens :: [Screen]
aPrevScreens=[Screen]
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 :: UIOpts
aopts=UIOpts
origopts, aPrevScreens :: [Screen]
aPrevScreens=[], aScreen :: Screen
aScreen=Screen
topscreen', aMode :: Mode
aMode=Mode
Normal}
  where
    topscreen' :: Screen
topscreen' = UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate UIOpts
origopts Day
d Journal
j forall a b. (a -> b) -> a -> b
$ 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 :: Journal
ajournal=Journal
j, aScreen :: Screen
aScreen=UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate UIOpts
opts Day
d Journal
j Screen
s, aPrevScreens :: [Screen]
aPrevScreens=forall a b. (a -> b) -> [a] -> [b]
map (UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate UIOpts
opts Day
d Journal
j) [Screen]
ss}