-- The transaction screen, showing a single transaction's general journal entry.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module Hledger.UI.TransactionScreen
(tsNew
,tsUpdate
,tsDraw
,tsHandle
) where

import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft))
import Brick
import Brick.Widgets.List (listMoveTo)

import Hledger
import Hledger.Cli hiding (mode, prices, progname,prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.Editor
import Brick.Widgets.Edit (editorText, renderEditor)
import Hledger.UI.ErrorScreen (uiReloadJournalIfChanged, uiCheckBalanceAssertions, uiReloadJournal)

tsDraw :: UIState -> [Widget Name]
tsDraw :: UIState -> [Widget Name]
tsDraw UIState{aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}}}
              ,ajournal :: UIState -> Journal
ajournal=Journal
j
              ,aScreen :: UIState -> Screen
aScreen=TS TSS{_tssTransaction :: TransactionScreenState -> NumberedTransaction
_tssTransaction=(Integer
i,Transaction
t')
                              ,_tssTransactions :: TransactionScreenState -> [NumberedTransaction]
_tssTransactions=[NumberedTransaction]
nts
                              ,_tssAccount :: TransactionScreenState -> AccountName
_tssAccount=AccountName
acct
                              }
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } =
  case Mode
mode of
    Mode
Help       -> [Widget Name
helpDialog, Widget Name
maincontent]
    Mode
_          -> [Widget Name
maincontent]
  where
    maincontent :: Widget Name
maincontent = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout Widget Name
toplabel Widget Name
bottomlabel Widget Name
txneditor
      where
        -- as with print, show amounts with all of their decimal places
        t :: Transaction
t = (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision Transaction
t'

        -- XXX would like to shrink the editor to the size of the entry,
        -- so handler can more easily detect clicks below it
        txneditor :: Widget Name
txneditor =
          forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. AccountName -> Widget n
txt) Bool
False forall a b. (a -> b) -> a -> b
$
          forall n. n -> Maybe Int -> AccountName -> Editor AccountName n
editorText Name
TransactionEditor forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
          ReportOpts -> ReportSpec -> Journal -> Transaction -> AccountName
showTxn ReportOpts
ropts ReportSpec
rspec Journal
j Transaction
t

        toplabel :: Widget Name
toplabel =
          forall n. [Char] -> Widget n
str [Char]
"Transaction "
          -- <+> withAttr ("border" <> "bold") (str $ "#" ++ show (tindex t))
          -- <+> str (" ("++show i++" of "++show (length nts)++" in "++acct++")")
          forall n. Widget n -> Widget n -> Widget n
<+> (forall n. [Char] -> Widget n
str forall a b. (a -> b) -> a -> b
$ [Char]
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Transaction -> Integer
tindex Transaction
t))
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. [Char] -> Widget n
str [Char]
" ("
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"bold") (forall n. [Char] -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Integer
i)
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. [Char] -> Widget n
str ([Char]
" of "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [NumberedTransaction]
nts))
          forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
togglefilters
          forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget Name
borderQueryStr ([[Char]] -> [Char]
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
quoteIfNeeded forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> [Char]
T.unpack) forall a b. (a -> b) -> a -> b
$ ReportOpts -> [AccountName]
querystring_ ReportOpts
ropts)
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. [Char] -> Widget n
str ([Char]
" in "forall a. [a] -> [a] -> [a]
++AccountName -> [Char]
T.unpack (AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"All" AccountName
acct)forall a. [a] -> [a] -> [a]
++[Char]
")")
          forall n. Widget n -> Widget n -> Widget n
<+> (if BalancingOpts -> Bool
ignore_assertions_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> BalancingOpts
balancingopts_ forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts then forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") (forall n. [Char] -> Widget n
str [Char]
" ignoring balance assertions") else forall n. [Char] -> Widget n
str [Char]
"")
          where
            togglefilters :: Widget n
togglefilters =
              case forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                   CliOpts -> [Status] -> [[Char]]
uiShowStatus CliOpts
copts forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Status]
statuses_ ReportOpts
ropts
                  ,if ReportOpts -> Bool
real_ ReportOpts
ropts then [[Char]
"real"] else []
                  ,if ReportOpts -> Bool
empty_ ReportOpts
ropts then [] else [[Char]
"nonzero"]
                  ] of
                [] -> forall n. [Char] -> Widget n
str [Char]
""
                [[Char]]
