ui: txn: add a transaction-viewing screen
This commit is contained in:
Simon Michael
parent
f6a7070167
commit
68cd35c965
@ -2280,6 +2280,14 @@ hledger-web, and other accounting systems), rather than postings
|
||||
$ hledger-ui --register checking desc:market
|
||||
```
|
||||
|
||||
##### Transaction screen
|
||||
|
||||
Pressing cursor right or enter on a transaction in the register screen
|
||||
will display the transaction in full, as a general journal entry
|
||||
(similar to `hledger print`).
|
||||
This shows more detail, such as the cleared status, transaction code,
|
||||
comments and tags, and the individual account postings.
|
||||
|
||||
##### Error screen
|
||||
|
||||
This screen will appear if there is a problem, such as a parse error,
|
||||
|
||||
@ -126,7 +126,7 @@ drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{
|
||||
-- ("up/down/pgup/pgdown/home/end", "move")
|
||||
("-+=1234567890", "adjust depth limit")
|
||||
,("f", "flat/tree mode")
|
||||
,("right/enter", "show transactions")
|
||||
,("right/enter", "show register")
|
||||
,("g", "reload")
|
||||
,("q", "quit")
|
||||
]
|
||||
|
||||
@ -30,6 +30,7 @@ import Hledger.UI.UIOptions
|
||||
-- import Hledger.UI.Theme
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIUtils
|
||||
import qualified Hledger.UI.TransactionScreen as TS (screen)
|
||||
import qualified Hledger.UI.ErrorScreen as ES (screen)
|
||||
|
||||
screen = RegisterScreen{
|
||||
@ -55,8 +56,6 @@ initRegisterScreen d st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScree
|
||||
-- XXX temp
|
||||
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
|
||||
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts
|
||||
-- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
|
||||
--{query_=unwords' $ locArgs l}
|
||||
|
||||
-- run a transactions report, most recent last
|
||||
q' =
|
||||
@ -78,6 +77,7 @@ initRegisterScreen d st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScree
|
||||
-- _ -> "<split>" -- should do this if accounts field width < 30
|
||||
,showMixedAmountOneLineWithoutPrice change
|
||||
,showMixedAmountOneLineWithoutPrice bal
|
||||
,t
|
||||
)
|
||||
displayitems = map displayitem items
|
||||
|
||||
@ -129,8 +129,8 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo
|
||||
whitespacewidth = 10 -- inter-column whitespace, fixed width
|
||||
minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts
|
||||
maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth)
|
||||
maxchangewidthseen = maximum' $ map (strWidth . fourth5) displayitems
|
||||
maxbalwidthseen = maximum' $ map (strWidth . fifth5) displayitems
|
||||
maxchangewidthseen = maximum' $ map (strWidth . fourth6) displayitems
|
||||
maxbalwidthseen = maximum' $ map (strWidth . fifth6) displayitems
|
||||
changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen)
|
||||
maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth
|
||||
maxbalwidth = maxamtswidth - maxchangewidth
|
||||
@ -143,8 +143,8 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo
|
||||
-- trace (show (totalwidth, datewidth, changewidth, balwidth, whitespacewidth)) $
|
||||
max 0 (totalwidth - datewidth - changewidth - balwidth - whitespacewidth)
|
||||
-- allocating proportionally.
|
||||
-- descwidth' = maximum' $ map (strWidth . second5) displayitems
|
||||
-- acctswidth' = maximum' $ map (strWidth . third5) displayitems
|
||||
-- descwidth' = maximum' $ map (strWidth . second6) displayitems
|
||||
-- acctswidth' = maximum' $ map (strWidth . third6) displayitems
|
||||
-- descwidthproportion = (descwidth' + acctswidth') / descwidth'
|
||||
-- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion)
|
||||
-- maxacctswidth = maxdescacctswidth - maxdescwidth
|
||||
@ -157,16 +157,18 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo
|
||||
|
||||
bottomlabel = borderKeysStr [
|
||||
-- ("up/down/pgup/pgdown/home/end", "move")
|
||||
("g", "reload")
|
||||
,("left", "return to accounts")
|
||||
("left", "return to accounts")
|
||||
,("right/enter", "show transaction")
|
||||
,("g", "reload")
|
||||
,("q", "quit")
|
||||
]
|
||||
|
||||
render $ defaultLayout toplabel bottomlabel $ renderList l (drawRegisterItem colwidths)
|
||||
|
||||
drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen"
|
||||
|
||||
drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget
|
||||
drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) =
|
||||
drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String,Transaction) -> Widget
|
||||
drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal,_) =
|
||||
Widget Greedy Fixed $ do
|
||||
render $
|
||||
str (fitString (Just datewidth) (Just datewidth) True True date) <+>
|
||||
@ -192,22 +194,28 @@ handleRegisterScreen st@AppState{
|
||||
,aopts=UIOpts{cliopts_=_copts}
|
||||
,ajournal=j
|
||||
} e = do
|
||||
d <- liftIO getCurrentDay
|
||||
case e of
|
||||
Vty.EvKey Vty.KEsc [] -> halt st
|
||||
Vty.EvKey (Vty.KChar 'q') [] -> halt st
|
||||
|
||||
Vty.EvKey (Vty.KChar 'g') [] -> do
|
||||
d <- liftIO getCurrentDay
|
||||
ej <- liftIO $ journalReload j -- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
|
||||
case ej of
|
||||
Right j' -> continue $ reload j' d st
|
||||
Left err -> continue $ screenEnter d ES.screen{esState=err} st
|
||||
|
||||
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
|
||||
-- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is
|
||||
|
||||
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
|
||||
case listSelectedElement l of
|
||||
Just (_, (_, _, _, _, _, t)) -> continue $ screenEnter d TS.screen{tsState=t} st
|
||||
Nothing -> continue st
|
||||
|
||||
-- fall through to the list's event handler (handles [pg]up/down)
|
||||
ev -> do
|
||||
l' <- handleEvent ev l
|
||||
continue st{aScreen=s{rsState=(l',acct)}}
|
||||
-- continue =<< handleEventLensed st someLens ev
|
||||
|
||||
handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
|
||||
188
hledger-ui/Hledger/UI/TransactionScreen.hs
Normal file
188
hledger-ui/Hledger/UI/TransactionScreen.hs
Normal file
@ -0,0 +1,188 @@
|
||||
-- The transaction screen, showing the general journal entry representing a single transaction.
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-} -- , FlexibleContexts
|
||||
|
||||
module Hledger.UI.TransactionScreen
|
||||
(screen
|
||||
-- ,tsSetCurrentAccount
|
||||
)
|
||||
where
|
||||
|
||||
-- import Control.Lens ((^.))
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
-- import Data.List
|
||||
-- import Data.List.Split (splitOn)
|
||||
import Data.Monoid
|
||||
-- import Data.Maybe
|
||||
import Data.Time.Calendar (Day)
|
||||
-- import qualified Data.Vector as V
|
||||
import Graphics.Vty as Vty
|
||||
import Brick
|
||||
-- import Brick.Widgets.List
|
||||
-- import Brick.Widgets.Border
|
||||
-- import Brick.Widgets.Border.Style
|
||||
-- import Brick.Widgets.Center
|
||||
-- import Text.Printf
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
import Hledger.UI.UIOptions
|
||||
-- import Hledger.UI.Theme
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIUtils
|
||||
import qualified Hledger.UI.ErrorScreen as ES (screen)
|
||||
|
||||
screen = TransactionScreen{
|
||||
tsState = nulltransaction
|
||||
,sInitFn = initTransactionScreen
|
||||
,sDrawFn = drawTransactionScreen
|
||||
,sHandleFn = handleTransactionScreen
|
||||
}
|
||||
|
||||
-- tsSetCurrentAccount a scr@TransactionScreen{tsState=(l,_)} = scr{tsState=(l,a)}
|
||||
-- tsSetCurrentAccount _ scr = scr
|
||||
|
||||
initTransactionScreen :: Day -> AppState -> AppState
|
||||
initTransactionScreen _d st@AppState{aopts=_opts, ajournal=_j, aScreen=_s@TransactionScreen{tsState=_t}} =
|
||||
st
|
||||
-- where
|
||||
-- -- gather arguments and queries
|
||||
-- ropts = (reportopts_ $ cliopts_ opts)
|
||||
-- {
|
||||
-- depth_=Nothing,
|
||||
-- balancetype_=HistoricalBalance
|
||||
-- }
|
||||
-- -- XXX temp
|
||||
-- thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
|
||||
-- q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts
|
||||
|
||||
-- -- run a transactions report, most recent last
|
||||
-- q' =
|
||||
-- -- ltrace "q"
|
||||
-- q
|
||||
-- thisacctq' =
|
||||
-- -- ltrace "thisacctq"
|
||||
-- thisacctq
|
||||
-- (_label,items') = accountTransactionsReport ropts j q' thisacctq'
|
||||
-- items = reverse items'
|
||||
|
||||
-- -- pre-render all items; these will be the List elements. This helps calculate column widths.
|
||||
-- displayitem (_, t, _issplit, otheracctsstr, change, bal) =
|
||||
-- (showDate $ tdate t
|
||||
-- ,tdescription t
|
||||
-- ,case splitOn ", " otheracctsstr of
|
||||
-- [s] -> s
|
||||
-- ss -> intercalate ", " ss
|
||||
-- -- _ -> "<split>" -- should do this if accounts field width < 30
|
||||
-- ,showMixedAmountOneLineWithoutPrice change
|
||||
-- ,showMixedAmountOneLineWithoutPrice bal
|
||||
-- )
|
||||
-- displayitems = map displayitem items
|
||||
|
||||
-- -- build the List, moving the selection to the end
|
||||
-- l = listMoveTo (length items) $
|
||||
-- list (Name "register") (V.fromList displayitems) 1
|
||||
|
||||
-- -- (listName someList)
|
||||
|
||||
initTransactionScreen _ _ = error "init function called with wrong screen type, should not happen"
|
||||
|
||||
drawTransactionScreen :: AppState -> [Widget]
|
||||
drawTransactionScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
|
||||
aScreen=TransactionScreen{tsState=t}} = [ui]
|
||||
where
|
||||
toplabel =
|
||||
str "Transaction "
|
||||
<+> withAttr ("border" <> "bold") (str $ show (tdate t) ++ " " ++ tdescription t)
|
||||
-- <+> str " of "
|
||||
-- <+> str " ("
|
||||
-- <+> cur
|
||||
-- <+> str "/"
|
||||
-- <+> total
|
||||
-- <+> str ")"
|
||||
-- cur = str $ case l^.listSelectedL of
|
||||
-- Nothing -> "-"
|
||||
-- Just i -> show (i + 1)
|
||||
-- total = str $ show $ length displayitems
|
||||
-- displayitems = V.toList $ l^.listElementsL
|
||||
|
||||
-- query = query_ $ reportopts_ $ cliopts_ opts
|
||||
|
||||
ui = Widget Greedy Greedy $ do
|
||||
|
||||
-- calculate column widths, based on current available width
|
||||
-- c <- getContext
|
||||
let
|
||||
-- totalwidth = c^.availWidthL
|
||||
-- - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
|
||||
|
||||
-- -- the date column is fixed width
|
||||
-- datewidth = 10
|
||||
|
||||
-- -- multi-commodity amounts rendered on one line can be
|
||||
-- -- arbitrarily wide. Give the two amounts as much space as
|
||||
-- -- they need, while reserving a minimum of space for other
|
||||
-- -- columns and whitespace. If they don't get all they need,
|
||||
-- -- allocate it to them proportionally to their maximum widths.
|
||||
-- whitespacewidth = 10 -- inter-column whitespace, fixed width
|
||||
-- minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts
|
||||
-- maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth)
|
||||
-- maxchangewidthseen = maximum' $ map (strWidth . fourth5) displayitems
|
||||
-- maxbalwidthseen = maximum' $ map (strWidth . fifth5) displayitems
|
||||
-- changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen)
|
||||
-- maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth
|
||||
-- maxbalwidth = maxamtswidth - maxchangewidth
|
||||
-- changewidth = min maxchangewidth maxchangewidthseen
|
||||
-- balwidth = min maxbalwidth maxbalwidthseen
|
||||
|
||||
-- -- assign the remaining space to the description and accounts columns
|
||||
-- -- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth
|
||||
-- maxdescacctswidth =
|
||||
-- -- trace (show (totalwidth, datewidth, changewidth, balwidth, whitespacewidth)) $
|
||||
-- max 0 (totalwidth - datewidth - changewidth - balwidth - whitespacewidth)
|
||||
-- -- allocating proportionally.
|
||||
-- -- descwidth' = maximum' $ map (strWidth . second5) displayitems
|
||||
-- -- acctswidth' = maximum' $ map (strWidth . third5) displayitems
|
||||
-- -- descwidthproportion = (descwidth' + acctswidth') / descwidth'
|
||||
-- -- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion)
|
||||
-- -- maxacctswidth = maxdescacctswidth - maxdescwidth
|
||||
-- -- descwidth = min maxdescwidth descwidth'
|
||||
-- -- acctswidth = min maxacctswidth acctswidth'
|
||||
-- -- allocating equally.
|
||||
-- descwidth = maxdescacctswidth `div` 2
|
||||
-- acctswidth = maxdescacctswidth - descwidth
|
||||
-- colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)
|
||||
|
||||
bottomlabel = borderKeysStr [
|
||||
-- ("up/down/pgup/pgdown/home/end", "move")
|
||||
("left", "return to register")
|
||||
,("g", "reload")
|
||||
,("q", "quit")
|
||||
]
|
||||
|
||||
render $ defaultLayout toplabel bottomlabel $ str $ showTransactionUnelided t
|
||||
|
||||
drawTransactionScreen _ = 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=_t}
|
||||
,aopts=UIOpts{cliopts_=_copts}
|
||||
,ajournal=j
|
||||
} e = do
|
||||
case e of
|
||||
Vty.EvKey Vty.KEsc [] -> halt st
|
||||
Vty.EvKey (Vty.KChar 'q') [] -> halt st
|
||||
|
||||
Vty.EvKey (Vty.KChar 'g') [] -> do
|
||||
d <- liftIO getCurrentDay
|
||||
ej <- liftIO $ journalReload j -- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
|
||||
case ej of
|
||||
Right j' -> continue $ reload j' d st
|
||||
Left err -> continue $ screenEnter d ES.screen{esState=err} st
|
||||
|
||||
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
|
||||
|
||||
_ev -> continue st
|
||||
|
||||
handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
@ -33,12 +33,19 @@ data Screen =
|
||||
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen
|
||||
}
|
||||
| RegisterScreen {
|
||||
rsState :: (List (String,String,String,String,String), AccountName) -- ^ list widget holding (date, description, other accts, change amt, balance amt);
|
||||
rsState :: (List (String,String,String,String,String,Transaction), AccountName)
|
||||
-- ^ list widget holding (date, description, other accts, change amt, balance amt, and the full transaction);
|
||||
-- the full name of the account we are showing a register for
|
||||
,sInitFn :: Day -> AppState -> AppState
|
||||
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
}
|
||||
| TransactionScreen {
|
||||
tsState :: Transaction -- ^ the transaction we are viewing
|
||||
,sInitFn :: Day -> AppState -> AppState
|
||||
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
}
|
||||
| ErrorScreen {
|
||||
esState :: String -- ^ error message to display
|
||||
,sInitFn :: Day -> AppState -> AppState
|
||||
|
||||
@ -167,6 +167,14 @@ hledger-web, and other accounting systems), rather than postings
|
||||
$ hledger-ui --register checking desc:market
|
||||
```
|
||||
|
||||
## Transaction screen
|
||||
|
||||
Pressing cursor right or enter on a transaction in the register screen
|
||||
will display the transaction in full, as a general journal entry
|
||||
(similar to `hledger print`).
|
||||
This shows more detail, such as the cleared status, transaction code,
|
||||
comments and tags, and the individual account postings.
|
||||
|
||||
## Error screen
|
||||
|
||||
This screen will appear if there is a problem, such as a parse error,
|
||||
|
||||
@ -83,4 +83,5 @@ executable hledger-ui
|
||||
Hledger.UI.AccountsScreen
|
||||
Hledger.UI.ErrorScreen
|
||||
Hledger.UI.RegisterScreen
|
||||
Hledger.UI.TransactionScreen
|
||||
default-language: Haskell2010
|
||||
|
||||
Loading…
Reference in New Issue
Block a user