ui: txn: add a transaction-viewing screen

This commit is contained in:
Simon Michael 2015-10-29 17:45:57 -07:00
parent f6a7070167
commit 68cd35c965
7 changed files with 235 additions and 15 deletions

View File

@ -2280,6 +2280,14 @@ hledger-web, and other accounting systems), rather than postings
$ hledger-ui --register checking desc:market $ 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 ##### Error screen
This screen will appear if there is a problem, such as a parse error, This screen will appear if there is a problem, such as a parse error,

View File

@ -126,7 +126,7 @@ drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{
-- ("up/down/pgup/pgdown/home/end", "move") -- ("up/down/pgup/pgdown/home/end", "move")
("-+=1234567890", "adjust depth limit") ("-+=1234567890", "adjust depth limit")
,("f", "flat/tree mode") ,("f", "flat/tree mode")
,("right/enter", "show transactions") ,("right/enter", "show register")
,("g", "reload") ,("g", "reload")
,("q", "quit") ,("q", "quit")
] ]

View File

@ -30,6 +30,7 @@ import Hledger.UI.UIOptions
-- import Hledger.UI.Theme -- import Hledger.UI.Theme
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIUtils import Hledger.UI.UIUtils
import qualified Hledger.UI.TransactionScreen as TS (screen)
import qualified Hledger.UI.ErrorScreen as ES (screen) import qualified Hledger.UI.ErrorScreen as ES (screen)
screen = RegisterScreen{ screen = RegisterScreen{
@ -55,8 +56,6 @@ initRegisterScreen d st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScree
-- XXX temp -- XXX temp
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts 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 -- run a transactions report, most recent last
q' = 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 -- _ -> "<split>" -- should do this if accounts field width < 30
,showMixedAmountOneLineWithoutPrice change ,showMixedAmountOneLineWithoutPrice change
,showMixedAmountOneLineWithoutPrice bal ,showMixedAmountOneLineWithoutPrice bal
,t
) )
displayitems = map displayitem items displayitems = map displayitem items
@ -129,8 +129,8 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo
whitespacewidth = 10 -- inter-column whitespace, fixed width whitespacewidth = 10 -- inter-column whitespace, fixed width
minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts
maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth) maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth)
maxchangewidthseen = maximum' $ map (strWidth . fourth5) displayitems maxchangewidthseen = maximum' $ map (strWidth . fourth6) displayitems
maxbalwidthseen = maximum' $ map (strWidth . fifth5) displayitems maxbalwidthseen = maximum' $ map (strWidth . fifth6) displayitems
changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen) changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen)
maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth
maxbalwidth = maxamtswidth - maxchangewidth maxbalwidth = maxamtswidth - maxchangewidth
@ -143,8 +143,8 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo
-- trace (show (totalwidth, datewidth, changewidth, balwidth, whitespacewidth)) $ -- trace (show (totalwidth, datewidth, changewidth, balwidth, whitespacewidth)) $
max 0 (totalwidth - datewidth - changewidth - balwidth - whitespacewidth) max 0 (totalwidth - datewidth - changewidth - balwidth - whitespacewidth)
-- allocating proportionally. -- allocating proportionally.
-- descwidth' = maximum' $ map (strWidth . second5) displayitems -- descwidth' = maximum' $ map (strWidth . second6) displayitems
-- acctswidth' = maximum' $ map (strWidth . third5) displayitems -- acctswidth' = maximum' $ map (strWidth . third6) displayitems
-- descwidthproportion = (descwidth' + acctswidth') / descwidth' -- descwidthproportion = (descwidth' + acctswidth') / descwidth'
-- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion) -- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion)
-- maxacctswidth = maxdescacctswidth - maxdescwidth -- maxacctswidth = maxdescacctswidth - maxdescwidth
@ -157,16 +157,18 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo
bottomlabel = borderKeysStr [ bottomlabel = borderKeysStr [
-- ("up/down/pgup/pgdown/home/end", "move") -- ("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) render $ defaultLayout toplabel bottomlabel $ renderList l (drawRegisterItem colwidths)
drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" 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 :: (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) = drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal,_) =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
render $ render $
str (fitString (Just datewidth) (Just datewidth) True True date) <+> str (fitString (Just datewidth) (Just datewidth) True True date) <+>
@ -192,22 +194,28 @@ handleRegisterScreen st@AppState{
,aopts=UIOpts{cliopts_=_copts} ,aopts=UIOpts{cliopts_=_copts}
,ajournal=j ,ajournal=j
} e = do } e = do
d <- liftIO getCurrentDay
case e of case e of
Vty.EvKey Vty.KEsc [] -> halt st Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey (Vty.KChar 'g') [] -> do Vty.EvKey (Vty.KChar 'g') [] -> do
d <- liftIO getCurrentDay
ej <- liftIO $ journalReload j -- (ej, changed) <- liftIO $ journalReloadIfChanged copts j ej <- liftIO $ journalReload j -- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
case ej of case ej of
Right j' -> continue $ reload j' d st Right j' -> continue $ reload j' d st
Left err -> continue $ screenEnter d ES.screen{esState=err} st Left err -> continue $ screenEnter d ES.screen{esState=err} st
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen 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) -- fall through to the list's event handler (handles [pg]up/down)
ev -> do ev -> do
l' <- handleEvent ev l l' <- handleEvent ev l
continue st{aScreen=s{rsState=(l',acct)}} continue st{aScreen=s{rsState=(l',acct)}}
-- continue =<< handleEventLensed st someLens ev -- continue =<< handleEventLensed st someLens ev
handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen" handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen"

View 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"

View File

@ -33,8 +33,15 @@ data Screen =
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen
} }
| RegisterScreen { | 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)
-- the full name of the account we are showing a register for -- ^ 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 ,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]

View File

@ -167,6 +167,14 @@ hledger-web, and other accounting systems), rather than postings
$ hledger-ui --register checking desc:market $ 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 ## Error screen
This screen will appear if there is a problem, such as a parse error, This screen will appear if there is a problem, such as a parse error,

View File

@ -83,4 +83,5 @@ executable hledger-ui
Hledger.UI.AccountsScreen Hledger.UI.AccountsScreen
Hledger.UI.ErrorScreen Hledger.UI.ErrorScreen
Hledger.UI.RegisterScreen Hledger.UI.RegisterScreen
Hledger.UI.TransactionScreen
default-language: Haskell2010 default-language: Haskell2010