slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: refactor, simplify, flatten screen types

Browse Source
This commit is contained in:
Simon Michael 2016-06-08 23:45:26 -07:00
parent e6b1d2d5a7
commit 8bda78a447
7 changed files with 281 additions and 306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

164
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -5,12 +5,11 @@
module Hledger.UI.AccountsScreen module Hledger.UI.AccountsScreen
(accountsScreen (accountsScreen
,initAccountsScreen ,asInit
,asSetSelectedAccount ,asSetSelectedAccount
) )
where where
import Lens.Micro ((^.))
-- import Control.Monad -- import Control.Monad
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
-- import Data.Default -- import Data.Default
@ -28,7 +27,7 @@ import Brick.Widgets.List
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Brick.Widgets.Border (borderAttr) import Brick.Widgets.Border (borderAttr)
-- import Brick.Widgets.Center -- import Brick.Widgets.Center
import Lens.Micro ((.~), (&)) import Lens.Micro
import Hledger import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green) import Hledger.Cli hiding (progname,prognameandversion,green)
@ -42,24 +41,20 @@ import Hledger.UI.ErrorScreen
accountsScreen :: Screen accountsScreen :: Screen
accountsScreen = AccountsScreen{ accountsScreen = AccountsScreen{
_asState = AccountsScreenState{_asItems=list "accounts" V.empty 1 sInit = asInit
,_asSelectedAccount="" ,sDraw = asDraw
} ,sHandle = asHandle
,sInitFn = initAccountsScreen ,_asList = list "accounts" V.empty 1
,sDrawFn = drawAccountsScreen ,_asSelectedAccount = ""
,sHandleFn = handleAccountsScreen
} }
asSetSelectedAccount a s@AccountsScreen{} = s & asState . asSelectedAccount .~ a asInit :: Day -> Bool -> AppState -> AppState
asSetSelectedAccount _ s = s asInit d reset st@AppState{
initAccountsScreen :: Day -> Bool -> AppState -> AppState
initAccountsScreen d reset st@AppState{
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
ajournal=j, ajournal=j,
aScreen=s@AccountsScreen{} aScreen=s@AccountsScreen{}
} = } =
st{aopts=uopts', aScreen=s & asState . asItems .~ newitems'} st{aopts=uopts', aScreen=s & asList .~ newitems'}
where where
newitems = list (Name "accounts") (V.fromList displayitems) 1 newitems = list (Name "accounts") (V.fromList displayitems) 1
@ -67,7 +62,7 @@ initAccountsScreen d reset st@AppState{
-- (may need to move to the next leaf account when entering flat mode) -- (may need to move to the next leaf account when entering flat mode)
newitems' = listMoveTo selidx newitems newitems' = listMoveTo selidx newitems
where where
selidx = case (reset, listSelectedElement $ s ^. asState . asItems) of selidx = case (reset, listSelectedElement $ s ^. asList) of
(True, _) -> 0 (True, _) -> 0
(_, Nothing) -> 0 (_, Nothing) -> 0
(_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch (_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch
@ -104,10 +99,10 @@ initAccountsScreen d reset st@AppState{
displayitems = map displayitem items displayitems = map displayitem items
initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen" asInit _ _ _ = error "init function called with wrong screen type, should not happen"
drawAccountsScreen :: AppState -> [Widget] asDraw :: AppState -> [Widget]
drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
,aScreen=s@AccountsScreen{} ,aScreen=s@AccountsScreen{}
,aMinibuffer=mbuf} = ,aMinibuffer=mbuf} =
@ -142,10 +137,10 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns"
nonzero | empty_ ropts = str "" nonzero | empty_ ropts = str ""
| otherwise = withAttr (borderAttr <> "query") (str " nonzero") | otherwise = withAttr (borderAttr <> "query") (str " nonzero")
cur = str (case s ^. asState . asItems ^. listSelectedL of -- XXX second ^. required here but not below.. cur = str (case s ^. asList ^. listSelectedL of -- XXX second ^. required here but not below..
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1)) Just i -> show (i + 1))
total = str $ show $ V.length $ s ^. asState . asItems . listElementsL total = str $ show $ V.length $ s ^. asList . listElementsL
bottomlabel = borderKeysStr [ bottomlabel = borderKeysStr [
-- ("up/down/pgup/pgdown/home/end", "move") -- ("up/down/pgup/pgdown/home/end", "move")
@ -174,7 +169,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-- ltrace "availwidth" $ -- ltrace "availwidth" $
c^.availWidthL c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = s ^. asState . asItems . listElementsL displayitems = s ^. asList . listElementsL
maxacctwidthseen = maxacctwidthseen =
-- ltrace "maxacctwidthseen" $ -- ltrace "maxacctwidthseen" $
V.maximum $ V.maximum $
@ -202,12 +197,12 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
colwidths = (acctwidth, balwidth) colwidths = (acctwidth, balwidth)
render $ defaultLayout toplabel bottomarea $ renderList (s ^. asState . asItems) (drawAccountsItem colwidths) render $ defaultLayout toplabel bottomarea $ renderList (s ^. asList) (asDrawItem colwidths)
drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen" asDraw _ = error "draw function called with wrong screen type, should not happen"
drawAccountsItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget
drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} = asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
-- c <- getContext -- c <- getContext
-- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
@ -233,8 +228,8 @@ drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
sel | selected = (<> "selected") sel | selected = (<> "selected")
| otherwise = id | otherwise = id
handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) asHandle :: AppState -> Vty.Event -> EventM (Next AppState)
handleAccountsScreen st@AppState{ asHandle st'@AppState{
aScreen=scr@AccountsScreen{..} aScreen=scr@AccountsScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
@ -245,55 +240,52 @@ handleAccountsScreen st@AppState{
-- let h = c^.availHeightL -- let h = c^.availHeightL
-- moveSel n l = listMoveBy n l -- moveSel n l = listMoveBy n l
-- before we go anywhere, remember the currently selected account. -- save the currently selected account, in case we leave this screen and lose the selection
-- (This is preserved across screen changes, unlike List's selection state)
let let
selacct = case listSelectedElement $ scr ^. asState . asItems of selacct = case listSelectedElement $ scr ^. asList of
Just (_, AccountsScreenItem{..}) -> asItemAccountName Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> scr ^. asState . asSelectedAccount Nothing -> scr ^. asSelectedAccount
st' = st{aScreen=scr & asState . asSelectedAccount .~ selacct} st = st'{aScreen=scr & asSelectedAccount .~ selacct}
case mbuf of case mbuf of
Nothing -> Nothing ->
case ev of case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st' Vty.EvKey (Vty.KChar 'q') [] -> halt st
-- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do -- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st' Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st
Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st') >>= continue Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue
Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st' Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st
Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st' Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st
Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st' Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st
Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st' Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st
Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st' Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st
Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st' Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st
Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st' Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st
Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st' Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st
Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st' Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st
Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st' Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st
Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st' Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st
Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st' Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st
Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st' Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st
Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st' Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st
Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st') Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st') Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st)
Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st') Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st)
Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st') Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st)
Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st' Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st
Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st') Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st)
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st' Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> scrollTopRegister >> continue (screenEnter d scr st)
let where
scr = rsSetCurrentAccount selacct registerScreen scr = rsSetAccount selacct registerScreen
st'' = screenEnter d scr st'
scrollTopRegister
continue st''
-- fall through to the list's event handler (handles up/down) -- fall through to the list's event handler (handles up/down)
ev -> do ev -> do
newitems <- handleEvent ev (scr ^. asState . asItems) newitems <- handleEvent ev (scr ^. asList)
continue $ st'{aScreen=scr & asState . asItems .~ newitems continue $ st'{aScreen=scr & asList .~ newitems
& asState . asSelectedAccount .~ selacct} & asSelectedAccount .~ selacct
}
-- continue =<< handleEventLensed st' someLens ev -- continue =<< handleEventLensed st' someLens ev
Just ed -> Just ed ->
@ -313,42 +305,8 @@ handleAccountsScreen st@AppState{
scrollTop = vScrollToBeginning $ viewportScroll "accounts" scrollTop = vScrollToBeginning $ viewportScroll "accounts"
scrollTopRegister = vScrollToBeginning $ viewportScroll "register" scrollTopRegister = vScrollToBeginning $ viewportScroll "register"
handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen" asHandle _ _ = error "event handler called with wrong screen type, should not happen"
-- | Get the maximum account depth in the current journal. asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
maxDepth :: AppState -> Int asSetSelectedAccount _ s = s
maxDepth AppState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames 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 :: AppState -> AppState
decDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}}
where
dec (Just d) = Just $ max 0 (d-1)
dec Nothing = Just $ maxDepth st - 1
-- | Increment the current depth limit. If this makes it equal to the
-- the maximum account depth, remove the depth limit.
incDepth :: AppState -> AppState
incDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}}
where
inc (Just d) | d < (maxDepth st - 1) = Just $ d+1
inc _ = Nothing
-- | Set the current depth limit to the specified depth, which should
-- be a positive number. If it is zero, or equal to or greater than the
-- current maximum account depth, the depth limit will be removed.
-- (Slight inconsistency here: zero is currently a valid display depth
-- which can be reached using the - key. But we need a key to remove
-- the depth limit, and 0 is it.)
setDepth :: Int -> AppState -> AppState
setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}}
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}}
where
mdepth' | depth < 0 = depth_ ropts
| depth == 0 = Nothing
| depth >= maxDepth st = Nothing
| otherwise = Just depth