fs -> forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") (forall n. [Char] -> Widget n
str forall a b. (a -> b) -> a -> b
$ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
fs)

        bottomlabel :: Widget Name
bottomlabel = Widget Name
quickhelp
                        -- case mode of
                        -- Minibuffer ed -> minibuffer ed
                        -- _             -> quickhelp
          where
            quickhelp :: Widget Name
quickhelp = [([Char], [Char])] -> Widget Name
borderKeysStr [
               ([Char]
"LEFT", [Char]
"back")
              ,([Char]
"UP/DOWN", [Char]
"prev/next txn")
              --,("ESC", "cancel/top")
              -- ,("a", "add")
              ,([Char]
"E", [Char]
"edit")
              ,([Char]
"g", [Char]
"reload")
              ,([Char]
"?", [Char]
"help")
              -- ,("q", "quit")
              ]

tsDraw UIState
_ = forall a. [Char] -> a
errorWrongScreenType [Char]
"draw function"  -- PARTIAL:

-- Render a transaction suitably for the transaction screen.
showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text
showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> AccountName
showTxn ReportOpts
ropts ReportSpec
rspec Journal
j Transaction
t =
      Transaction -> AccountName
showTransactionOneLineAmounts
    forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (PriceOracle
-> Map AccountName AmountStyle
-> Day
-> Day
-> ValuationType
-> Transaction
-> Transaction
transactionApplyValuation PriceOracle
prices Map AccountName AmountStyle
styles Day
periodlast (ReportSpec -> Day
_rsDay ReportSpec
rspec)) (ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts)
    forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ConversionOp -> Transaction -> Transaction
transactionToCost (ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts) Transaction
t
    -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
  where
    prices :: PriceOracle
prices = Bool -> Journal -> PriceOracle
journalPriceOracle (ReportOpts -> Bool
infer_prices_ ReportOpts
ropts) Journal
j
    styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
    periodlast :: Day
periodlast =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. [Char] -> a
error' [Char]
"TransactionScreen: expected a non-empty journal") forall a b. (a -> b) -> a -> b
$  -- PARTIAL: shouldn't happen
      ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ReportSpec
rspec Journal
j

tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
tsHandle BrickEvent Name AppEvent
ev = do
  UIState
ui0 <- EventM Name UIState UIState
get'
  case UIState
ui0 of
    ui :: UIState
ui@UIState{aScreen :: UIState -> Screen
aScreen=TS TSS{_tssTransaction :: TransactionScreenState -> NumberedTransaction
_tssTransaction=(Integer
i,Transaction
t), _tssTransactions :: TransactionScreenState -> [NumberedTransaction]
_tssTransactions=[NumberedTransaction]
nts}
              ,aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}
              ,ajournal :: UIState -> Journal
ajournal=Journal
j
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } ->
      case Mode
mode of
        Mode
Help ->
          case BrickEvent Name AppEvent
ev of
            -- VtyEvent (EvKey (KChar 'q') []) -> halt
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
helpHandle BrickEvent Name AppEvent
ev

        Mode
_ -> do
          Day
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
          let
            (Integer
iprev,Transaction
tprev) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer
i,Transaction
t) ((Integer
iforall a. Num a => a -> a -> a
-Integer
1),) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Integer
iforall a. Num a => a -> a -> a
-Integer
1) [NumberedTransaction]
nts
            (Integer
inext,Transaction
tnext) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer
i,Transaction
t) ((Integer
iforall a. Num a => a -> a -> a
+Integer
1),) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Integer
iforall a. Num a => a -> a -> a
+Integer
1) [NumberedTransaction]
nts
          case BrickEvent Name AppEvent
