a simple interactive text ui
Lets you navigate around the balance, register, print reports and the raw ledger, and drill down on a single account. Adds a dependency on vty.
This commit is contained in:
		
							parent
							
								
									b4bdc926dd
								
							
						
					
					
						commit
						dd040f9ca2
					
				
							
								
								
									
										44
									
								
								Options.hs
									
									
									
									
									
								
							
							
						
						
									
										44
									
								
								Options.hs
									
									
									
									
									
								
							| @ -36,27 +36,28 @@ usage = usageInfo usagehdr options ++ usageftr | ||||
| -- | Command-line options we accept. | ||||
| options :: [OptDescr Opt] | ||||
| options = [ | ||||
|  Option ['f'] ["file"]         (ReqArg File "FILE")   filehelp, | ||||
|  Option ['b'] ["begin"]        (ReqArg Begin "DATE") "report on entries on or after this date", | ||||
|  Option ['e'] ["end"]          (ReqArg End "DATE")   "report on entries prior to this date", | ||||
|  Option ['p'] ["period"]       (ReqArg Period "EXPR") ("report on entries during the specified period\n" ++ | ||||
|                                                        "and/or with the specified reporting interval\n"), | ||||
|  Option ['C'] ["cleared"]      (NoArg  Cleared)       "report only on cleared entries", | ||||
|  Option ['B'] ["cost","basis"] (NoArg  CostBasis)     "report cost basis of commodities", | ||||
|  Option []    ["depth"]        (ReqArg Depth "N")     "balance report: maximum account depth to show", | ||||
|  Option ['d'] ["display"]      (ReqArg Display "EXPR") ("display only transactions matching simple EXPR\n" ++ | ||||
|                                                         "(where EXPR is 'dOP[DATE]', OP is <, <=, =, >=, >)"), | ||||
|  Option ['E'] ["empty"]        (NoArg  Empty)         "balance report: show accounts with zero balance", | ||||
|  Option ['R'] ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions", | ||||
|  Option []    ["options-anywhere"] (NoArg OptionsAnywhere) "allow options anywhere, use ^ to negate patterns", | ||||
|  Option ['n'] ["collapse"]     (NoArg  Collapse)      "balance report: no grand total", | ||||
|  Option ['s'] ["subtotal"]     (NoArg  SubTotal)      "balance report: show subaccounts", | ||||
|  Option ['W'] ["weekly"]       (NoArg  WeeklyOpt)        "register report: show weekly summary", | ||||
|  Option ['M'] ["monthly"]      (NoArg  MonthlyOpt)       "register report: show monthly summary", | ||||
|  Option ['Y'] ["yearly"]       (NoArg  YearlyOpt)        "register report: show yearly summary", | ||||
|  Option ['h'] ["help"] (NoArg  Help)                  "show this help", | ||||
|  Option ['v'] ["verbose"]      (NoArg  Verbose)       "verbose test output", | ||||
|  Option ['V'] ["version"]      (NoArg  Version)       "show version" | ||||
|   Option ['f'] ["file"]         (ReqArg File "FILE")   filehelp | ||||
|  ,Option ['b'] ["begin"]        (ReqArg Begin "DATE")  "report on entries on or after this date" | ||||
|  ,Option ['e'] ["end"]          (ReqArg End "DATE")    "report on entries prior to this date" | ||||
|  ,Option ['p'] ["period"]       (ReqArg Period "EXPR") ("report on entries during the specified period\n" ++ | ||||
|                                                        "and/or with the specified reporting interval\n") | ||||
|  ,Option ['C'] ["cleared"]      (NoArg  Cleared)       "report only on cleared entries" | ||||
|  ,Option ['B'] ["cost","basis"] (NoArg  CostBasis)     "report cost basis of commodities" | ||||
|  ,Option []    ["depth"]        (ReqArg Depth "N")     "balance report: maximum account depth to show" | ||||
|  ,Option ['d'] ["display"]      (ReqArg Display "EXPR") ("display only transactions matching simple EXPR\n" ++ | ||||
|                                                         "(where EXPR is 'dOP[DATE]', OP is <, <=, =, >=, >)") | ||||
|  ,Option ['E'] ["empty"]        (NoArg  Empty)         "balance report: show accounts with zero balance" | ||||
|  ,Option ['R'] ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions" | ||||
|  ,Option []    ["options-anywhere"] (NoArg OptionsAnywhere) "allow options anywhere, use ^ to negate patterns" | ||||
|  ,Option ['n'] ["collapse"]     (NoArg  Collapse)      "balance report: no grand total" | ||||
|  ,Option ['s'] ["subtotal"]     (NoArg  SubTotal)      "balance report: show subaccounts" | ||||
|  ,Option ['W'] ["weekly"]       (NoArg  WeeklyOpt)     "register report: show weekly summary" | ||||
|  ,Option ['M'] ["monthly"]      (NoArg  MonthlyOpt)    "register report: show monthly summary" | ||||
|  ,Option ['Y'] ["yearly"]       (NoArg  YearlyOpt)     "register report: show yearly summary" | ||||
|  ,Option ['h'] ["help"] (NoArg  Help)                  "show this help" | ||||
|  ,Option ['v'] ["verbose"]      (NoArg  Verbose)       "verbose test output" | ||||
|  ,Option ['V'] ["version"]      (NoArg  Version)       "show version" | ||||
|  ,Option []    ["debug-no-ui"]  (NoArg  DebugNoUI)     "when running in ui mode, don't display anything (mostly)" | ||||
|  ] | ||||
|     where  | ||||
|       filehelp = printf "ledger file; - means use standard input. Defaults\nto the %s environment variable or %s" | ||||
| @ -83,6 +84,7 @@ data Opt = | ||||
|     Help | | ||||
|     Verbose | | ||||
|     Version | ||||
|     | DebugNoUI | ||||
|     deriving (Show,Eq) | ||||
| 
 | ||||
