diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index b1779a1ed..4ffc9da94 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -10,6 +10,7 @@ hierarchy. module Hledger.Data.AccountName where import Data.List +import Data.List.Split (splitOn) import Data.Tree import Test.HUnit import Text.Printf @@ -31,6 +32,15 @@ accountNameFromComponents = concat . intersperse [acctsepchar] accountLeafName :: AccountName -> String accountLeafName = last . accountNameComponents +accountSummarisedName :: AccountName -> String +accountSummarisedName a + -- | length cs > 1 = take 2 (head cs) ++ ":" ++ a' + | length cs > 1 = intercalate ":" (map (take 2) $ init cs) ++ ":" ++ a' + | otherwise = a' + where + cs = accountNameComponents a + a' = accountLeafName a + accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 accountNameLevel a = length (filter (==acctsepchar) a) + 1 @@ -100,7 +110,18 @@ nullaccountnametree = Node "root" [] -- ..:Af:Lu:Sn:Ca:Ch:Cash ; Abbreviated and elided! -- @ elideAccountName :: Int -> AccountName -> AccountName -elideAccountName width s = +elideAccountName width s + -- XXX special case for transactions register's multi-account pseudo-names + | " (split)" `isSuffixOf` s = + let + names = splitOn ", " $ take (length s - 8) s + widthpername = (max 0 (width - 8 - 2 * (max 1 (length names) - 1))) `div` length names + in + elideLeft width $ + (++" (split)") $ + intercalate ", " $ + [accountNameFromComponents $ elideparts widthpername [] $ accountNameComponents s' | s' <- names] + | otherwise = elideLeft width $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s where elideparts :: Int -> [String] -> [String] -> [String] diff --git a/hledger-lib/Hledger/Reports/TransactionsReports.hs b/hledger-lib/Hledger/Reports/TransactionsReports.hs index 33cd80f40..cc1f72b22 100644 --- a/hledger-lib/Hledger/Reports/TransactionsReports.hs +++ b/hledger-lib/Hledger/Reports/TransactionsReports.hs @@ -11,6 +11,8 @@ a some base account. They are used by hledger-web. module Hledger.Reports.TransactionsReports ( TransactionsReport, TransactionsReportItem, + AccountTransactionsReport, + AccountTransactionsReportItem, triOrigTransaction, triDate, triAmount, @@ -78,15 +80,16 @@ journalTransactionsReport opts j q = (totallabel, items) -- | An account transactions report represents transactions affecting -- a particular account (or possibly several accounts, but we don't --- use that). It is used by hledger-web's account register view, where --- we want to show one row per journal transaction, with: +-- use that). It is used by hledger-web's (and hledger-ui's) account +-- register view, where we want to show one row per journal +-- transaction, with: -- -- - the total increase/decrease to the current account -- -- - the names of the other account(s) posted to/from -- --- - transaction dates adjusted to the date of the earliest posting to --- the current account, if those postings have their own dates +-- - transaction dates, adjusted to the date of the earliest posting to +-- the current account if those postings have their own dates -- -- Currently, reporting intervals are not supported, and report items -- are most recent first. @@ -199,7 +202,7 @@ accountTransactionsReportItems query thisacctquery bal signfn (torig:ts) = -- | Generate a simplified summary of some postings' accounts. summarisePostingAccounts :: [Posting] -> String -summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount +summarisePostingAccounts = intercalate ", " . map accountSummarisedName . nub . map paccount filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps} diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 60f232d6b..aeea0196b 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -26,7 +26,7 @@ import Hledger.Cli hiding (progname,prognameandversion,green) import Hledger.UI.Options import Hledger.UI.UITypes import Hledger.UI.UIUtils -import qualified Hledger.UI.RegisterScreen as RS (screen) +import qualified Hledger.UI.RegisterScreen2 as RS2 (screen) screen = AccountsScreen{ asState = list "accounts" V.empty 1 @@ -105,7 +105,7 @@ handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey (Vty.KRight) [] -> continue st' where - st' = screenEnter d args RS.screen st + st' = screenEnter d args RS2.screen st args = case listSelectedElement is of Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct] Nothing -> [] diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index f423aa160..c14b8100d 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -4,20 +4,27 @@ Copyright (c) 2007-2015 Simon Michael Released under GPL version 3 or later. TODO: -reg: don't repeat date/description for postings in same txn -reg: show a hledger-web-style register +show journal entries -- switch to next brick release -reg: use full width -reg: keep cursor at bottom of screen when jumping to end -page up/down -home/end + reg: use full width + home/end + keep cursor at bottom of screen if jumping to end + reg2: find subaccounts' transactions better + reg2: track current account better + reg2: track current query better +-- +-H +--drop search filter --- -show journal entries +depth adjustment add edit +options adjustment +reload on screen change +reload on redraw +reload on file change -} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -45,14 +52,15 @@ import Hledger.UI.Options import Hledger.UI.UITypes import Hledger.UI.UIUtils import Hledger.UI.AccountsScreen as AS -import Hledger.UI.RegisterScreen as RS +-- import Hledger.UI.RegisterScreen as RS +import Hledger.UI.RegisterScreen2 as RS2 ---------------------------------------------------------------------- -- | The available screens. appScreens = [ AS.screen - ,RS.screen + ,RS2.screen ] main :: IO () diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 19363d91a..29caa27d3 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -98,6 +98,6 @@ handleRegisterScreen st@AppState{aScreen=s@RegisterScreen{rsState=is}} e = -- fall through to the list's event handler (handles [pg]up/down) ev -> do is' <- handleEvent ev is - continue $ st{aScreen=s{rsState=is'}} + continue st{aScreen=s{rsState=is'}} -- continue =<< handleEventLensed st someLens ev handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen" diff --git a/hledger-ui/Hledger/UI/RegisterScreen2.hs b/hledger-ui/Hledger/UI/RegisterScreen2.hs new file mode 100644 index 000000000..2e4d86362 --- /dev/null +++ b/hledger-ui/Hledger/UI/RegisterScreen2.hs @@ -0,0 +1,125 @@ +-- The register screen, showing account postings, like the CLI register command. + +{-# LANGUAGE OverloadedStrings #-} + +module Hledger.UI.RegisterScreen2 + (screen) +where + +import Control.Lens ((^.)) +-- import Control.Monad.IO.Class (liftIO) +import Data.List +import Data.List.Split (splitOn) +import Data.Time.Calendar (Day) +import qualified Data.Vector as V +import qualified Graphics.Vty as Vty +import Brick +import Brick.Widgets.List +import Brick.Widgets.Border +import Brick.Widgets.Center + +import Hledger +import Hledger.Cli hiding (progname,prognameandversion,green) +import Hledger.UI.Options +import Hledger.UI.UITypes +import Hledger.UI.UIUtils + +screen = RegisterScreen2{ + rs2State = list "register" V.empty 1 + ,sInitFn = initRegisterScreen2 + ,sDrawFn = drawRegisterScreen2 + ,sHandleFn = handleRegisterScreen2 + } + +initRegisterScreen2 :: Day -> [String] -> AppState -> AppState +initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{}} = + st{aScreen=s{rs2State=is'}} + where + is' = + -- listMoveTo (length items) $ + list (Name "register") (V.fromList items) 1 + + (_label,items) = accountTransactionsReport ropts j thisacctq q + where + -- XXX temp + curacct = drop 5 $ head args -- should be "acct:..." + thisacctq = Acct $ curacct -- XXX why is this excluding subs: accountNameToAccountRegex curacct + + q = queryFromOpts d ropts + -- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items + --{query_=unwords' $ locArgs l} + ropts = (reportopts_ cliopts) + {query_=unwords' args} + cliopts = cliopts_ opts +initRegisterScreen2 _ _ _ = error "init function called with wrong screen type, should not happen" + +drawRegisterScreen2 :: AppState -> [Widget] +drawRegisterScreen2 AppState{aopts=_opts, aScreen=RegisterScreen2{rs2State=is}} = [ui] + where + label = str "Transaction " + <+> cur + <+> str " of " + <+> total + <+> str " to/from this account" -- " <+> str query <+> "and subaccounts" + cur = str $ case is^.(listSelectedL) of + Nothing -> "-" + Just i -> show (i + 1) + total = str $ show $ length $ is^.(listElementsL) + -- query = query_ $ reportopts_ $ cliopts_ opts + box = borderWithLabel label $ + -- hLimit 25 $ + -- vLimit 15 $ + renderList is drawRegisterItem + ui = box + _ui = vCenter $ vBox [ hCenter box + , str " " + , hCenter $ str "Press Esc to exit." + ] +drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen" + +drawRegisterItem :: Bool -> AccountTransactionsReportItem -> Widget +drawRegisterItem sel item = + + -- (w,_) <- getViewportSize "register" -- getCurrentViewportSize + -- st@AppState{aopts=opts} <- getAppState + -- let opts' = opts{width_=Just $ show w} + + let selStr i = if sel + then withAttr customAttr (str $ showitem i) + else str $ showitem i + showitem (_origt,t,split,acctsstr,postedamt,totalamt) = + -- make a fake posting to render + let p = nullposting{ + pdate=Just $ tdate t + ,paccount=if split then intercalate ", " acctnames ++" (split)" else acctsstr + -- XXX elideAccountName doesn't elide combined split names well + ,pamount=postedamt + ,ptransaction=Just t + } + acctnames = nub $ sort $ splitOn ", " acctsstr -- XXX + in + intercalate ", " $ map strip $ lines $ + postingsReportItemAsText defcliopts{width_=Just "160"} $ -- XXX + mkpostingsReportItem True True PrimaryDate Nothing p totalamt + -- fmt = BottomAligned [ + -- FormatField False (Just 20) Nothing TotalField + -- , FormatLiteral " " + -- , FormatField True (Just 2) Nothing DepthSpacerField + -- , FormatField True Nothing Nothing AccountField + -- ] + in + selStr item + +handleRegisterScreen2 :: AppState -> Vty.Event -> EventM (Next AppState) +handleRegisterScreen2 st@AppState{aopts=_opts,aScreen=s@RegisterScreen2{rs2State=is}} e = do + case e of + Vty.EvKey Vty.KEsc [] -> halt st + Vty.EvKey (Vty.KChar 'q') [] -> halt st + Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st + -- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is + -- fall through to the list's event handler (handles [pg]up/down) + ev -> do + is' <- handleEvent ev is + continue st{aScreen=s{rs2State=is'}} + -- continue =<< handleEventLensed st someLens ev +handleRegisterScreen2 _ _ = error "event handler called with wrong screen type, should not happen" diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index a0f337f6a..0b1fb4092 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -37,5 +37,11 @@ data Screen = ,sDrawFn :: AppState -> [Widget] } deriving (Show) + | RegisterScreen2 { + rs2State :: List AccountTransactionsReportItem + ,sInitFn :: Day -> [String] -> AppState -> AppState + ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) + ,sDrawFn :: AppState -> [Widget] + } instance Show (List a) where show _ = "" diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 133d0ff46..43dd47d71 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -78,4 +78,5 @@ executable hledger-ui Hledger.UI.UIUtils Hledger.UI.AccountsScreen Hledger.UI.RegisterScreen + Hledger.UI.RegisterScreen2 default-language: Haskell2010