603b2e9f09
This increases composability and avoids some ugly case handling. We re-export runExceptT in Hledger.Read. The final return types of the following functions has been changed from IO (Either String a) to ExceptT String IO a. If this causes a problem, you can get the old behaviour by calling runExceptT on the output: readJournal, readJournalFiles, readJournalFile Or, you can use the easy functions readJournal', readJournalFiles', and readJournalFile', which assume default options and return in the IO monad.
218 lines
9.8 KiB
Haskell
218 lines
9.8 KiB
Haskell
-- The transaction screen, showing a single transaction's general journal entry.
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Hledger.UI.TransactionScreen
|
|
( transactionScreen
|
|
) where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Except (liftIO)
|
|
import Data.List
|
|
import Data.Maybe
|
|
import qualified Data.Text as T
|
|
import Data.Time.Calendar (Day)
|
|
import qualified Data.Vector as V
|
|
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft))
|
|
import Lens.Micro ((^.))
|
|
import Brick
|
|
import Brick.Widgets.List (listElementsL, listMoveTo, listSelectedElement)
|
|
|
|
import Hledger
|
|
import Hledger.Cli hiding (progname,prognameandversion)
|
|
import Hledger.UI.UIOptions
|
|
-- import Hledger.UI.Theme
|
|
import Hledger.UI.UITypes
|
|
import Hledger.UI.UIState
|
|
import Hledger.UI.UIUtils
|
|
import Hledger.UI.Editor
|
|
import Hledger.UI.ErrorScreen
|
|
import Brick.Widgets.Edit (editorText, renderEditor)
|
|
|
|
transactionScreen :: Screen
|
|
transactionScreen = TransactionScreen{
|
|
sInit = tsInit
|
|
,sDraw = tsDraw
|
|
,sHandle = tsHandle
|
|
,tsTransaction = (1,nulltransaction)
|
|
,tsTransactions = [(1,nulltransaction)]
|
|
,tsAccount = ""
|
|
}
|
|
|
|
tsInit :: Day -> Bool -> UIState -> UIState
|
|
tsInit _d _reset ui@UIState{aopts=UIOpts{}
|
|
,ajournal=_j
|
|
,aScreen=s@TransactionScreen{tsTransaction=(_,t),tsTransactions=nts}
|
|
,aPrevScreens=prevscreens
|
|
} =
|
|
ui{aScreen=s{tsTransaction=(i',t'),tsTransactions=nts'}}
|
|
where
|
|
i' = maybe 0 (toInteger . (+1)) . elemIndex t' $ map snd nts'
|
|
-- If the previous screen was RegisterScreen, use the listed and selected items as
|
|
-- the transactions. Otherwise, use the provided transaction and list.
|
|
(t',nts') = case prevscreens of
|
|
RegisterScreen{rsList=xs}:_ -> (seltxn, zip [1..] $ map rsItemTransaction nonblanks)
|
|
where
|
|
seltxn = maybe nulltransaction (rsItemTransaction . snd) $ listSelectedElement xs
|
|
nonblanks = V.toList . V.takeWhile (not . T.null . rsItemDate) $ xs ^. listElementsL
|
|
_ -> (t, nts)
|
|
tsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
|
|
|
-- Render a transaction suitably for the transaction screen.
|
|
showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text
|
|
showTxn ropts rspec j t =
|
|
showTransactionOneLineAmounts
|
|
$ maybe id (transactionApplyValuation prices styles periodlast (_rsDay rspec)) (value_ ropts)
|
|
$ maybe id (transactionToCost styles) (conversionop_ ropts) t
|
|
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
|
|
where
|
|
prices = journalPriceOracle (infer_prices_ ropts) j
|
|
styles = journalCommodityStyles j
|
|
periodlast =
|
|
fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
|
|
reportPeriodOrJournalLastDay rspec j
|
|
|
|
tsDraw :: UIState -> [Widget Name]
|
|
tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
|
,ajournal=j
|
|
,aScreen=TransactionScreen{tsTransaction=(i,t')
|
|
,tsTransactions=nts
|
|
,tsAccount=acct
|
|
}
|
|
,aMode=mode
|
|
} =
|
|
case mode of
|
|
Help -> [helpDialog copts, maincontent]
|
|
-- Minibuffer e -> [minibuffer e, maincontent]
|
|
_ -> [maincontent]
|
|
where
|
|
maincontent = Widget Greedy Greedy $ render $ defaultLayout toplabel bottomlabel txneditor
|
|
where
|
|
-- as with print, show amounts with all of their decimal places
|
|
t = transactionMapPostingAmounts mixedAmountSetFullPrecision t'
|
|
|
|
-- XXX would like to shrink the editor to the size of the entry,
|
|
-- so handler can more easily detect clicks below it
|
|
txneditor =
|
|
renderEditor (vBox . map txt) False $
|
|
editorText TransactionEditor Nothing $
|
|
showTxn ropts rspec j t
|
|
|
|
toplabel =
|
|
str "Transaction "
|
|
-- <+> withAttr ("border" <> "bold") (str $ "#" ++ show (tindex t))
|
|
-- <+> str (" ("++show i++" of "++show (length nts)++" in "++acct++")")
|
|
<+> (str $ "#" ++ show (tindex t))
|
|
<+> str " ("
|
|
<+> withAttr ("border" <> "bold") (str $ show i)
|
|
<+> str (" of "++show (length nts))
|
|
<+> togglefilters
|
|
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
|
|
<+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")")
|
|
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "")
|
|
where
|
|
togglefilters =
|
|
case concat [
|
|
uiShowStatus copts $ statuses_ ropts
|
|
,if real_ ropts then ["real"] else []
|
|
,if empty_ ropts then [] else ["nonzero"]
|
|
] of
|
|
[] -> str ""
|
|
fs -> withAttr ("border" <> "query") (str $ " " ++ intercalate ", " fs)
|
|
|
|
bottomlabel = quickhelp
|
|
-- case mode of
|
|
-- Minibuffer ed -> minibuffer ed
|
|
-- _ -> quickhelp
|
|
where
|
|
quickhelp = borderKeysStr [
|
|
("?", "help")
|
|
,("LEFT", "back")
|
|
,("UP/DOWN", "prev/next")
|
|
--,("ESC", "cancel/top")
|
|
-- ,("a", "add")
|
|
,("E", "editor")
|
|
,("g", "reload")
|
|
,("q", "quit")
|
|
]
|
|
|
|
tsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
|
|
|
tsHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
|
tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
|
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
|
,ajournal=j
|
|
,aMode=mode
|
|
}
|
|
ev =
|
|
case mode of
|
|
Help ->
|
|
case ev of
|
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
|
_ -> helpHandle ui ev
|
|
|
|
_ -> do
|
|
let
|
|
d = copts^.rsDay
|
|
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
|
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
|
case ev of
|
|
VtyEvent (EvKey (KChar 'q') []) -> halt ui
|
|
VtyEvent (EvKey KEsc []) -> continue $ resetScreens d ui
|
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> continue $ setMode Help ui
|
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
|
where
|
|
(pos,f) = case tsourcepos t of
|
|
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
|
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
|
continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
|
where
|
|
p = reportPeriod ui
|
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
|
|
-- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return ()
|
|
ej <- liftIO . runExceptT $ journalReload copts
|
|
case ej of
|
|
Left err -> continue $ screenEnter d errorScreen{esError=err} ui
|
|
Right j' -> continue $ regenerateScreens j' d ui
|
|
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
|
|
|
-- for toggles that may change the current/prev/next transactions,
|
|
-- we must regenerate the transaction list, like the g handler above ? with regenerateTransactions ? TODO WIP
|
|
-- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui
|
|
-- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui
|
|
-- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui
|
|
VtyEvent (EvKey (KChar 'B') []) -> continue . regenerateScreens j d $ toggleConversionOp ui
|
|
VtyEvent (EvKey (KChar 'V') []) -> continue . regenerateScreens j d $ toggleValue ui
|
|
|
|
VtyEvent e | e `elem` moveUpEvents -> continue $ tsSelect iprev tprev ui
|
|
VtyEvent e | e `elem` moveDownEvents -> continue $ tsSelect inext tnext ui
|
|
|
|
-- exit screen on LEFT
|
|
VtyEvent e | e `elem` moveLeftEvents -> continue . popScreen $ tsSelect i t ui -- Probably not necessary to tsSelect here, but it's safe.
|
|
-- or on a click in the app's left margin.
|
|
VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> continue . popScreen $ tsSelect i t ui
|
|
-- or on clicking the blank area below the transaction.
|
|
MouseUp _ (Just BLeft) Location{loc=(_,y)} | y+1 > numentrylines -> continue . popScreen $ tsSelect i t ui
|
|
where numentrylines = length (T.lines $ showTxn ropts rspec j t) - 1
|
|
|
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw ui
|
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
|
_ -> continue ui
|
|
|
|
tsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
|
|
|
-- | Select a new transaction and update the previous register screen
|
|
tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
|
|
x:xs -> ui'{aPrevScreens=rsSelect i x : xs}
|
|
[] -> ui'
|
|
where ui' = ui{aScreen=s{tsTransaction=(i,t)}}
|
|
tsSelect _ _ ui = ui
|
|
|
|
-- | Select the nth item on the register screen.
|
|
rsSelect i scr@RegisterScreen{..} = scr{rsList=listMoveTo (fromInteger $ i-1) rsList}
|
|
rsSelect _ scr = scr
|