| -- yow.. | ||||
|  | ||||
							
								
								
									
										381
									
								
								UICommand.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										381
									
								
								UICommand.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,381 @@ | ||||
| {-|  | ||||
| 
 | ||||
| A simple text UI for hledger. | ||||
| 
 | ||||
| -} | ||||
| 
 | ||||
| module UICommand | ||||
| where | ||||
| import qualified Data.Map as Map | ||||
| import Data.Map ((!)) | ||||
| import Graphics.Vty | ||||
| import qualified Data.ByteString.Char8 as B | ||||
| import Ledger | ||||
| import Options | ||||
| import BalanceCommand | ||||
| import RegisterCommand | ||||
| import PrintCommand | ||||
| 
 | ||||
| 
 | ||||
| helpmsg = "Welcome to hledger. (b)alances, (r)egister, (p)rint entries, (l)edger, (right) to drill down, (left) to back up, or (q)uit" | ||||
| 
 | ||||
| instance Show Vty where show v = "a Vty" | ||||
| 
 | ||||
| data AppState = AppState { | ||||
|      av :: Vty                   -- the vty context | ||||
|     ,aw :: Int                   -- window width | ||||
|     ,ah :: Int                   -- window height | ||||
|     ,amsg :: String              -- status message | ||||
|     ,aopts :: [Opt]              -- command-line opts | ||||
|     ,aargs :: [String]           -- command-line args | ||||
|     ,aledger :: Ledger           -- parsed ledger | ||||
|     ,abuf :: [String]            -- lines of the current buffered view | ||||
|     ,alocs :: [Loc]              -- user's navigation trail within the UI | ||||
|                                 -- never null, head is current location | ||||
|     } deriving (Show) | ||||
| 
 | ||||