34
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -30,19 +30,19 @@ import Hledger.UI.UIUtils
errorScreen :: Screen errorScreen :: Screen
errorScreen = ErrorScreen{ errorScreen = ErrorScreen{
esState = ErrorScreenState{esError=""} sInit = esInit
,sInitFn = initErrorScreen ,sDraw = esDraw
,sDrawFn = drawErrorScreen ,sHandle = esHandle
,sHandleFn = handleErrorScreen ,esError = ""
} }
initErrorScreen :: Day -> Bool -> AppState -> AppState esInit :: Day -> Bool -> AppState -> AppState
initErrorScreen _ _ st@AppState{aScreen=ErrorScreen{}} = st esInit _ _ st@AppState{aScreen=ErrorScreen{}} = st
initErrorScreen _ _ _ = error "init function called with wrong screen type, should not happen" esInit _ _ _ = error "init function called with wrong screen type, should not happen"
drawErrorScreen :: AppState -> [Widget] esDraw :: AppState -> [Widget]
drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
aScreen=ErrorScreen{esState=ErrorScreenState{..}}} = [ui] aScreen=ErrorScreen{..}} = [ui]
where where
toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload") toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload")
-- <+> str " transactions" -- <+> str " transactions"
@ -77,7 +77,7 @@ drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto
render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError
drawErrorScreen _ = error "draw function called with wrong screen type, should not happen" esDraw _ = error "draw function called with wrong screen type, should not happen"
-- drawErrorItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget -- drawErrorItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget
-- drawErrorItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) = -- drawErrorItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) =
@ -100,9 +100,9 @@ drawErrorScreen _ = error "draw function called with wrong screen type, should n
-- sel | selected = (<> "selected") -- sel | selected = (<> "selected")
-- | otherwise = id -- | otherwise = id
handleErrorScreen :: AppState -> Vty.Event -> EventM (Next AppState) esHandle :: AppState -> Vty.Event -> EventM (Next AppState)
handleErrorScreen st@AppState{ esHandle st@AppState{
aScreen=s@ErrorScreen{esState=_err} aScreen=s@ErrorScreen{}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
} e = do } e = do
@ -114,7 +114,7 @@ handleErrorScreen st@AppState{
Vty.EvKey (Vty.KChar 'g') [] -> do Vty.EvKey (Vty.KChar 'g') [] -> do
(ej, _) <- liftIO $ journalReloadIfChanged copts d j (ej, _) <- liftIO $ journalReloadIfChanged copts d j
case ej of case ej of
Left err -> continue st{aScreen=s{esState=ErrorScreenState{esError=err}}} -- show latest parse error Left err -> continue st{aScreen=s{esError=err}} -- show latest parse error
Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it
-- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st -- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
@ -124,7 +124,7 @@ handleErrorScreen st@AppState{
-- is' <- handleEvent ev is -- is' <- handleEvent ev is
-- continue st{aScreen=s{rsState=is'}} -- continue st{aScreen=s{rsState=is'}}
-- continue =<< handleEventLensed st someLens e -- continue =<< handleEventLensed st someLens e
handleErrorScreen _ _ = error "event handler called with wrong screen type, should not happen" esHandle _ _ = error "event handler called with wrong screen type, should not happen"
-- If journal file(s) have changed, reload the journal and regenerate all screens. -- If journal file(s) have changed, reload the journal and regenerate all screens.
-- This is here so it can reference the error screen. -- This is here so it can reference the error screen.
@ -133,5 +133,5 @@ stReloadJournalIfChanged copts d j st = do
(ej, _) <- journalReloadIfChanged copts d j (ej, _) <- journalReloadIfChanged copts d j
return $ case ej of return $ case ej of
Right j' -> regenerateScreens j' d st Right j' -> regenerateScreens j' d st
Left err -> screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st Left err -> screenEnter d errorScreen{esError=err} st

10
hledger-ui/Hledger/UI/Main.hs
View File

@ -101,7 +101,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
-- with --register, start on the register screen, and also put -- with --register, start on the register screen, and also put
-- the accounts screen on the prev screens stack so you can exit -- the accounts screen on the prev screens stack so you can exit
-- to that as usual. -- to that as usual.
Just apat -> (rsSetCurrentAccount acct registerScreen, [ascr']) Just apat -> (rsSetAccount acct registerScreen, [ascr'])
where where
acct = headDef acct = headDef
(error' $ "--register "++apat++" did not match any account") (error' $ "--register "++apat++" did not match any account")
@ -109,7 +109,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
-- Initialising the accounts screen is awkward, requiring -- Initialising the accounts screen is awkward, requiring
-- another temporary AppState value.. -- another temporary AppState value..
ascr' = aScreen $ ascr' = aScreen $
initAccountsScreen d True $ asInit d True $
AppState{ AppState{
aopts=uopts' aopts=uopts'
,ajournal=j ,ajournal=j
@ -118,7 +118,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
,aMinibuffer=Nothing ,aMinibuffer=Nothing
} }
st = (sInitFn scr) d True st = (sInit scr) d True
AppState{ AppState{
aopts=uopts' aopts=uopts'
,ajournal=j ,ajournal=j
@ -133,8 +133,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
, appStartEvent = return , appStartEvent = return
, appAttrMap = const theme , appAttrMap = const theme
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
, appHandleEvent = \st ev -> sHandleFn (aScreen st) st ev , appHandleEvent = \st ev -> sHandle (aScreen st) st ev
, appDraw = \st -> sDrawFn (aScreen st) st , appDraw = \st -> sDraw (aScreen st) st
-- XXX bizarro. removing the st arg and parameter above, -- XXX bizarro. removing the st arg and parameter above,
-- which according to GHCI does not change the type, -- which according to GHCI does not change the type,
-- causes "Exception: draw function called with wrong screen type" -- causes "Exception: draw function called with wrong screen type"

72
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -4,7 +4,7 @@
module Hledger.UI.RegisterScreen module Hledger.UI.RegisterScreen
(registerScreen (registerScreen
,rsSetCurrentAccount ,rsSetAccount
) )
where where
@ -37,20 +37,19 @@ import Hledger.UI.ErrorScreen
registerScreen :: Screen registerScreen :: Screen
registerScreen = RegisterScreen{ registerScreen = RegisterScreen{
rsState = RegisterScreenState{rsItems=list "register" V.empty 1 sInit = rsInit
,rsSelectedAccount="" ,sDraw = rsDraw
} ,sHandle = rsHandle
,sInitFn = initRegisterScreen ,rsList = list "register" V.empty 1
,sDrawFn = drawRegisterScreen ,rsAccount = ""
,sHandleFn = handleRegisterScreen
} }
rsSetCurrentAccount a scr@RegisterScreen{..} = scr{rsState=rsState{rsSelectedAccount=a}} rsSetAccount a scr@RegisterScreen{} = scr{rsAccount=a}
rsSetCurrentAccount _ scr = scr rsSetAccount _ scr = scr
initRegisterScreen :: Day -> Bool -> AppState -> AppState rsInit :: Day -> Bool -> AppState -> AppState
initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}} = rsInit d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{..}} =
st{aScreen=s{rsState=rsState{rsItems=newitems'}}} st{aScreen=s{rsList=newitems'}}
where where
-- gather arguments and queries -- gather arguments and queries
ropts = (reportopts_ $ cliopts_ opts) ropts = (reportopts_ $ cliopts_ opts)
@ -59,7 +58,7 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
balancetype_=HistoricalBalance balancetype_=HistoricalBalance
} }
-- XXX temp -- XXX temp
thisacctq = Acct $ accountNameToAccountRegex rsSelectedAccount -- includes subs thisacctq = Acct $ accountNameToAccountRegex rsAccount -- includes subs
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts
(_label,items) = accountTransactionsReport ropts j q thisacctq (_label,items) = accountTransactionsReport ropts j q thisacctq
@ -89,22 +88,22 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
-- (eg after toggling nonzero mode), otherwise select the last element. -- (eg after toggling nonzero mode), otherwise select the last element.
newitems' = listMoveTo newselidx newitems newitems' = listMoveTo newselidx newitems
where where
newselidx = case (reset, listSelectedElement rsItems) of newselidx = case (reset, listSelectedElement rsList) of
(True, _) -> 0 (True, _) -> 0
(_, Nothing) -> endidx (_, Nothing) -> endidx
(_, Just (_,RegisterScreenItem{rsItemTransaction=Transaction{tindex=ti}})) (_, Just (_,RegisterScreenItem{rsItemTransaction=Transaction{tindex=ti}}))
-> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) displayitems -> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) displayitems
endidx = length displayitems endidx = length displayitems
initRegisterScreen _ _ _ = error "init function called with wrong screen type, should not happen" rsInit _ _ _ = error "init function called with wrong screen type, should not happen"
drawRegisterScreen :: AppState -> [Widget] rsDraw :: AppState -> [Widget]
drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=RegisterScreen{rsState=RegisterScreenState{..}} ,aScreen=RegisterScreen{..}
,aMinibuffer=mbuf} ,aMinibuffer=mbuf}
= [ui] = [ui]
where where
toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsSelectedAccount) toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount)
<+> togglefilters <+> togglefilters
<+> str " transactions" <+> str " transactions"
<+> borderQueryStr (query_ ropts) <+> borderQueryStr (query_ ropts)
@ -124,11 +123,11 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
] of ] of
[] -> str "" [] -> str ""
fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs) fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs)
cur = str $ case rsItems ^. listSelectedL of cur = str $ case rsList ^. listSelectedL of
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1) Just i -> show (i + 1)
total = str $ show $ length displayitems total = str $ show $ length displayitems
displayitems = V.toList $ rsItems ^. listElementsL displayitems = V.toList $ rsList ^. listElementsL
-- query = query_ $ reportopts_ $ cliopts_ opts -- query = query_ $ reportopts_ $ cliopts_ opts
@ -196,12 +195,12 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
Nothing -> bottomlabel Nothing -> bottomlabel
Just ed -> minibuffer ed Just ed -> minibuffer ed
render $ defaultLayout toplabel bottomarea $ renderList rsItems (drawRegisterItem colwidths) render $ defaultLayout toplabel bottomarea $ renderList rsList (rsDrawItem colwidths)
drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" rsDraw _ = error "draw function called with wrong screen type, should not happen"
drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget
drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
render $ render $
str (fitString (Just datewidth) (Just datewidth) True True rsItemDate) <+> str (fitString (Just datewidth) (Just datewidth) True True rsItemDate) <+>
@ -221,9 +220,9 @@ drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected
sel | selected = (<> "selected") sel | selected = (<> "selected")
| otherwise = id | otherwise = id
handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState) rsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
handleRegisterScreen st@AppState{ rsHandle st@AppState{
aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}} aScreen=s@RegisterScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
,aMinibuffer=mbuf ,aMinibuffer=mbuf
@ -245,22 +244,22 @@ handleRegisterScreen st@AppState{
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
case listSelectedElement rsItems of case listSelectedElement rsList of
Just (_, RegisterScreenItem{rsItemTransaction=t}) -> Just (_, RegisterScreenItem{rsItemTransaction=t}) ->
let let
ts = map rsItemTransaction $ V.toList $ listElements rsItems ts = map rsItemTransaction $ V.toList $ listElements rsList
numberedts = zip [1..] ts numberedts = zip [1..] ts
i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX
in in
continue $ screenEnter d transactionScreen{tsState=TransactionScreenState{tsTransaction=(i,t) continue $ screenEnter d transactionScreen{tsTransaction=(i,t)
,tsTransactions=numberedts ,tsTransactions=numberedts
,tsSelectedAccount=rsSelectedAccount}} st ,tsAccount=rsAccount} st
Nothing -> continue st Nothing -> continue st
-- fall through to the list's event handler (handles [pg]up/down) -- fall through to the list's event handler (handles [pg]up/down)
ev -> do ev -> do
newitems <- handleEvent ev rsItems newitems <- handleEvent ev rsList
continue st{aScreen=s{rsState=rsState{rsItems=newitems}}} continue st{aScreen=s{rsList=newitems}}
-- continue =<< handleEventLensed st someLens ev -- continue =<< handleEventLensed st someLens ev
Just ed -> Just ed ->
@ -275,4 +274,5 @@ handleRegisterScreen st@AppState{
-- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs) -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs)
scrollTop = vScrollToBeginning $ viewportScroll "register" scrollTop = vScrollToBeginning $ viewportScroll "register"
handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen" rsHandle _ _ = error "event handler called with wrong screen type, should not happen"

