1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
|
{- |
Overview:
hledger-ui's UIState holds the currently active screen and any previously visited
screens (and their states).
The brick App delegates all event-handling and rendering
to the UIState's active screen.
Screens have their own screen state, render function, event handler, and app state
update function, so they have full control.
@
Brick.defaultMain brickapp st
where
brickapp :: App (UIState) V.Event
brickapp = App {
appLiftVtyEvent = id
, appStartEvent = return
, appAttrMap = const theme
, appChooseCursor = showFirstCursor
, appHandleEvent = \st ev -> sHandle (aScreen st) st ev
, appDraw = \st -> sDraw (aScreen st) st
}
st :: UIState
st = (sInit s) d
UIState{
aopts=uopts'
,ajournal=j
,aScreen=s
,aPrevScreens=prevscrs
,aMinibuffer=Nothing
}
@
-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE EmptyDataDeriving #-}
module Hledger.UI.UITypes where
-- import Control.Concurrent (threadDelay)
-- import GHC.IO (unsafePerformIO)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Brick.Widgets.List (List)
import Brick.Widgets.Edit (Editor)
import Lens.Micro.Platform (makeLenses)
import Text.Show.Functions ()
-- import the Show instance for functions. Warning, this also re-exports it
import Hledger
import Hledger.Cli (HasCliOpts(..))
import Hledger.UI.UIOptions
data AppEvent =
FileChange -- one of the Journal's files has been added/modified/removed
| DateChange Day Day -- the current date has changed since last checked (with the old and new values)
deriving (Eq, Show)
-- | hledger-ui's application state. This holds one or more stateful screens.
-- As you navigate through screens, the old ones are saved in a stack.
-- The app can be in one of several modes: normal screen operation,
-- showing a help dialog, entering data in the minibuffer etc.
data UIState = UIState {
-- unchanging:
astartupopts :: UIOpts -- ^ the command-line options and query arguments specified at program start
-- can change while program runs:
,aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect
,ajournal :: Journal -- ^ the journal being viewed (can change with --watch)
,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first (XXX silly, reverse these)
,aScreen :: Screen -- ^ the currently active screen
,aMode :: Mode -- ^ the currently active mode on the current screen
} deriving (Show)
-- | Any screen can be in one of several modes, which modifies
-- its rendering and event handling.
-- The mode resets to Normal when entering a new screen.
data Mode =
Normal
| Help
| Minibuffer Text (Editor String Name)
deriving (Show,Eq)
-- Ignore the editor when comparing Modes.
instance Eq (Editor l n) where _ == _ = True
-- Unique names required for brick widgets, viewports, cursor locations etc.
data Name =
HelpDialog
| MinibufferEditor
| MenuList
| AccountsViewport
| AccountsList
| RegisterViewport
| RegisterList
| TransactionEditor
deriving (Ord, Show, Eq)
-- Unique names for screens the user can navigate to from the menu.
data ScreenName =
Accounts
| CashScreen
| Balancesheet
| Incomestatement
deriving (Ord, Show, Eq)
----------------------------------------------------------------------------------------------------
-- | hledger-ui screen types, v1, "one screen = one module"
-- These types aimed for maximum decoupling of modules and ease of adding more screens.
-- A new screen requires
-- 1. a new constructor in the Screen type,
-- 2. a new module implementing init/draw/handle functions,
-- 3. a call from any other screen which enters it.
-- Each screen type has generically named initialisation, draw, and event handling functions,
-- and zero or more uniquely named screen state fields, which hold the data for a particular
-- instance of this screen. Note the latter create partial functions, which means that some invalid
-- cases need to be handled, and also that their lenses are traversals, not single-value getters.
-- data Screen =
-- AccountsScreen {
-- sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state
-- ,sDraw :: UIState -> [Widget Name] -- ^ brick renderer for this screen
-- ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState () -- ^ brick event handler for this screen
-- -- state fields.These ones have lenses:
-- ,_asList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
-- ,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "")
-- }
-- | RegisterScreen {
-- sInit :: Day -> Bool -> UIState -> UIState
-- ,sDraw :: UIState -> [Widget Name]
-- ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
-- --
-- ,rsList :: List Name RegisterScreenItem -- ^ list widget showing transactions affecting this account
-- ,rsAccount :: AccountName -- ^ the account this register is for
-- ,rsForceInclusive :: Bool -- ^ should this register always include subaccount transactions,
-- -- even when in flat mode ? (ie because entered from a
-- -- depth-clipped accounts screen item)
-- }
-- | TransactionScreen {
-- sInit :: Day -> Bool -> UIState -> UIState
-- ,sDraw :: UIState -> [Widget Name]
-- ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
-- --
-- ,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list
-- ,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through
-- ,tsAccount :: AccountName -- ^ the account whose register we entered this screen from
-- }
-- | ErrorScreen {
-- sInit :: Day -> Bool -> UIState -> UIState
-- ,sDraw :: UIState -> [Widget Name]
-- ,sHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
-- --
-- ,esError :: String -- ^ error message to show
-- }
-- deriving (Show)
----------------------------------------------------------------------------------------------------
-- | hledger-ui screen types, v2, "more parts, but simpler parts"
-- These types aim to be more restrictive, allowing fewer invalid states, and easier to inspect
-- and debug. The screen types store only state, not behaviour (functions), and there is no longer
-- a circular dependency between UIState and Screen.
-- A new screen requires
-- 1. a new constructor in the Screen type
-- 2. a new screen state type if needed
-- 3. a new case in toAccountsLikeScreen if needed
-- 4. new cases in the uiDraw and uiHandle functions
-- 5. new constructor and updater functions in UIScreens, and a new case in screenUpdate
-- 6. a new module implementing draw and event-handling functions
-- 7. a call from any other screen which enters it (eg the menu screen, a new case in msEnterScreen)
-- 8. if it appears on the main menu: a new menu item in msNew
-- cf https://github.com/jtdaugherty/brick/issues/379#issuecomment-1192000374
-- | The various screens which a user can navigate to in hledger-ui,
-- along with any screen-specific parameters or data influencing what they display.
-- (The separate state types add code noise but seem to reduce partial code/invalid data a bit.)
data Screen =
MS MenuScreenState
| AS AccountsScreenState
| CS AccountsScreenState
| BS AccountsScreenState
| IS AccountsScreenState
| RS RegisterScreenState
| TS TransactionScreenState
| ES ErrorScreenState
deriving (Show)
-- | A subset of the screens which reuse the account screen's state and logic.
-- Such Screens can be converted to and from this more restrictive type
-- for cleaner code.
data AccountsLikeScreen = ALS (AccountsScreenState -> Screen) AccountsScreenState
deriving (Show)
toAccountsLikeScreen :: Screen -> Maybe AccountsLikeScreen
toAccountsLikeScreen scr = case scr of
AS ass -> Just $ ALS AS ass
CS ass -> Just $ ALS CS ass
BS ass -> Just $ ALS BS ass
IS ass -> Just $ ALS IS ass
_ -> Nothing
fromAccountsLikeScreen :: AccountsLikeScreen -> Screen
fromAccountsLikeScreen (ALS scons ass) = scons ass
data MenuScreenState = MSS {
-- view data:
_mssList :: List Name MenuScreenItem -- ^ list widget showing screen names
,_mssUnused :: () -- ^ dummy field to silence warning
} deriving (Show)
-- Used for the accounts screen and similar screens.
data AccountsScreenState = ASS {
-- screen parameters:
_assSelectedAccount :: AccountName -- ^ a copy of the account name from the list's selected item (or "")
-- view data derived from options, reporting date, journal, and screen parameters:
,_assList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
} deriving (Show)
data RegisterScreenState = RSS {
-- screen parameters:
_rssAccount :: AccountName -- ^ the account this register is for
,_rssForceInclusive :: Bool -- ^ should this register always include subaccount transactions,
-- even when in flat mode ? (ie because entered from a
-- depth-clipped accounts screen item)
-- view data derived from options, reporting date, journal, and screen parameters:
,_rssList :: List Name RegisterScreenItem -- ^ list widget showing transactions affecting this account
} deriving (Show)
data TransactionScreenState = TSS {
-- screen parameters:
_tssAccount :: AccountName -- ^ the account whose register we entered this screen from
,_tssTransactions :: [NumberedTransaction] -- ^ the transactions in that register, which we can step through
,_tssTransaction :: NumberedTransaction -- ^ the currently displayed transaction, and its position in the list
} deriving (Show)
data ErrorScreenState = ESS {
-- screen parameters:
_essError :: String -- ^ error message to show
,_essUnused :: () -- ^ dummy field to silence warning
} deriving (Show)
-- | An item in the menu screen's list of screens.
data MenuScreenItem = MenuScreenItem {
msItemScreenName :: Text -- ^ screen display name
,msItemScreen :: ScreenName -- ^ an internal name we can use to find the corresponding screen
} deriving (Show)
-- | An item in the accounts screen's list of accounts and balances.
data AccountsScreenItem = AccountsScreenItem {
asItemIndentLevel :: Int -- ^ indent level
,asItemAccountName :: AccountName -- ^ full account name
,asItemDisplayAccountName :: AccountName -- ^ full or short account name to display
,asItemMixedAmount :: Maybe MixedAmount -- ^ mixed amount to display
} deriving (Show)
-- | An item in the register screen's list of transactions in the current account.
data RegisterScreenItem = RegisterScreenItem {
rsItemDate :: Text -- ^ date
,rsItemStatus :: Status -- ^ transaction status
,rsItemDescription :: Text -- ^ description
,rsItemOtherAccounts :: Text -- ^ other accounts
,rsItemChangeAmount :: WideBuilder -- ^ the change to the current account from this transaction
,rsItemBalanceAmount :: WideBuilder -- ^ the balance or running total after this transaction
,rsItemTransaction :: Transaction -- ^ the full transaction
}
deriving (Show)
type NumberedTransaction = (Integer, Transaction)
-- These TH calls must come after most of the types above.
-- Fields named _foo produce lenses named foo.
-- XXX foo fields producing fooL lenses would be preferable
makeLenses ''MenuScreenState
makeLenses ''AccountsScreenState
makeLenses ''RegisterScreenState
makeLenses ''TransactionScreenState
makeLenses ''ErrorScreenState
----------------------------------------------------------------------------------------------------
-- | Error message to use in case statements adapting to the different Screen shapes.
errorWrongScreenType :: String -> a
errorWrongScreenType lbl =
-- unsafePerformIO $ threadDelay 2000000 >> -- delay to allow console output to be seen
error' (unwords [lbl, "called with wrong screen type, should not happen"])
-- dummy monoid instance needed make lenses work with List fields not common across constructors
--instance Monoid (List n a)
-- where
-- mempty = list "" V.empty 1 -- XXX problem in 0.7, every list requires a unique Name
-- mappend l1 l = l1 & listElementsL .~ (l1^.listElementsL <> l^.listElementsL)
uioptslens f ui = (\x -> ui{aopts=x}) <$> f (aopts ui)
instance HasCliOpts UIState where
cliOpts = uioptslens.cliOpts
instance HasInputOpts UIState where
inputOpts = uioptslens.inputOpts
instance HasBalancingOpts UIState where
balancingOpts = uioptslens.balancingOpts
instance HasReportSpec UIState where
reportSpec = uioptslens.reportSpec
instance HasReportOptsNoUpdate UIState where
reportOptsNoUpdate = uioptslens.reportOptsNoUpdate
instance HasReportOpts UIState where
reportOpts = uioptslens.reportOpts
|