| data Loc = Loc { | ||||
|      scr :: Screen               -- ui screen | ||||
|     ,sy :: Int                   -- viewport y scroll position | ||||
|     ,cy :: Int                   -- cursor y position | ||||
|     } deriving (Show) | ||||
| 
 | ||||
| data Screen = BalanceScreen     -- like "hledger balance".. shows accounts | ||||
|             | RegisterScreen    -- like "hledger register".. shows transactions | ||||
|             | PrintScreen       -- like "hledger print".. shows entries | ||||
|             | LedgerScreen      -- shows the raw ledger | ||||
|               deriving (Eq,Show) | ||||
| 
 | ||||
| -- | Run the interactive text ui. | ||||
| ui :: [Opt] -> [String] -> Ledger -> IO () | ||||
| ui opts args l = do | ||||
|   v <- mkVty | ||||
|   (w,h) <- getSize v | ||||
|   let opts' = SubTotal:opts | ||||
|   let a = enter BalanceScreen $  | ||||
|           AppState { | ||||
|                   av=v | ||||
|                  ,aw=w | ||||
|                  ,ah=h | ||||
|                  ,amsg=helpmsg | ||||
|                  ,aopts=opts' | ||||
|                  ,aargs=args | ||||
|                  ,aledger=l | ||||
|                  ,abuf=[] | ||||
|                  ,alocs=[] | ||||
|                  } | ||||
|   go a  | ||||
| 
 | ||||
| -- | Update the screen, wait for the next event, repeat. | ||||
| go :: AppState -> IO () | ||||
| go a@AppState{av=av,aw=aw,ah=ah,abuf=buf,amsg=amsg,aopts=opts,aargs=args,aledger=l} = do | ||||
|   when (not $ DebugNoUI `elem` opts) $ update av (renderScreen a) | ||||
|   k <- getEvent av | ||||
|   case k of  | ||||
|     EvResize x y                -> go $ resize x y a | ||||
|     EvKey (KASCII 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg} | ||||
|     EvKey (KASCII 'b') []       -> go $ resetTrailAndEnter BalanceScreen a | ||||
|     EvKey (KASCII 'r') []       -> go $ resetTrailAndEnter RegisterScreen a | ||||
|     EvKey (KASCII 'p') []       -> go $ resetTrailAndEnter PrintScreen a | ||||
|     EvKey (KASCII 'l') []       -> go $ resetTrailAndEnter LedgerScreen a | ||||
|     EvKey KRight []             -> go $ drilldown a | ||||
|     EvKey KEnter []             -> go $ drilldown a | ||||
|     EvKey KLeft  []             -> go $ backout a | ||||
|     EvKey KUp    []             -> go $ moveUpAndPushEdge a | ||||
|     EvKey KDown  []             -> go $ moveDownAndPushEdge a | ||||
|     EvKey KHome  []             -> go $ moveToTop a | ||||
|     EvKey KUp    [MCtrl]        -> go $ moveToTop a | ||||
|     EvKey KUp    [MShift]       -> go $ moveToTop a | ||||
|     EvKey KEnd   []             -> go $ moveToBottom a | ||||
|     EvKey KDown  [MCtrl]        -> go $ moveToBottom a | ||||
|     EvKey KDown  [MShift]       -> go $ moveToBottom a | ||||
|     EvKey KPageUp []            -> go $ prevpage a | ||||
|     EvKey KBS []                -> go $ prevpage a | ||||
|     EvKey (KASCII ' ') [MShift] -> go $ prevpage a | ||||
|     EvKey KPageDown []          -> go $ nextpage a | ||||
|     EvKey (KASCII ' ') []       -> go $ nextpage a | ||||
|     EvKey (KASCII 'q') []       -> shutdown av >> return () | ||||
| --    EvKey KEsc   []           -> shutdown av >> return () | ||||
|     _                           -> go a | ||||
|     where | ||||
|       bh = length buf | ||||
|       y = posY a | ||||
| 
 | ||||