67
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -4,6 +4,7 @@
module Hledger.UI.TransactionScreen module Hledger.UI.TransactionScreen
(transactionScreen (transactionScreen
,rsSelect
) )
where where
@ -37,26 +38,26 @@ import Hledger.UI.ErrorScreen
transactionScreen :: Screen transactionScreen :: Screen
transactionScreen = TransactionScreen{ transactionScreen = TransactionScreen{
tsState = TransactionScreenState{tsTransaction=(1,nulltransaction) sInit = tsInit
,tsTransactions=[(1,nulltransaction)] ,sDraw = tsDraw
,tsSelectedAccount=""} ,sHandle = tsHandle
,sInitFn = initTransactionScreen ,tsTransaction = (1,nulltransaction)
,sDrawFn = drawTransactionScreen ,tsTransactions = [(1,nulltransaction)]
,sHandleFn = handleTransactionScreen ,tsAccount = ""
} }
initTransactionScreen :: Day -> Bool -> AppState -> AppState tsInit :: Day -> Bool -> AppState -> AppState
initTransactionScreen _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} tsInit _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
,ajournal=_j ,ajournal=_j
,aScreen=TransactionScreen{..}} = st ,aScreen=TransactionScreen{..}} = st
initTransactionScreen _ _ _ = error "init function called with wrong screen type, should not happen" tsInit _ _ _ = error "init function called with wrong screen type, should not happen"
drawTransactionScreen :: AppState -> [Widget] tsDraw :: AppState -> [Widget]
drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=TransactionScreen{ ,aScreen=TransactionScreen{
tsState=TransactionScreenState{tsTransaction=(i,t) tsTransaction=(i,t)
,tsTransactions=nts ,tsTransactions=nts
,tsSelectedAccount=acct}}} = ,tsAccount=acct}} =
[ui] [ui]
where where
-- datedesc = show (tdate t) ++ " " ++ tdescription t -- datedesc = show (tdate t) ++ " " ++ tdescription t
@ -96,13 +97,13 @@ drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
t t
drawTransactionScreen _ = error "draw function called with wrong screen type, should not happen" tsDraw _ = error "draw function called with wrong screen type, should not happen"
handleTransactionScreen :: AppState -> Vty.Event -> EventM (Next AppState) tsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
handleTransactionScreen tsHandle
st@AppState{aScreen=s@TransactionScreen{tsState=tsState@TransactionScreenState{tsTransaction=(i,t) st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
,tsTransactions=nts ,tsTransactions=nts
,tsSelectedAccount=acct}} ,tsAccount=acct}
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
} }
@ -121,7 +122,7 @@ handleTransactionScreen
case ej of case ej of
Right j' -> do Right j' -> do
-- got to redo the register screen's transactions report, to get the latest transactions list for this screen -- got to redo the register screen's transactions report, to get the latest transactions list for this screen
-- XXX duplicates initRegisterScreen -- XXX duplicates rsInit
let let
ropts' = ropts {depth_=Nothing ropts' = ropts {depth_=Nothing
,balancetype_=HistoricalBalance ,balancetype_=HistoricalBalance
@ -138,31 +139,31 @@ handleTransactionScreen
Nothing | null numberedts -> (0,nulltransaction) Nothing | null numberedts -> (0,nulltransaction)
| i > fst (last numberedts) -> last numberedts | i > fst (last numberedts) -> last numberedts
| otherwise -> head numberedts | otherwise -> head numberedts
st' = st{aScreen=s{tsState=TransactionScreenState{tsTransaction=(i',t') st' = st{aScreen=s{tsTransaction=(i',t')
,tsTransactions=numberedts ,tsTransactions=numberedts
,tsSelectedAccount=acct}}} ,tsAccount=acct}}
continue $ regenerateScreens j' d st' continue $ regenerateScreens j' d st'
Left err -> continue $ screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st Left err -> continue $ screenEnter d errorScreen{esError=err} st
-- if allowing toggling here, we should refresh the txn list from the parent register screen -- if allowing toggling here, we should refresh the txn list from the parent register screen
-- Vty.EvKey (Vty.KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st -- Vty.EvKey (Vty.KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st
-- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared st -- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared st
-- Vty.EvKey (Vty.KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal st -- Vty.EvKey (Vty.KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal st
Vty.EvKey (Vty.KUp) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=tsState{tsTransaction=(iprev,tprev)}}} Vty.EvKey (Vty.KUp) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(iprev,tprev)}}
Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=tsState{tsTransaction=(inext,tnext)}}} Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(inext,tnext)}}
Vty.EvKey (Vty.KLeft) [] -> continue st'' Vty.EvKey (Vty.KLeft) [] -> continue st''
where where
st'@AppState{aScreen=scr} = popScreen st st'@AppState{aScreen=scr} = popScreen st
st'' = st'{aScreen=rsSetSelectedTransaction (fromIntegral i) scr} st'' = st'{aScreen=rsSelect (fromIntegral i) scr}
_ev -> continue st _ev -> continue st
handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen" tsHandle _ _ = error "event handler called with wrong screen type, should not happen"
rsSetSelectedTransaction i scr@RegisterScreen{rsState=rsState@RegisterScreenState{..}} = scr{rsState=rsState{rsItems=l'}}
where l' = listMoveTo (i-1) rsItems
rsSetSelectedTransaction _ scr = scr
-- | Select the nth item on the register screen.
rsSelect i scr@RegisterScreen{..} = scr{rsList=l'}
where l' = listMoveTo (i-1) rsList
rsSelect _ scr = scr

123
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -1,9 +1,11 @@
{- | {- |
Overview: Overview:
hledger-ui's AppState holds the active screen and any previously visited screens. hledger-ui's AppState holds the currently active screen and any previously visited
Screens have their own render state, render function, event handler, screens (and their states).
and app state update function (which can update the whole AppState). The brick App delegates all event-handling and rendering
A brick App delegates event-handling and rendering to our AppState's active screen. to the AppState'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 Brick.defaultMain brickapp st
@ -14,15 +16,15 @@ Brick.defaultMain brickapp st
, appStartEvent = return , appStartEvent = return
, appAttrMap = const theme , appAttrMap = const theme
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
, appHandleEvent = \st ev -> sHandleFn (aScreen st) st ev , appHandleEvent = \st ev -> sHandle (aScreen st) st ev
, appDraw = \st -> sDrawFn (aScreen st) st , appDraw = \st -> sDraw (aScreen st) st
} }
st :: AppState st :: AppState
st = (sInitFn scr) d st = (sInit s) d
AppState{ AppState{
aopts=uopts' aopts=uopts'
,ajournal=j ,ajournal=j
,aScreen=scr ,aScreen=s
,aPrevScreens=prevscrs ,aPrevScreens=prevscrs
,aMinibuffer=Nothing ,aMinibuffer=Nothing
} }
@ -30,9 +32,9 @@ Brick.defaultMain brickapp st
-} -}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Hledger.UI.UITypes where module Hledger.UI.UITypes where
@ -51,63 +53,57 @@ import Text.Show.Functions ()
import Hledger import Hledger
import Hledger.UI.UIOptions import Hledger.UI.UIOptions
instance Show (List a) where show _ = "<List>"
instance Show Editor where show _ = "<Editor>"
-- | hledger-ui's application state. This holds one or more stateful screens. -- | hledger-ui's application state. This holds one or more stateful screens.
data AppState = AppState { data AppState = AppState {
aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect
,ajournal :: Journal -- ^ the journal being viewed ,ajournal :: Journal -- ^ the journal being viewed
,aScreen :: Screen -- ^ the currently active screen ,aScreen :: Screen -- ^ the currently active screen
,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first ,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first
,aMinibuffer :: Maybe Editor -- ^ a compact editor used for data entry, when active ,aMinibuffer :: Maybe Editor -- ^ a compact editor, when active, used for data entry on all screens
} deriving (Show) } deriving (Show)
-- | Types of screen available within hledger-ui. Each has its own -- | hledger-ui screen types & instances.
-- specific state type, and generic initialisation, event handling -- Each screen type has generically named initialisation, draw, and event handling functions,
-- and rendering functions. -- and zero or more uniquely named screen state fields, which hold the data for a particular
-- -- instance of this screen. The latter create partial functions, so take care.
-- Screen types are pattern-matched by their constructor and their
-- state field, which must have a unique name. This type causes
-- partial functions, so take care.
data Screen = data Screen =
AccountsScreen { AccountsScreen {
_asState :: AccountsScreenState sInit :: Day -> Bool -> AppState -> AppState -- ^ function to update the screen's state
,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change ,sDraw :: AppState -> [Widget] -- ^ brick renderer for this screen
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer for this screen ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen -- state fields. These ones have lenses:
,_asList :: List AccountsScreenItem -- ^ list widget showing account names & balances
,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "")
} }
| RegisterScreen { | RegisterScreen {
rsState :: RegisterScreenState sInit :: Day -> Bool -> AppState -> AppState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sDraw :: AppState -> [Widget]
,sDrawFn :: AppState -> [Widget] ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) --
,rsList :: List RegisterScreenItem -- ^ list widget showing transactions affecting this account
,rsAccount :: AccountName -- ^ the account this register is for
} }
| TransactionScreen { | TransactionScreen {
tsState :: TransactionScreenState sInit :: Day -> Bool -> AppState -> AppState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sDraw :: AppState -> [Widget]
,sDrawFn :: AppState -> [Widget] ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) --
,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 { | ErrorScreen {
esState :: ErrorScreenState sInit :: Day -> Bool -> AppState -> AppState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sDraw :: AppState -> [Widget]
,sDrawFn :: AppState -> [Widget] ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) --
,esError :: String -- ^ error message to show
} }
deriving (Show) deriving (Show)
instance Show (List a) where show _ = "<List>"
instance Show Editor where show _ = "<Editor>"
instance Monoid (List a)
where
mempty = list "" V.empty 1
mappend a b = a & listElementsL .~ (a^.listElementsL <> b^.listElementsL)
-- | Render state for this type of screen.
data AccountsScreenState = AccountsScreenState {
_asItems :: List AccountsScreenItem -- ^ list of account names & balances
,_asSelectedAccount :: AccountName -- ^ full name of the currently selected account (or "")
} deriving (Show)
-- | An item in the accounts screen's list of accounts and balances. -- | An item in the accounts screen's list of accounts and balances.
data AccountsScreenItem = AccountsScreenItem { data AccountsScreenItem = AccountsScreenItem {
asItemIndentLevel :: Int -- ^ indent level asItemIndentLevel :: Int -- ^ indent level
@ -116,12 +112,6 @@ data AccountsScreenItem = AccountsScreenItem {
,asItemRenderedAmounts :: [String] -- ^ rendered amounts ,asItemRenderedAmounts :: [String] -- ^ rendered amounts
} }
-- | Render state for this type of screen.
data RegisterScreenState = RegisterScreenState {
rsItems :: List RegisterScreenItem -- ^ list of transactions affecting this account
,rsSelectedAccount :: AccountName -- ^ full name of the account we are showing a register for
} deriving (Show)
-- | An item in the register screen's list of transactions in the current account. -- | An item in the register screen's list of transactions in the current account.
data RegisterScreenItem = RegisterScreenItem { data RegisterScreenItem = RegisterScreenItem {
rsItemDate :: String -- ^ date rsItemDate :: String -- ^ date
@ -132,26 +122,15 @@ data RegisterScreenItem = RegisterScreenItem {
,rsItemTransaction :: Transaction -- ^ the full transaction ,rsItemTransaction :: Transaction -- ^ the full transaction
} }
-- | Render state for this type of screen.
data TransactionScreenState = TransactionScreenState {
tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list
,tsTransactions :: [NumberedTransaction] -- ^ the list of transactions we can step through
,tsSelectedAccount :: AccountName -- ^ the account whose register we entered this screen from
} deriving (Show)
type NumberedTransaction = (Integer, Transaction) type NumberedTransaction = (Integer, Transaction)
-- | Render state for this type of screen. -- needed for lenses
data ErrorScreenState = ErrorScreenState { instance Monoid (List a)
esError :: String -- ^ error message to show where
} deriving (Show) mempty = list "" V.empty 1
mappend l1 l2 = l1 & listElementsL .~ (l1^.listElementsL <> l2^.listElementsL)
-- makeLenses ''AccountsScreenState
concat <$> mapM makeLenses [ concat <$> mapM makeLenses [
''AccountsScreenState ''Screen
-- ,''RegisterScreenState
-- ,''TransactionScreenState
-- ,''ErrorScreenState
,''Screen
] ]

117
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -1,33 +1,36 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.UIUtils ( module Hledger.UI.UIUtils
pushScreen -- (
,popScreen -- pushScreen
,resetScreens -- ,popScreen
,screenEnter -- ,resetScreens
,regenerateScreens -- ,screenEnter
,getViewportSize -- ,regenerateScreens
-- ,margin -- ,getViewportSize
,withBorderAttr -- -- ,margin
,topBottomBorderWithLabel -- ,withBorderAttr
,topBottomBorderWithLabels -- ,topBottomBorderWithLabel
,defaultLayout -- ,topBottomBorderWithLabels
,borderQueryStr -- ,defaultLayout
,borderDepthStr -- ,borderQueryStr
,borderKeysStr -- ,borderDepthStr
,minibuffer -- ,borderKeysStr
-- -- ,minibuffer
,stToggleCleared -- --
,stTogglePending -- ,stToggleCleared
,stToggleUncleared -- ,stTogglePending
,stToggleEmpty -- ,stToggleUncleared
,stToggleFlat -- ,stToggleEmpty
,stToggleReal -- ,stToggleFlat
,stFilter -- ,stToggleReal
,stResetFilter -- ,stFilter
,stShowMinibuffer -- ,stResetFilter
,stHideMinibuffer -- ,stShowMinibuffer
) where -- ,stHideMinibuffer
-- )
where
import Lens.Micro ((^.)) import Lens.Micro ((^.))
-- import Control.Monad -- import Control.Monad
@ -44,13 +47,10 @@ import Brick.Widgets.Border
import Brick.Widgets.Border.Style import Brick.Widgets.Border.Style
import Graphics.Vty as Vty import Graphics.Vty as Vty
import Hledger.UI.UITypes import Hledger
import Hledger.Data.Types (Journal)
import Hledger.UI.UIOptions
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Reports.ReportOptions import Hledger.UI.UITypes
import Hledger.Utils (applyN) import Hledger.UI.UIOptions
-- import Hledger.Utils.Debug
-- | Toggle between showing only cleared items or all items. -- | Toggle between showing only cleared items or all items.
stToggleCleared :: AppState -> AppState stToggleCleared :: AppState -> AppState
@ -116,6 +116,43 @@ stResetDepth :: AppState -> AppState
stResetDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = stResetDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}} st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}}
-- | Get the maximum account depth in the current journal.
maxDepth :: AppState -> Int
maxDepth AppState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames 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 :: AppState -> AppState
decDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}}
where
dec (Just d) = Just $ max 0 (d-1)
dec Nothing = Just $ maxDepth st - 1
-- | Increment the current depth limit. If this makes it equal to the
-- the maximum account depth, remove the depth limit.
incDepth :: AppState -> AppState
incDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}}
where
inc (Just d) | d < (maxDepth st - 1) = Just $ d+1
inc _ = Nothing
-- | Set the current depth limit to the specified depth, which should
-- be a positive number. If it is zero, or equal to or greater than the
-- current maximum account depth, the depth limit will be removed.
-- (Slight inconsistency here: zero is currently a valid display depth
-- which can be reached using the - key. But we need a key to remove
-- the depth limit, and 0 is it.)
setDepth :: Int -> AppState -> AppState
setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}}
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}}
where
mdepth' | depth < 0 = depth_ ropts
| depth == 0 = Nothing
| depth >= maxDepth st = Nothing
| otherwise = Just depth
-- | Enable the minibuffer, setting its content to the current query with the cursor at the end. -- | Enable the minibuffer, setting its content to the current query with the cursor at the end.
stShowMinibuffer st = st{aMinibuffer=Just e} stShowMinibuffer st = st{aMinibuffer=Just e}
where where
@ -129,14 +166,14 @@ stHideMinibuffer st = st{aMinibuffer=Nothing}
regenerateScreens :: Journal -> Day -> AppState -> AppState regenerateScreens :: Journal -> Day -> AppState -> AppState
regenerateScreens j d st@AppState{aScreen=s,aPrevScreens=ss} = regenerateScreens j d st@AppState{aScreen=s,aPrevScreens=ss} =
-- XXX clumsy due to entanglement of AppState and Screen. -- XXX clumsy due to entanglement of AppState and Screen.
-- sInitFn operates only on an appstate's current screen, so -- sInit operates only on an appstate's current screen, so
-- remove all the screens from the appstate and then add them back -- remove all the screens from the appstate and then add them back
-- one at a time, regenerating as we go. -- one at a time, regenerating as we go.
let let
first:rest = reverse $ s:ss :: [Screen] first:rest = reverse $ s:ss :: [Screen]
st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} :: AppState st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} :: AppState
st1 = (sInitFn first) d False st0 :: AppState st1 = (sInit first) d False st0 :: AppState
st2 = foldl' (\st s -> (sInitFn s) d False $ pushScreen s st) st1 rest :: AppState st2 = foldl' (\st s -> (sInit s) d False $ pushScreen s st) st1 rest :: AppState
in in
st2 st2
@ -151,7 +188,7 @@ popScreen st = st
resetScreens :: Day -> AppState -> AppState resetScreens :: Day -> AppState -> AppState
resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} = resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} =
(sInitFn topscreen) d True $ stResetDepth $ stResetFilter $ stHideMinibuffer st{aScreen=topscreen, aPrevScreens=[]} (sInit topscreen) d True $ stResetDepth $ stResetFilter $ stHideMinibuffer st{aScreen=topscreen, aPrevScreens=[]}
where where
topscreen = case ss of _:_ -> last ss topscreen = case ss of _:_ -> last ss
[] -> s [] -> s
@ -162,7 +199,7 @@ resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} =
-- | Enter a new screen, saving the old screen & state in the -- | Enter a new screen, saving the old screen & state in the
-- navigation history and initialising the new screen's state. -- navigation history and initialising the new screen's state.
screenEnter :: Day -> Screen -> AppState -> AppState screenEnter :: Day -> Screen -> AppState -> AppState
screenEnter d scr st = (sInitFn scr) d True $ screenEnter d scr st = (sInit scr) d True $
pushScreen scr pushScreen scr
st st
@ -230,7 +267,7 @@ _topBottomBorderWithLabel2 label = \wrapped ->
-- thickness, using the current background colour or the specified -- thickness, using the current background colour or the specified
-- colour. -- colour.
-- XXX May disrupt border style of inner widgets. -- XXX May disrupt border style of inner widgets.
-- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf drawRegisterScreen2). -- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf rsDraw2).
margin :: Int -> Int -> Maybe Color -> Widget -> Widget margin :: Int -> Int -> Maybe Color -> Widget -> Widget
margin h v mcolour = \w -> margin h v mcolour = \w ->
Widget Greedy Greedy $ do Widget Greedy Greedy $ do