ev of
            VtyEvent (EvKey (KChar Char
'q') []) -> forall a s. EventM a s ()
halt
            VtyEvent (EvKey Key
KEsc        []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
resetScreens Day
d UIState
ui
            VtyEvent (EvKey (KChar Char
c)   []) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'?' -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Mode -> UIState -> UIState
setMode Mode
Help UIState
ui
            VtyEvent (EvKey (KChar Char
'E') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> [Char] -> IO ExitCode
runEditor Maybe TextPosition
pos [Char]
f) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
              where
                (Maybe TextPosition
pos,[Char]
f) = case Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t of
                            (SourcePos [Char]
f' Pos
l1 Pos
c1,SourcePos
_) -> (forall a. a -> Maybe a
Just (Pos -> Int
unPos Pos
l1, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos Pos
c1),[Char]
f')
            AppEvent (DateChange Day
old Day
_) | Period -> Bool
isStandardPeriod Period
p Bool -> Bool -> Bool
&& Period
p Period -> Day -> Bool
`periodContainsDate` Day
old ->
              UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
              where
                p :: Period
p = UIState -> Period
reportPeriod UIState
ui

            -- Reload. Warning, this updates parent screens but not the transaction screen itself (see tsUpdate).
            -- To see the updated transaction, one must exit and re-enter the transaction screen.
            BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') []), forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange] ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
                -- debugging.. leaving these here because they were hard to find
                -- \u -> dbguiEv (pshow u) >> put' u  -- doesn't log
                -- \UIState{aScreen=TS tss} -> error $ pshow $ _tssTransaction tss

            VtyEvent (EvKey (KChar Char
'I') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
toggleIgnoreBalanceAssertions UIState
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') [] -> put' $ regenerateScreens j d $ stToggleEmpty ui
            -- EvKey (KChar 'C') [] -> put' $ regenerateScreens j d $ stToggleCleared ui
            -- EvKey (KChar 'R') [] -> put' $ regenerateScreens j d $ stToggleReal ui
            VtyEvent (EvKey (KChar Char
'B') []) -> UIState -> EventM Name UIState ()
put' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleConversionOp UIState
ui
            VtyEvent (EvKey (KChar Char
'V') []) -> UIState -> EventM Name UIState ()
put' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleValue UIState
ui

            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveUpEvents   -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
iprev Transaction
tprev UIState
ui
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
inext Transaction
tnext UIState
ui

            -- exit screen on LEFT
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveLeftEvents -> UIState -> EventM Name UIState ()
put' forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIState -> UIState
popScreen forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
i Transaction
t UIState
ui  -- Probably not necessary to tsSelect here, but it's safe.
            -- or on a click in the app's left margin.
            VtyEvent (EvMouseUp Int
x Int
_y (Just Button
BLeft)) | Int
xforall a. Eq a => a -> a -> Bool
==Int
0 -> UIState -> EventM Name UIState ()
put' forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIState -> UIState
popScreen forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
i Transaction
t UIState
ui

            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            BrickEvent Name AppEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    UIState
_ -> forall a. [Char] -> a
errorWrongScreenType [Char]
"event handler"

-- | Select a new transaction and update the previous register screen
tsSelect :: Integer -> Transaction -> UIState -> UIState
tsSelect :: Integer -> Transaction -> UIState -> UIState
tsSelect Integer
i Transaction
t ui :: UIState
ui@UIState{aScreen :: UIState -> Screen
aScreen=TS TransactionScreenState
sst} = case UIState -> [Screen]
aPrevScreens UIState
ui of
    Screen
x:[Screen]
xs -> UIState
ui'{aPrevScreens :: [Screen]
aPrevScreens=Integer -> Screen -> Screen
rsSelect Integer
i Screen
x forall a. a -> [a] -> [a]
: [Screen]
xs}
    []   -> UIState
ui'
  where ui' :: UIState
ui' = UIState
ui{aScreen :: Screen
aScreen=TransactionScreenState -> Screen
TS TransactionScreenState
sst{_tssTransaction :: NumberedTransaction
_tssTransaction=(Integer
i,Transaction
t)}}
tsSelect Integer
_ Transaction
_ UIState
ui = UIState
ui

-- | Select the nth item on the register screen.
rsSelect :: Integer -> Screen -> Screen
rsSelect :: Integer -> Screen -> Screen
rsSelect Integer
i (RS sst :: RegisterScreenState
sst@RSS{Bool
AccountName
List Name RegisterScreenItem
_rssList :: RegisterScreenState -> List Name RegisterScreenItem
_rssForceInclusive :: RegisterScreenState -> Bool
_rssAccount :: RegisterScreenState -> AccountName
_rssList :: List Name RegisterScreenItem
_rssForceInclusive :: Bool
_rssAccount :: AccountName
..}) = RegisterScreenState -> Screen
RS RegisterScreenState
sst{_rssList :: List Name RegisterScreenItem
_rssList=forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Integer
iforall a. Num a => a -> a -> a
-Integer
1) List Name RegisterScreenItem
_rssList}
rsSelect Integer
_ Screen
scr = Screen
scr