| -- app state modifiers | ||||
| 
 | ||||
| -- | The number of lines currently available for the main data display area. | ||||
| pageHeight :: AppState -> Int | ||||
| pageHeight a = ah a - 1 | ||||
| 
 | ||||
| setLocCursorY, setLocScrollY :: Int -> Loc -> Loc | ||||
| setLocCursorY y l = l{cy=y} | ||||
| setLocScrollY y l = l{sy=y} | ||||
| 
 | ||||
| cursorY, scrollY, posY :: AppState -> Int | ||||
| cursorY = cy . loc | ||||
| scrollY = sy . loc | ||||
| posY a = scrollY a + cursorY a | ||||
| 
 | ||||
| setCursorY, setScrollY, setPosY :: Int -> AppState -> AppState | ||||
| setCursorY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocCursorY y l | ||||
| setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocScrollY y l | ||||
| setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} | ||||
|     where  | ||||
|       l' = setLocScrollY sy $ setLocCursorY cy l | ||||
|       ph = pageHeight a | ||||
|       cy = y `mod` ph | ||||
|       sy = y - cy | ||||
| 
 | ||||
| updateCursorY, updateScrollY, updatePosY :: (Int -> Int) -> AppState -> AppState | ||||
| updateCursorY f a = setCursorY (f $ cursorY a) a | ||||
| updateScrollY f a = setScrollY (f $ scrollY a) a | ||||
| updatePosY f a = setPosY (f $ posY a) a | ||||
| 
 | ||||
| resize x y a = setCursorY cy' a{aw=x,ah=y} | ||||
|     where | ||||
|       cy = cursorY a | ||||
|       cy' = min cy (y-2) | ||||
| 
 | ||||
| moveToTop a = setPosY 0 a | ||||
| 
 | ||||
| moveToBottom a = setPosY (length $ abuf a) a | ||||
| 
 | ||||
| moveUpAndPushEdge a@AppState{alocs=(Loc{sy=sy,cy=cy}:_)} | ||||
|     | cy > 0 = updateCursorY (subtract 1) a | ||||
|     | sy > 0 = updateScrollY (subtract 1) a | ||||
|     | otherwise = a | ||||
| 
 | ||||
| moveDownAndPushEdge a@AppState{alocs=(Loc{sy=sy,cy=cy}:_)} | ||||
|     | sy+cy >= bh = a | ||||
|     | cy < ph-1 = updateCursorY (+1) a | ||||
|     | otherwise = updateScrollY (+1) a | ||||
|     where  | ||||
|       ph = pageHeight a | ||||
|       bh = length $ abuf a | ||||
| 
 | ||||
| -- | Scroll down by page height or until we can just see the last line, | ||||
| -- without moving the cursor, or if we are already scrolled as far as | ||||
| -- possible then move the cursor to the last line. | ||||
| nextpage (a@AppState{abuf=b}) | ||||
|     | sy < bh-jump = setScrollY sy' a | ||||
|     | otherwise    = setCursorY (bh-sy) a | ||||
|     where | ||||
|       sy = scrollY a | ||||
|       jump = pageHeight a - 1 | ||||
|       bh = length b | ||||
|       sy' = min (sy+jump) (bh-jump) | ||||
| 
 | ||||
| -- | Scroll up by page height or until we can just see the first line, | ||||
| -- without moving the cursor, or if we are scrolled as far as possible | ||||
| -- then move the cursor to the first line. | ||||
| prevpage (a@AppState{abuf=b}) | ||||
|     | sy > 0    = setScrollY sy' a | ||||
|     | otherwise = setCursorY 0 a | ||||
|     where | ||||
|       sy = scrollY a | ||||
|       jump = pageHeight a - 1 | ||||
|       sy' = max (sy-jump) 0 | ||||
| 
 | ||||
| -- | Push a new UI location on to the stack. | ||||
| pushLoc :: Loc -> AppState -> AppState | ||||
| pushLoc l a = a{alocs=(l:alocs a)} | ||||
| 
 | ||||
