131 lines
5.1 KiB
Haskell
131 lines
5.1 KiB
Haskell
-- The transaction screen, showing a single transaction's general journal entry.
|
|
|
|
{-# LANGUAGE OverloadedStrings, TupleSections #-} -- , FlexibleContexts
|
|
|
|
module Hledger.UI.TransactionScreen
|
|
(screen
|
|
)
|
|
where
|
|
|
|
-- import Control.Lens ((^.))
|
|
import Control.Monad.IO.Class (liftIO)
|
|
-- import Data.List
|
|
-- import Data.List.Split (splitOn)
|
|
-- import Data.Ord
|
|
import Data.Monoid
|
|
-- import Data.Maybe
|
|
import Data.Time.Calendar (Day)
|
|
-- import qualified Data.Vector as V
|
|
import Graphics.Vty as Vty
|
|
-- import Safe (headDef, lastDef)
|
|
import Brick
|
|
import Brick.Widgets.List (listMoveTo)
|
|
-- 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 = ((1,nulltransaction),[(1,nulltransaction)],"")
|
|
,sInitFn = initTransactionScreen
|
|
,sDrawFn = drawTransactionScreen
|
|
,sHandleFn = handleTransactionScreen
|
|
}
|
|
|
|
initTransactionScreen :: Day -> AppState -> AppState
|
|
initTransactionScreen _d st@AppState{aopts=_opts, ajournal=_j, aScreen=_s@TransactionScreen{tsState=_}} = st
|
|
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=((i,t),nts,acct)}} = [ui]
|
|
where
|
|
-- datedesc = show (tdate t) ++ " " ++ tdescription 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)++" in "++acct++")")
|
|
bottomlabel = borderKeysStr [
|
|
("left", "back")
|
|
,("up/down", "prev/next")
|
|
,("g", "reload")
|
|
,("q", "quit")
|
|
]
|
|
ui = Widget Greedy Greedy $ do
|
|
render $ defaultLayout toplabel bottomlabel $ str $ showTransactionUnelidedOneLineAmounts 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=((i,t),nts,acct)}
|
|
,aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
|
,ajournal=j
|
|
} e = do
|
|
d <- liftIO getCurrentDay
|
|
let
|
|
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
|
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
|
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' -> do
|
|
-- got to redo the register screen's transactions report, to get the latest transactions list for this screen
|
|
-- XXX duplicates initRegisterScreen
|
|
let
|
|
ropts' = ropts {depth_=Nothing
|
|
,balancetype_=HistoricalBalance
|
|
}
|
|
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
|
|
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
|
|
items = reverse $ snd $ accountTransactionsReport ropts j' q thisacctq
|
|
ts = map first6 items
|
|
numberedts = zip [1..] ts
|
|
-- select the best current transaction from the new list
|
|
-- stay at the same index if possible, or if we are now past the end, select the last, otherwise select the first
|
|
(i',t') = case lookup i numberedts
|
|
of Just t'' -> (i,t'')
|
|
Nothing | null numberedts -> (0,nulltransaction)
|
|
| i > fst (last numberedts) -> last numberedts
|
|
| otherwise -> head numberedts
|
|
st' = st{aScreen=s{tsState=((i',t'),numberedts,acct)}}
|
|
continue $ reload j' d st'
|
|
|
|
Left err -> continue $ screenEnter d ES.screen{esState=err} st
|
|
|
|
-- Vty.EvKey (Vty.KChar 'C') [] -> continue $ reload j d $ stToggleCleared st
|
|
|
|
Vty.EvKey (Vty.KUp) [] -> continue $ reload j d st{aScreen=s{tsState=((iprev,tprev),nts,acct)}}
|
|
Vty.EvKey (Vty.KDown) [] -> continue $ reload j d st{aScreen=s{tsState=((inext,tnext),nts,acct)}}
|
|
|
|
Vty.EvKey (Vty.KLeft) [] -> continue st''
|
|
where
|
|
st'@AppState{aScreen=scr} = popScreen st
|
|
st'' = st'{aScreen=rsSetSelectedTransaction (fromIntegral i) scr}
|
|
|
|
_ev -> continue st
|
|
|
|
handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen"
|
|
|
|
rsSetSelectedTransaction i scr@RegisterScreen{rsState=(l,a)} = scr{rsState=(l',a)}
|
|
where l' = listMoveTo (i-1) l
|
|
rsSetSelectedTransaction _ scr = scr
|
|
|