hledger-ui (formerly hledger-vty) is now built on brick, a new declarative UI layer built on vty. This brings much new power, and should make the UI much easier to grow and maintain. At this point, functionality and performance are similar to the old version. There's no journal entries screen, but entering the postings screen jumps to the latest posting, and layout is better (multiple commodities are rendered on one line). Requires unreleased brick from github (HEAD or some branch) for now.
		
			
				
	
	
		
			101 lines
		
	
	
		
			3.8 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			101 lines
		
	
	
		
			3.8 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| -- The register screen, showing account postings, like the CLI register command.
 | |
| 
 | |
| {-# LANGUAGE OverloadedStrings #-}
 | |
| 
 | |
| module Hledger.UI.RegisterScreen
 | |
|  (screen)
 | |
| where
 | |
| 
 | |
| import Control.Lens ((^.))
 | |
| import Data.List
 | |
| import Data.Time.Calendar (Day)
 | |
| import qualified Data.Vector as V
 | |
| import qualified Graphics.Vty as Vty
 | |
| import qualified Brick.Types as T
 | |
| import qualified Brick.Main as M
 | |
| -- import qualified Brick.AttrMap as A
 | |
| import qualified Brick.Widgets.Border as B
 | |
| import qualified Brick.Widgets.Center as C
 | |
| import qualified Brick.Widgets.List as L
 | |
| -- import Brick.Util (fg, on)
 | |
| import Brick.Widgets.Core
 | |
| 
 | |
| import Hledger
 | |
| import Hledger.Cli hiding (progname,prognameandversion,green)
 | |
| import Hledger.UI.Options
 | |
| import Hledger.UI.UITypes
 | |
| import Hledger.UI.UIUtils
 | |
| 
 | |
| screen = RegisterScreen{
 | |
|    rsState  = L.list "register" V.empty
 | |
|   ,sInitFn    = initRegisterScreen
 | |
|   ,sDrawFn    = drawRegisterScreen
 | |
|   ,sHandleFn = handleRegisterScreen
 | |
|   }
 | |
| 
 | |
| initRegisterScreen :: Day -> [String] -> AppState -> AppState
 | |
| initRegisterScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{}} =
 | |
|   st{aScreen=s{rsState=is'}}
 | |
|   where
 | |
|     is' =
 | |
|       L.listMoveTo (length items) $
 | |
|       L.list (T.Name "register") (V.fromList items)
 | |
|     (_label,items) = postingsReport ropts q j
 | |
|       where
 | |
|         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
 | |
| initRegisterScreen _ _ _ = error "init function called with wrong screen type, should not happen"
 | |
| 
 | |
| drawRegisterScreen :: AppState -> [Widget]
 | |
| drawRegisterScreen AppState{aopts=_opts, aScreen=RegisterScreen{rsState=is}} = [ui]
 | |
|   where
 | |
|     label = "Posting " <+> cur <+> " of " <+> total <+> " in this account and subaccounts" -- " <+> str query <+> "and subaccounts"
 | |
|     cur = case is^.(L.listSelectedL) of
 | |
|             Nothing -> "-"
 | |
|             Just i -> str (show (i + 1))
 | |
|     total = str $ show $ length $ is^.(L.listElementsL)
 | |
|     -- query = query_ $ reportopts_ $ cliopts_ opts
 | |
|     box = B.borderWithLabel label $
 | |
|           -- hLimit 25 $
 | |
|           -- vLimit 15 $
 | |
|           L.renderList is drawRegisterItem 1
 | |
|     ui = box
 | |
|     _ui = C.vCenter $ vBox [ C.hCenter box
 | |
|                           , " "
 | |
|                           , C.hCenter "Press Esc to exit."
 | |
|                           ]
 | |
| drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen"
 | |
| 
 | |
| drawRegisterItem :: Bool -> PostingsReportItem -> Widget
 | |
| drawRegisterItem sel item =
 | |
|   let selStr i = if sel
 | |
|                  then withAttr customAttr (str $ showitem i)
 | |
|                  else str $ showitem i
 | |
|       showitem (_,_,_,p,b) =
 | |
|         intercalate ", " $ map strip $ lines $ 
 | |
|         postingsReportItemAsText defcliopts $
 | |
|         mkpostingsReportItem True True PrimaryDate Nothing p b
 | |
|       -- fmt = BottomAligned [
 | |
|       --     FormatField False (Just 20) Nothing TotalField
 | |
|       --   , FormatLiteral "  "
 | |
|       --   , FormatField True (Just 2) Nothing DepthSpacerField
 | |
|       --   , FormatField True Nothing Nothing AccountField
 | |
|       --   ]
 | |
|   in
 | |
|    selStr item
 | |
| 
 | |
| handleRegisterScreen :: AppState -> Vty.Event -> M.EventM (M.Next AppState)
 | |
| handleRegisterScreen st@AppState{aScreen=s@RegisterScreen{rsState=is}} e =
 | |
|   case e of
 | |
|     Vty.EvKey Vty.KEsc []        -> M.halt st
 | |
|     Vty.EvKey (Vty.KChar 'q') [] -> M.halt st
 | |
|     Vty.EvKey (Vty.KLeft) []     -> M.continue $ popScreen st
 | |
|     -- Vty.EvKey (Vty.KRight) []    -> error (show curItem) where curItem = L.listSelectedElement is
 | |
|     -- fall through to the list's event handler (handles up/down)
 | |
|     ev                       -> M.continue st{aScreen=s{rsState=T.handleEvent ev is}}
 | |
| handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen"
 |