| popLoc :: AppState -> AppState | ||||
| popLoc a@AppState{alocs=locs} | ||||
|     | length locs > 1 = a{alocs=drop 1 locs} | ||||
|     | otherwise = a | ||||
| 
 | ||||
| clearLocs :: AppState -> AppState | ||||
| clearLocs a = a{alocs=[]} | ||||
| 
 | ||||
| exit :: AppState -> AppState  | ||||
| exit = popLoc | ||||
| 
 | ||||
| loc :: AppState -> Loc | ||||
| loc = head . alocs | ||||
| 
 | ||||
| screen :: AppState -> Screen | ||||
| screen a = scr where (Loc scr _ _) = loc a | ||||
| 
 | ||||
| -- | Enter a new screen, saving the old ui location on the stack. | ||||
| enter :: Screen -> AppState -> AppState  | ||||
| enter scr@BalanceScreen a  = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a | ||||
| enter scr@RegisterScreen a = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a | ||||
| enter scr@PrintScreen a    = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a | ||||
| enter scr@LedgerScreen a   = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a | ||||
| 
 | ||||
| resetTrailAndEnter scr a = enter scr $ clearLocs a | ||||
| 
 | ||||
| -- | Regenerate the display data based on current UI location. | ||||
| updateData :: AppState -> AppState | ||||
| updateData a@AppState{aopts=opts,aargs=args,aledger=l} | ||||
|     | scr == BalanceScreen  = a{abuf=lines $ showBalanceReport opts [] l, aargs=[]} | ||||
|     | scr == RegisterScreen = a{abuf=lines $ showRegisterReport opts args l} | ||||
|     | scr == PrintScreen    = a{abuf=lines $ showEntries opts args l} | ||||
|     | scr == LedgerScreen   = a{abuf=lines $ rawledgertext l} | ||||
|     where scr = screen a | ||||
| 
 | ||||
| backout :: AppState -> AppState | ||||
| backout a | ||||
|     | screen a == BalanceScreen = a | ||||
|     | otherwise = updateData $ popLoc a | ||||
| 
 | ||||
| drilldown :: AppState -> AppState | ||||
| drilldown a | ||||
|     | screen a == BalanceScreen  = enter RegisterScreen a{aargs=[currentAccountName a]} | ||||
|     | screen a == RegisterScreen = scrollToEntry e $ enter PrintScreen a | ||||
|     | screen a == PrintScreen   = enter LedgerScreen a | ||||
|     | screen a == LedgerScreen   = a | ||||
|     where e = currentEntry a | ||||
| 
 | ||||
| -- | Get the account name currently highlighted by the cursor on the | ||||
| -- balance screen. Results undefined while on other screens. | ||||
| currentAccountName :: AppState -> AccountName | ||||
| currentAccountName a = accountNameAt (abuf a) (posY a) | ||||
| 
 | ||||
| -- | Get the full name of the account being displayed at a specific line | ||||
| -- within the balance command's output. | ||||
| accountNameAt :: [String] -> Int -> AccountName | ||||
| accountNameAt buf lineno = accountNameFromComponents anamecomponents | ||||
|     where | ||||
|       namestohere = map (drop 22) $ take (lineno+1) buf | ||||
|       (indented, nonindented) = span (" " `isPrefixOf`) $ reverse namestohere | ||||
|       thisbranch = indented ++ take 1 nonindented | ||||
|       anamecomponents = reverse $ map strip $ dropsiblings thisbranch | ||||
| 
 | ||||
|       dropsiblings :: [AccountName] -> [AccountName] | ||||
|       dropsiblings [] = [] | ||||
|       dropsiblings (x:xs) = [x] ++ dropsiblings xs' | ||||
|           where | ||||
|             xs' = dropWhile moreindented xs | ||||
|             moreindented = (>= myindent) . indentof | ||||
|             myindent = indentof x | ||||
|             indentof = length . takeWhile (==' ') | ||||
| 
 | ||||
