mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
ui: refactor, simplify, flatten screen types
This commit is contained in:
Simon Michael
parent
e6b1d2d5a7
commit
8bda78a447
@ -5,12 +5,11 @@
|
||||
|
||||
module Hledger.UI.AccountsScreen
|
||||
(accountsScreen
|
||||
,initAccountsScreen
|
||||
,asInit
|
||||
,asSetSelectedAccount
|
||||
)
|
||||
where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
-- import Control.Monad
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
-- import Data.Default
|
||||
@ -28,7 +27,7 @@ import Brick.Widgets.List
|
||||
import Brick.Widgets.Edit
|
||||
import Brick.Widgets.Border (borderAttr)
|
||||
-- import Brick.Widgets.Center
|
||||
import Lens.Micro ((.~), (&))
|
||||
import Lens.Micro
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
@ -42,24 +41,20 @@ import Hledger.UI.ErrorScreen
|
||||
|
||||
accountsScreen :: Screen
|
||||
accountsScreen = AccountsScreen{
|
||||
_asState = AccountsScreenState{_asItems=list "accounts" V.empty 1
|
||||
,_asSelectedAccount=""
|
||||
}
|
||||
,sInitFn = initAccountsScreen
|
||||
,sDrawFn = drawAccountsScreen
|
||||
,sHandleFn = handleAccountsScreen
|
||||
sInit = asInit
|
||||
,sDraw = asDraw
|
||||
,sHandle = asHandle
|
||||
,_asList = list "accounts" V.empty 1
|
||||
,_asSelectedAccount = ""
|
||||
}
|
||||
|
||||
asSetSelectedAccount a s@AccountsScreen{} = s & asState . asSelectedAccount .~ a
|
||||
asSetSelectedAccount _ s = s
|
||||
|
||||
initAccountsScreen :: Day -> Bool -> AppState -> AppState
|
||||
initAccountsScreen d reset st@AppState{
|
||||
asInit :: Day -> Bool -> AppState -> AppState
|
||||
asInit d reset st@AppState{
|
||||
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
|
||||
ajournal=j,
|
||||
aScreen=s@AccountsScreen{}
|
||||
} =
|
||||
st{aopts=uopts', aScreen=s & asState . asItems .~ newitems'}
|
||||
st{aopts=uopts', aScreen=s & asList .~ newitems'}
|
||||
where
|
||||
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)
|
||||
newitems' = listMoveTo selidx newitems
|
||||
where
|
||||
selidx = case (reset, listSelectedElement $ s ^. asState . asItems) of
|
||||
selidx = case (reset, listSelectedElement $ s ^. asList) of
|
||||
(True, _) -> 0
|
||||
(_, Nothing) -> 0
|
||||
(_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch
|
||||
@ -104,10 +99,10 @@ initAccountsScreen d reset st@AppState{
|
||||
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]
|
||||
drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
asDraw :: AppState -> [Widget]
|
||||
asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,ajournal=j
|
||||
,aScreen=s@AccountsScreen{}
|
||||
,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"
|
||||
nonzero | empty_ ropts = str ""
|
||||
| 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 -> "-"
|
||||
Just i -> show (i + 1))
|
||||
total = str $ show $ V.length $ s ^. asState . asItems . listElementsL
|
||||
total = str $ show $ V.length $ s ^. asList . listElementsL
|
||||
|
||||
bottomlabel = borderKeysStr [
|
||||
-- ("up/down/pgup/pgdown/home/end", "move")
|
||||
@ -174,7 +169,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
-- ltrace "availwidth" $
|
||||
c^.availWidthL
|
||||
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
|
||||
displayitems = s ^. asState . asItems . listElementsL
|
||||
displayitems = s ^. asList . listElementsL
|
||||
maxacctwidthseen =
|
||||
-- ltrace "maxacctwidthseen" $
|
||||
V.maximum $
|
||||
@ -202,12 +197,12 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
|
||||
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
|
||||
drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget
|
||||
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
Widget Greedy Fixed $ do
|
||||
-- c <- getContext
|
||||
-- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
|
||||
@ -233,8 +228,8 @@ drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
sel | selected = (<> "selected")
|
||||
| otherwise = id
|
||||
|
||||
handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
handleAccountsScreen st@AppState{
|
||||
asHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
asHandle st'@AppState{
|
||||
aScreen=scr@AccountsScreen{..}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
@ -245,55 +240,52 @@ handleAccountsScreen st@AppState{
|
||||
-- let h = c^.availHeightL
|
||||
-- moveSel n l = listMoveBy n l
|
||||
|
||||
-- before we go anywhere, remember the currently selected account.
|
||||
-- (This is preserved across screen changes, unlike List's selection state)
|
||||
-- save the currently selected account, in case we leave this screen and lose the selection
|
||||
let
|
||||
selacct = case listSelectedElement $ scr ^. asState . asItems of
|
||||
selacct = case listSelectedElement $ scr ^. asList of
|
||||
Just (_, AccountsScreenItem{..}) -> asItemAccountName
|
||||
Nothing -> scr ^. asState . asSelectedAccount
|
||||
st' = st{aScreen=scr & asState . asSelectedAccount .~ selacct}
|
||||
Nothing -> scr ^. asSelectedAccount
|
||||
st = st'{aScreen=scr & asSelectedAccount .~ selacct}
|
||||
|
||||
case mbuf of
|
||||
Nothing ->
|
||||
|
||||
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.KEsc [] -> continue $ resetScreens d st'
|
||||
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 $ 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 '2') [] -> continue $ regenerateScreens j d $ setDepth 2 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 '5') [] -> continue $ regenerateScreens j d $ setDepth 5 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 '8') [] -> continue $ regenerateScreens j d $ setDepth 8 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 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat 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 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared 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.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st')
|
||||
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st'
|
||||
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
|
||||
let
|
||||
scr = rsSetCurrentAccount selacct registerScreen
|
||||
st'' = screenEnter d scr st'
|
||||
scrollTopRegister
|
||||
continue 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 '-') [] -> 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 '1') [] -> continue $ regenerateScreens j d $ setDepth 1 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 '4') [] -> continue $ regenerateScreens j d $ setDepth 4 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 '7') [] -> continue $ regenerateScreens j d $ setDepth 7 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 '0') [] -> continue $ regenerateScreens j d $ setDepth 0 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 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared 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 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 (Vty.KLeft) [] -> continue $ popScreen st
|
||||
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> scrollTopRegister >> continue (screenEnter d scr st)
|
||||
where
|
||||
scr = rsSetAccount selacct registerScreen
|
||||
|
||||
-- fall through to the list's event handler (handles up/down)
|
||||
ev -> do
|
||||
newitems <- handleEvent ev (scr ^. asState . asItems)
|
||||
continue $ st'{aScreen=scr & asState . asItems .~ newitems
|
||||
& asState . asSelectedAccount .~ selacct}
|
||||
newitems <- handleEvent ev (scr ^. asList)
|
||||
continue $ st'{aScreen=scr & asList .~ newitems
|
||||
& asSelectedAccount .~ selacct
|
||||
}
|
||||
-- continue =<< handleEventLensed st' someLens ev
|
||||
|
||||
Just ed ->
|
||||
@ -313,42 +305,8 @@ handleAccountsScreen st@AppState{
|
||||
scrollTop = vScrollToBeginning $ viewportScroll "accounts"
|
||||
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.
|
||||
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
|
||||
asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
|
||||
asSetSelectedAccount _ s = s
|
||||
|
||||
|
||||
@ -30,19 +30,19 @@ import Hledger.UI.UIUtils
|
||||
|
||||
errorScreen :: Screen
|
||||
errorScreen = ErrorScreen{
|
||||
esState = ErrorScreenState{esError=""}
|
||||
,sInitFn = initErrorScreen
|
||||
,sDrawFn = drawErrorScreen
|
||||
,sHandleFn = handleErrorScreen
|
||||
sInit = esInit
|
||||
,sDraw = esDraw
|
||||
,sHandle = esHandle
|
||||
,esError = ""
|
||||
}
|
||||
|
||||
initErrorScreen :: Day -> Bool -> AppState -> AppState
|
||||
initErrorScreen _ _ st@AppState{aScreen=ErrorScreen{}} = st
|
||||
initErrorScreen _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
esInit :: Day -> Bool -> AppState -> AppState
|
||||
esInit _ _ st@AppState{aScreen=ErrorScreen{}} = st
|
||||
esInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
|
||||
drawErrorScreen :: AppState -> [Widget]
|
||||
drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
|
||||
aScreen=ErrorScreen{esState=ErrorScreenState{..}}} = [ui]
|
||||
esDraw :: AppState -> [Widget]
|
||||
esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
|
||||
aScreen=ErrorScreen{..}} = [ui]
|
||||
where
|
||||
toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload")
|
||||
-- <+> str " transactions"
|
||||
@ -77,7 +77,7 @@ drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto
|
||||
|
||||
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 (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")
|
||||
-- | otherwise = id
|
||||
|
||||
handleErrorScreen :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
handleErrorScreen st@AppState{
|
||||
aScreen=s@ErrorScreen{esState=_err}
|
||||
esHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
esHandle st@AppState{
|
||||
aScreen=s@ErrorScreen{}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
} e = do
|
||||
@ -114,7 +114,7 @@ handleErrorScreen st@AppState{
|
||||
Vty.EvKey (Vty.KChar 'g') [] -> do
|
||||
(ej, _) <- liftIO $ journalReloadIfChanged copts d j
|
||||
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
|
||||
|
||||
-- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
|
||||
@ -124,7 +124,7 @@ handleErrorScreen st@AppState{
|
||||
-- is' <- handleEvent ev is
|
||||
-- continue st{aScreen=s{rsState=is'}}
|
||||
-- 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.
|
||||
-- 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
|
||||
return $ case ej of
|
||||
Right j' -> regenerateScreens j' d st
|
||||
Left err -> screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st
|
||||
Left err -> screenEnter d errorScreen{esError=err} st
|
||||
|
||||
|
||||
@ -101,7 +101,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
|
||||
-- with --register, start on the register screen, and also put
|
||||
-- the accounts screen on the prev screens stack so you can exit
|
||||
-- to that as usual.
|
||||
Just apat -> (rsSetCurrentAccount acct registerScreen, [ascr'])
|
||||
Just apat -> (rsSetAccount acct registerScreen, [ascr'])
|
||||
where
|
||||
acct = headDef
|
||||
(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
|
||||
-- another temporary AppState value..
|
||||
ascr' = aScreen $
|
||||
initAccountsScreen d True $
|
||||
asInit d True $
|
||||
AppState{
|
||||
aopts=uopts'
|
||||
,ajournal=j
|
||||
@ -118,7 +118,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
|
||||
,aMinibuffer=Nothing
|
||||
}
|
||||
|
||||
st = (sInitFn scr) d True
|
||||
st = (sInit scr) d True
|
||||
AppState{
|
||||
aopts=uopts'
|
||||
,ajournal=j
|
||||
@ -133,8 +133,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const theme
|
||||
, appChooseCursor = showFirstCursor
|
||||
, appHandleEvent = \st ev -> sHandleFn (aScreen st) st ev
|
||||
, appDraw = \st -> sDrawFn (aScreen st) st
|
||||
, appHandleEvent = \st ev -> sHandle (aScreen st) st ev
|
||||
, appDraw = \st -> sDraw (aScreen st) st
|
||||
-- XXX bizarro. removing the st arg and parameter above,
|
||||
-- which according to GHCI does not change the type,
|
||||
-- causes "Exception: draw function called with wrong screen type"
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
|
||||
module Hledger.UI.RegisterScreen
|
||||
(registerScreen
|
||||
,rsSetCurrentAccount
|
||||
,rsSetAccount
|
||||
)
|
||||
where
|
||||
|
||||
@ -37,20 +37,19 @@ import Hledger.UI.ErrorScreen
|
||||
|
||||
registerScreen :: Screen
|
||||
registerScreen = RegisterScreen{
|
||||
rsState = RegisterScreenState{rsItems=list "register" V.empty 1
|
||||
,rsSelectedAccount=""
|
||||
}
|
||||
,sInitFn = initRegisterScreen
|
||||
,sDrawFn = drawRegisterScreen
|
||||
,sHandleFn = handleRegisterScreen
|
||||
sInit = rsInit
|
||||
,sDraw = rsDraw
|
||||
,sHandle = rsHandle
|
||||
,rsList = list "register" V.empty 1
|
||||
,rsAccount = ""
|
||||
}
|
||||
|
||||
rsSetCurrentAccount a scr@RegisterScreen{..} = scr{rsState=rsState{rsSelectedAccount=a}}
|
||||
rsSetCurrentAccount _ scr = scr
|
||||
rsSetAccount a scr@RegisterScreen{} = scr{rsAccount=a}
|
||||
rsSetAccount _ scr = scr
|
||||
|
||||
initRegisterScreen :: Day -> Bool -> AppState -> AppState
|
||||
initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}} =
|
||||
st{aScreen=s{rsState=rsState{rsItems=newitems'}}}
|
||||
rsInit :: Day -> Bool -> AppState -> AppState
|
||||
rsInit d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{..}} =
|
||||
st{aScreen=s{rsList=newitems'}}
|
||||
where
|
||||
-- gather arguments and queries
|
||||
ropts = (reportopts_ $ cliopts_ opts)
|
||||
@ -59,7 +58,7 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
|
||||
balancetype_=HistoricalBalance
|
||||
}
|
||||
-- XXX temp
|
||||
thisacctq = Acct $ accountNameToAccountRegex rsSelectedAccount -- includes subs
|
||||
thisacctq = Acct $ accountNameToAccountRegex rsAccount -- includes subs
|
||||
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts
|
||||
|
||||
(_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.
|
||||
newitems' = listMoveTo newselidx newitems
|
||||
where
|
||||
newselidx = case (reset, listSelectedElement rsItems) of
|
||||
newselidx = case (reset, listSelectedElement rsList) of
|
||||
(True, _) -> 0
|
||||
(_, Nothing) -> endidx
|
||||
(_, Just (_,RegisterScreenItem{rsItemTransaction=Transaction{tindex=ti}}))
|
||||
-> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) 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]
|
||||
drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,aScreen=RegisterScreen{rsState=RegisterScreenState{..}}
|
||||
rsDraw :: AppState -> [Widget]
|
||||
rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,aScreen=RegisterScreen{..}
|
||||
,aMinibuffer=mbuf}
|
||||
= [ui]
|
||||
where
|
||||
toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsSelectedAccount)
|
||||
toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount)
|
||||
<+> togglefilters
|
||||
<+> str " transactions"
|
||||
<+> borderQueryStr (query_ ropts)
|
||||
@ -124,11 +123,11 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
] of
|
||||
[] -> str ""
|
||||
fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs)
|
||||
cur = str $ case rsItems ^. listSelectedL of
|
||||
cur = str $ case rsList ^. listSelectedL of
|
||||
Nothing -> "-"
|
||||
Just i -> show (i + 1)
|
||||
total = str $ show $ length displayitems
|
||||
displayitems = V.toList $ rsItems ^. listElementsL
|
||||
displayitems = V.toList $ rsList ^. listElementsL
|
||||
|
||||
-- query = query_ $ reportopts_ $ cliopts_ opts
|
||||
|
||||
@ -196,12 +195,12 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
Nothing -> bottomlabel
|
||||
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
|
||||
drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
|
||||
rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget
|
||||
rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
|
||||
Widget Greedy Fixed $ do
|
||||
render $
|
||||
str (fitString (Just datewidth) (Just datewidth) True True rsItemDate) <+>
|
||||
@ -221,9 +220,9 @@ drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected
|
||||
sel | selected = (<> "selected")
|
||||
| otherwise = id
|
||||
|
||||
handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
handleRegisterScreen st@AppState{
|
||||
aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}
|
||||
rsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
rsHandle st@AppState{
|
||||
aScreen=s@RegisterScreen{..}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
,aMinibuffer=mbuf
|
||||
@ -245,22 +244,22 @@ handleRegisterScreen st@AppState{
|
||||
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
|
||||
|
||||
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
|
||||
case listSelectedElement rsItems of
|
||||
case listSelectedElement rsList of
|
||||
Just (_, RegisterScreenItem{rsItemTransaction=t}) ->
|
||||
let
|
||||
ts = map rsItemTransaction $ V.toList $ listElements rsItems
|
||||
ts = map rsItemTransaction $ V.toList $ listElements rsList
|
||||
numberedts = zip [1..] ts
|
||||
i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX
|
||||
in
|
||||
continue $ screenEnter d transactionScreen{tsState=TransactionScreenState{tsTransaction=(i,t)
|
||||
,tsTransactions=numberedts
|
||||
,tsSelectedAccount=rsSelectedAccount}} st
|
||||
continue $ screenEnter d transactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=numberedts
|
||||
,tsAccount=rsAccount} st
|
||||
Nothing -> continue st
|
||||
|
||||
-- fall through to the list's event handler (handles [pg]up/down)
|
||||
ev -> do
|
||||
newitems <- handleEvent ev rsItems
|
||||
continue st{aScreen=s{rsState=rsState{rsItems=newitems}}}
|
||||
newitems <- handleEvent ev rsList
|
||||
continue st{aScreen=s{rsList=newitems}}
|
||||
-- continue =<< handleEventLensed st someLens ev
|
||||
|
||||
Just ed ->
|
||||
@ -275,4 +274,5 @@ handleRegisterScreen st@AppState{
|
||||
-- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs)
|
||||
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"
|
||||
|
||||
|
||||
@ -4,6 +4,7 @@
|
||||
|
||||
module Hledger.UI.TransactionScreen
|
||||
(transactionScreen
|
||||
,rsSelect
|
||||
)
|
||||
where
|
||||
|
||||
@ -37,26 +38,26 @@ import Hledger.UI.ErrorScreen
|
||||
|
||||
transactionScreen :: Screen
|
||||
transactionScreen = TransactionScreen{
|
||||
tsState = TransactionScreenState{tsTransaction=(1,nulltransaction)
|
||||
,tsTransactions=[(1,nulltransaction)]
|
||||
,tsSelectedAccount=""}
|
||||
,sInitFn = initTransactionScreen
|
||||
,sDrawFn = drawTransactionScreen
|
||||
,sHandleFn = handleTransactionScreen
|
||||
sInit = tsInit
|
||||
,sDraw = tsDraw
|
||||
,sHandle = tsHandle
|
||||
,tsTransaction = (1,nulltransaction)
|
||||
,tsTransactions = [(1,nulltransaction)]
|
||||
,tsAccount = ""
|
||||
}
|
||||
|
||||
initTransactionScreen :: Day -> Bool -> AppState -> AppState
|
||||
initTransactionScreen _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
tsInit :: Day -> Bool -> AppState -> AppState
|
||||
tsInit _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
,ajournal=_j
|
||||
,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]
|
||||
drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
tsDraw :: AppState -> [Widget]
|
||||
tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,aScreen=TransactionScreen{
|
||||
tsState=TransactionScreenState{tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
,tsSelectedAccount=acct}}} =
|
||||
tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
,tsAccount=acct}} =
|
||||
[ui]
|
||||
where
|
||||
-- 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
|
||||
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)
|
||||
handleTransactionScreen
|
||||
st@AppState{aScreen=s@TransactionScreen{tsState=tsState@TransactionScreenState{tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
,tsSelectedAccount=acct}}
|
||||
tsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
tsHandle
|
||||
st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
,tsAccount=acct}
|
||||
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
,ajournal=j
|
||||
}
|
||||
@ -121,7 +122,7 @@ handleTransactionScreen
|
||||
case ej of
|
||||
Right j' -> do
|
||||
-- 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
|
||||
ropts' = ropts {depth_=Nothing
|
||||
,balancetype_=HistoricalBalance
|
||||
@ -138,31 +139,31 @@ handleTransactionScreen
|
||||
Nothing | null numberedts -> (0,nulltransaction)
|
||||
| i > fst (last numberedts) -> last numberedts
|
||||
| otherwise -> head numberedts
|
||||
st' = st{aScreen=s{tsState=TransactionScreenState{tsTransaction=(i',t')
|
||||
,tsTransactions=numberedts
|
||||
,tsSelectedAccount=acct}}}
|
||||
st' = st{aScreen=s{tsTransaction=(i',t')
|
||||
,tsTransactions=numberedts
|
||||
,tsAccount=acct}}
|
||||
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
|
||||
-- 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 '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.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=tsState{tsTransaction=(inext,tnext)}}}
|
||||
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{tsTransaction=(inext,tnext)}}
|
||||
|
||||
Vty.EvKey (Vty.KLeft) [] -> continue st''
|
||||
where
|
||||
st'@AppState{aScreen=scr} = popScreen st
|
||||
st'' = st'{aScreen=rsSetSelectedTransaction (fromIntegral i) scr}
|
||||
st'' = st'{aScreen=rsSelect (fromIntegral i) scr}
|
||||
|
||||
_ev -> continue st
|
||||
|
||||
handleTransactionScreen _ _ = 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
|
||||
tsHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
|
||||
-- | Select the nth item on the register screen.
|
||||
rsSelect i scr@RegisterScreen{..} = scr{rsList=l'}
|
||||
where l' = listMoveTo (i-1) rsList
|
||||
rsSelect _ scr = scr
|
||||
|
||||
@ -1,9 +1,11 @@
|
||||
{- |
|
||||
Overview:
|
||||
hledger-ui's AppState holds the active screen and any previously visited screens.
|
||||
Screens have their own render state, render function, event handler,
|
||||
and app state update function (which can update the whole AppState).
|
||||
A brick App delegates event-handling and rendering to our AppState's active screen.
|
||||
hledger-ui's AppState holds the currently active screen and any previously visited
|
||||
screens (and their states).
|
||||
The brick App delegates all event-handling and rendering
|
||||
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
|
||||
@ -14,15 +16,15 @@ Brick.defaultMain brickapp st
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const theme
|
||||
, appChooseCursor = showFirstCursor
|
||||
, appHandleEvent = \st ev -> sHandleFn (aScreen st) st ev
|
||||
, appDraw = \st -> sDrawFn (aScreen st) st
|
||||
, appHandleEvent = \st ev -> sHandle (aScreen st) st ev
|
||||
, appDraw = \st -> sDraw (aScreen st) st
|
||||
}
|
||||
st :: AppState
|
||||
st = (sInitFn scr) d
|
||||
st = (sInit s) d
|
||||
AppState{
|
||||
aopts=uopts'
|
||||
,ajournal=j
|
||||
,aScreen=scr
|
||||
,aScreen=s
|
||||
,aPrevScreens=prevscrs
|
||||
,aMinibuffer=Nothing
|
||||
}
|
||||
@ -30,9 +32,9 @@ Brick.defaultMain brickapp st
|
||||
-}
|
||||
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.UI.UITypes where
|
||||
|
||||
@ -51,63 +53,57 @@ import Text.Show.Functions ()
|
||||
import Hledger
|
||||
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.
|
||||
data AppState = AppState {
|
||||
aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect
|
||||
,ajournal :: Journal -- ^ the journal being viewed
|
||||
,aScreen :: Screen -- ^ the currently active screen
|
||||
,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)
|
||||
|
||||
-- | Types of screen available within hledger-ui. Each has its own
|
||||
-- specific state type, and generic initialisation, event handling
|
||||
-- and rendering functions.
|
||||
--
|
||||
-- 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.
|
||||
-- | hledger-ui screen types & instances.
|
||||
-- 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. The latter create partial functions, so take care.
|
||||
data Screen =
|
||||
AccountsScreen {
|
||||
_asState :: AccountsScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change
|
||||
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer for this screen
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen
|
||||
sInit :: Day -> Bool -> AppState -> AppState -- ^ function to update the screen's state
|
||||
,sDraw :: AppState -> [Widget] -- ^ brick renderer for this screen
|
||||
,sHandle :: 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 {
|
||||
rsState :: RegisterScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
sInit :: Day -> Bool -> AppState -> AppState
|
||||
,sDraw :: AppState -> [Widget]
|
||||
,sHandle :: 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 {
|
||||
tsState :: TransactionScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
sInit :: Day -> Bool -> AppState -> AppState
|
||||
,sDraw :: AppState -> [Widget]
|
||||
,sHandle :: 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 {
|
||||
esState :: ErrorScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
sInit :: Day -> Bool -> AppState -> AppState
|
||||
,sDraw :: AppState -> [Widget]
|
||||
,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
--
|
||||
,esError :: String -- ^ error message to 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.
|
||||
data AccountsScreenItem = AccountsScreenItem {
|
||||
asItemIndentLevel :: Int -- ^ indent level
|
||||
@ -116,12 +112,6 @@ data AccountsScreenItem = AccountsScreenItem {
|
||||
,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.
|
||||
data RegisterScreenItem = RegisterScreenItem {
|
||||
rsItemDate :: String -- ^ date
|
||||
@ -132,26 +122,15 @@ data RegisterScreenItem = RegisterScreenItem {
|
||||
,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)
|
||||
|
||||
-- | Render state for this type of screen.
|
||||
data ErrorScreenState = ErrorScreenState {
|
||||
esError :: String -- ^ error message to show
|
||||
} deriving (Show)
|
||||
-- needed for lenses
|
||||
instance Monoid (List a)
|
||||
where
|
||||
mempty = list "" V.empty 1
|
||||
mappend l1 l2 = l1 & listElementsL .~ (l1^.listElementsL <> l2^.listElementsL)
|
||||
|
||||
-- makeLenses ''AccountsScreenState
|
||||
concat <$> mapM makeLenses [
|
||||
''AccountsScreenState
|
||||
-- ,''RegisterScreenState
|
||||
-- ,''TransactionScreenState
|
||||
-- ,''ErrorScreenState
|
||||
,''Screen
|
||||
''Screen
|
||||
]
|
||||
|
||||
|
||||
@ -1,33 +1,36 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Hledger.UI.UIUtils (
|
||||
pushScreen
|
||||
,popScreen
|
||||
,resetScreens
|
||||
,screenEnter
|
||||
,regenerateScreens
|
||||
,getViewportSize
|
||||
-- ,margin
|
||||
,withBorderAttr
|
||||
,topBottomBorderWithLabel
|
||||
,topBottomBorderWithLabels
|
||||
,defaultLayout
|
||||
,borderQueryStr
|
||||
,borderDepthStr
|
||||
,borderKeysStr
|
||||
,minibuffer
|
||||
--
|
||||
,stToggleCleared
|
||||
,stTogglePending
|
||||
,stToggleUncleared
|
||||
,stToggleEmpty
|
||||
,stToggleFlat
|
||||
,stToggleReal
|
||||
,stFilter
|
||||
,stResetFilter
|
||||
,stShowMinibuffer
|
||||
,stHideMinibuffer
|
||||
) where
|
||||
module Hledger.UI.UIUtils
|
||||
-- (
|
||||
-- pushScreen
|
||||
-- ,popScreen
|
||||
-- ,resetScreens
|
||||
-- ,screenEnter
|
||||
-- ,regenerateScreens
|
||||
-- ,getViewportSize
|
||||
-- -- ,margin
|
||||
-- ,withBorderAttr
|
||||
-- ,topBottomBorderWithLabel
|
||||
-- ,topBottomBorderWithLabels
|
||||
-- ,defaultLayout
|
||||
-- ,borderQueryStr
|
||||
-- ,borderDepthStr
|
||||
-- ,borderKeysStr
|
||||
-- ,minibuffer
|
||||
-- --
|
||||
-- ,stToggleCleared
|
||||
-- ,stTogglePending
|
||||
-- ,stToggleUncleared
|
||||
-- ,stToggleEmpty
|
||||
-- ,stToggleFlat
|
||||
-- ,stToggleReal
|
||||
-- ,stFilter
|
||||
-- ,stResetFilter
|
||||
-- ,stShowMinibuffer
|
||||
-- ,stHideMinibuffer
|
||||
-- )
|
||||
where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
-- import Control.Monad
|
||||
@ -44,13 +47,10 @@ import Brick.Widgets.Border
|
||||
import Brick.Widgets.Border.Style
|
||||
import Graphics.Vty as Vty
|
||||
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.Data.Types (Journal)
|
||||
import Hledger.UI.UIOptions
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Reports.ReportOptions
|
||||
import Hledger.Utils (applyN)
|
||||
-- import Hledger.Utils.Debug
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIOptions
|
||||
|
||||
-- | Toggle between showing only cleared items or all items.
|
||||
stToggleCleared :: AppState -> AppState
|
||||
@ -116,6 +116,43 @@ stResetDepth :: AppState -> AppState
|
||||
stResetDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
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.
|
||||
stShowMinibuffer st = st{aMinibuffer=Just e}
|
||||
where
|
||||
@ -129,14 +166,14 @@ stHideMinibuffer st = st{aMinibuffer=Nothing}
|
||||
regenerateScreens :: Journal -> Day -> AppState -> AppState
|
||||
regenerateScreens j d st@AppState{aScreen=s,aPrevScreens=ss} =
|
||||
-- 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
|
||||
-- one at a time, regenerating as we go.
|
||||
let
|
||||
first:rest = reverse $ s:ss :: [Screen]
|
||||
st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} :: AppState
|
||||
st1 = (sInitFn first) d False st0 :: AppState
|
||||
st2 = foldl' (\st s -> (sInitFn s) d False $ pushScreen s st) st1 rest :: AppState
|
||||
st1 = (sInit first) d False st0 :: AppState
|
||||
st2 = foldl' (\st s -> (sInit s) d False $ pushScreen s st) st1 rest :: AppState
|
||||
in
|
||||
st2
|
||||
|
||||
@ -151,7 +188,7 @@ popScreen st = st
|
||||
|
||||
resetScreens :: Day -> AppState -> AppState
|
||||
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
|
||||
topscreen = case ss of _:_ -> last ss
|
||||
[] -> s
|
||||
@ -162,7 +199,7 @@ resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} =
|
||||
-- | Enter a new screen, saving the old screen & state in the
|
||||
-- navigation history and initialising the new screen's state.
|
||||
screenEnter :: Day -> Screen -> AppState -> AppState
|
||||
screenEnter d scr st = (sInitFn scr) d True $
|
||||
screenEnter d scr st = (sInit scr) d True $
|
||||
pushScreen scr
|
||||
st
|
||||
|
||||
@ -230,7 +267,7 @@ _topBottomBorderWithLabel2 label = \wrapped ->
|
||||
-- thickness, using the current background colour or the specified
|
||||
-- colour.
|
||||
-- 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 h v mcolour = \w ->
|
||||
Widget Greedy Greedy $ do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user