| -- currentEntry/scrollToEntry doesn't work | ||||
| -- | If on the print screen, move the cursor to highlight the specified entry | ||||
| -- (or a reasonable guess). | ||||
| scrollToEntry :: Entry -> AppState -> AppState | ||||
| scrollToEntry e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a | ||||
|     where | ||||
|       entryfirstline = head $ lines $ showEntry $ e | ||||
|       halfph = pageHeight a `div` 2 | ||||
|       y = fromMaybe 0 $ findIndex (== entryfirstline) buf | ||||
|       sy = max 0 $ y - halfph | ||||
|       cy = y - sy | ||||
| 
 | ||||
| -- | Get the entry containing the transaction currently highlighted by the | ||||
| -- cursor on the register screen (or best guess). Results undefined while | ||||
| -- on other screens. | ||||
| currentEntry :: AppState -> Entry | ||||
| currentEntry a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t | ||||
|     where | ||||
|       t = safehead nulltxn $ filter ismatch $ ledgerTransactions l | ||||
|       ismatch t = date t == (parsedate $ take 10 datedesc) | ||||
|                   && (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt) | ||||
|       datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above | ||||
|       acctamt = drop 32 $ safehead "" rest | ||||
|       safehead d ls = if null ls then d else head ls | ||||
|       (above,rest) = splitAt y buf | ||||
|       y = posY a | ||||
| 
 | ||||
| -- | Get the entry which contains the given transaction. | ||||
| -- Will raise an error if there are problems. | ||||
| entryContainingTransaction :: AppState -> Transaction -> Entry | ||||
| entryContainingTransaction AppState{aledger=l} t = (entries $ rawledger l) !! entryno t | ||||
| 
 | ||||
| -- renderers | ||||
| 
 | ||||
| renderScreen :: AppState -> Picture | ||||
| renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) = | ||||
|     pic {pCursor = Cursor cx cy, | ||||
|          pImage = mainimg | ||||
|                   <-> | ||||
|                   renderStatus w msg | ||||
|         } | ||||
|     where  | ||||
|       (cx, cy) = (0, cursorY a) | ||||
|       sy = scrollY a | ||||
|       -- trying for more speed | ||||
|       mainimg = (vertcat $ map (render defaultattr) above) | ||||
|                <-> | ||||
|                (render currentlineattr thisline) | ||||
|                <-> | ||||
|                (vertcat $ map (render defaultattr) below) | ||||
|       render attr = renderBS attr . B.pack | ||||
|       (thisline,below) | null rest = (blankline,[]) | ||||
|                        | otherwise = (head rest, tail rest) | ||||
|       (above,rest) = splitAt cy linestorender | ||||
|       linestorender = map padclipline $ take (h-1) $ drop sy $ buf ++ replicate h blankline | ||||
|       padclipline l = take w $ l ++ blankline | ||||
|       blankline = replicate w ' ' | ||||
| --       mainimg = (renderString attr $ unlines $ above) | ||||
| --           <-> | ||||
| --           (renderString reverseattr $ thisline) | ||||
| --           <-> | ||||
| --           (renderString attr $ unlines $ below) | ||||
| --       (above,(thisline:below))  | ||||
| --           | null ls   = ([],[""]) | ||||
| --           | otherwise = splitAt y ls | ||||
| --       ls = lines $ fitto w (h-1) $ unlines $ drop as $ buf | ||||
| 
 | ||||
| padClipString :: Int -> Int -> String -> [String] | ||||
| padClipString h w s = rows | ||||
|     where | ||||
|       rows = map padclipline $ take h $ lines s ++ replicate h blankline | ||||
|       padclipline l = take w $ l ++ blankline | ||||
|       blankline = replicate w ' ' | ||||
| 
 | ||||
| renderString :: Attr -> String -> Image | ||||
| renderString attr s = vertcat $ map (renderBS attr . B.pack) rows | ||||
|     where | ||||
|       rows = lines $ fitto w h s | ||||
|       w = maximum $ map length $ ls | ||||
|       h = length ls | ||||
|       ls = lines s | ||||
| 
 | ||||
| renderStatus :: Int -> String -> Image | ||||
| renderStatus w s = renderBS statusattr (B.pack $ take w (s ++ repeat ' '))  | ||||
| 
 | ||||
| 
 | ||||
| -- the all-important theming engine | ||||
| 
 | ||||
| theme = 1 | ||||
| 
 | ||||
| (defaultattr,  | ||||
|  currentlineattr,  | ||||
|  statusattr | ||||
|  ) =  | ||||
|     case theme of | ||||
|       1 -> ( -- restrained | ||||
|            attr | ||||
|           ,setBold attr | ||||
|           ,setRV attr | ||||
|           ) | ||||
|       2 -> ( -- colorful | ||||
|            setRV attr | ||||
|           ,setFG white $ setBG red $ attr | ||||
|           ,setFG black $ setBG green $ attr | ||||
|           ) | ||||
|       3 -> ( --  | ||||
|            setRV attr | ||||
|           ,setFG white $ setBG red $ attr | ||||
|           ,setRV attr | ||||
|           ) | ||||
| 
 | ||||
| halfbrightattr = setHalfBright attr | ||||
| reverseattr = setRV attr | ||||
| redattr = setFG red attr | ||||
| greenattr = setFG green attr | ||||
| reverseredattr = setRV $ setFG red attr | ||||
| reversegreenattr= setRV $ setFG green attr | ||||
| 
 | ||||
| --     pic { pCursor = Cursor x y, | ||||
| --           pImage = renderFill pieceA ' ' w y  | ||||
| --           <-> | ||||
| --           renderHFill pieceA ' ' x <|> renderChar pieceA '@' <|> renderHFill pieceA ' ' (w - x - 1)  | ||||
| --           <-> | ||||
| --           renderFill pieceA ' ' w (h - y - 1)  | ||||
| --           <-> | ||||
| --           renderStatus w msg | ||||
| --         } | ||||
| @ -20,7 +20,7 @@ Cabal-Version:  >= 1.2 | ||||
| 
 | ||||
| Executable hledger | ||||
|   Build-Depends:  base, containers, haskell98, directory, parsec, regex-compat, regexpr | ||||
|                   old-locale, time, HUnit | ||||
|                   old-locale, time, HUnit, vty | ||||
|   Main-Is:        hledger.hs | ||||
|   Other-Modules:   | ||||
|                   BalanceCommand | ||||
|  | ||||
| @ -39,6 +39,7 @@ module Main ( | ||||
|              module BalanceCommand, | ||||
|              module PrintCommand, | ||||
|              module RegisterCommand, | ||||
|              module UICommand, | ||||
| ) | ||||
| where | ||||
| import qualified Data.Map as Map (lookup) | ||||
| @ -48,6 +49,7 @@ import Options | ||||
| import BalanceCommand | ||||
| import PrintCommand | ||||
| import RegisterCommand | ||||
| import UICommand | ||||
| import Tests | ||||
| 
 | ||||
| 
 | ||||
| @ -62,6 +64,7 @@ main = do | ||||
|        | cmd `isPrefixOf` "balance"  = parseLedgerAndDo opts args balance | ||||
|        | cmd `isPrefixOf` "print"    = parseLedgerAndDo opts args print' | ||||
|        | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args register | ||||
|        | cmd `isPrefixOf` "ui"       = parseLedgerAndDo opts args ui | ||||
|        | cmd `isPrefixOf` "test"     = runtests opts args >> return () | ||||
|        | otherwise                   = putStr $ usage | ||||
| 
 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user