ui: revive the curses UI, now named hledger-ui

README.md

@@ -5,11 +5,12 @@
 hledger is a computer program for easily tracking money, time, or other commodities,
 on unix, mac and windows (and web-capable mobile devices, to some extent).
 
-It is first a command-line tool, but there is also a web interface
+It is first a command-line tool, but there are also curses-style and
-and a Haskell library (http://hackage.haskell.org/package/hledger-lib) for
+web interfaces, and a Haskell library
-building your own programs and scripts (hledger is written in Haskell).
+(http://hackage.haskell.org/package/hledger-lib) for building your own
-hledger was inspired by and is largely compatible with Ledger.
+programs and scripts (hledger is written in Haskell).  hledger was
-hledger is free software available under the GNU General Public License v3+.
+inspired by and is largely compatible with Ledger.  hledger is free
+software available under the GNU General Public License v3+.
 
 hledger aims to help both computer experts and regular folks
 to gain clarity and control in their finances and time management,

extra/hledger-vty/Hledger/Vty.hs

@@ -1,21 +0,0 @@
-{-|
-Re-export the modules of the hledger-vty program.
--}
-
-module Hledger.Vty (
-                     module Hledger.Vty.Main,
-                     module Hledger.Vty.Options,
-                     tests_Hledger_Vty
-              )
-where
-import Test.HUnit
-
-import Hledger.Vty.Main
-import Hledger.Vty.Options
-
-tests_Hledger_Vty :: Test
-tests_Hledger_Vty = TestList
- [
- --  tests_Hledger_Vty_Main
- --  tests_Hledger_Vty_Options
- ]

extra/hledger-vty/README

@@ -1,5 +0,0 @@
-A curses-style console interface for the hledger accounting tool.
-It allows browsing the balance, register and print reports with cursor keys and scrolling,
-and was actually quite useful.
-
-Warning, this package has been unmaintained since 2011 and will not install.

extra/hledger-vty/stack.yaml

@@ -1,8 +0,0 @@
-packages:
-- '../../hledger-lib'
-- '../../hledger'
-- '.'
-flags:
-resolver: lts-3.0
-extra-deps:
-- vty-5.2.10

hledger-ui/Hledger/UI.hs

@@ -0,0 +1,21 @@
+{-|
+Re-export the modules of the hledger-ui program.
+-}
+
+module Hledger.UI (
+                     module Hledger.UI.Main,
+                     module Hledger.UI.Options,
+                     tests_Hledger_UI
+              )
+where
+import Test.HUnit
+
+import Hledger.UI.Main
+import Hledger.UI.Options
+
+tests_Hledger_UI :: Test
+tests_Hledger_UI = TestList
+ [
+ --  tests_Hledger_UI_Main
+ --  tests_Hledger_UI_Options
+ ]

hledger-ui/Hledger/UI/Main.hs

@@ -1,10 +1,10 @@
 {-|
-hledger-vty - a hledger add-on providing a curses-style interface.
+hledger-ui - a hledger add-on providing a curses-style interface.
 Copyright (c) 2007-2011 Simon Michael <simon@joyful.com>
 Released under GPL version 3 or later.
 -}
 
-module Hledger.Vty.Main (main) where
+module Hledger.UI.Main (main) where
 
 import Control.Monad
 import Data.List
@@ -16,25 +16,25 @@ import System.Exit
 
 import Hledger
 import Hledger.Cli hiding (progname,prognameandversion,green)
-import Hledger.Vty.Options
+import Hledger.UI.Options
 
 
 main :: IO ()
 main = do
-  opts <- getHledgerVtyOpts
+  opts <- getHledgerUIOpts
   -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
   runWith opts
 
-runWith :: VtyOpts -> IO ()
+runWith :: UIOpts -> IO ()
 runWith opts = run opts
     where
       run opts
-          | "help" `inRawOpts` (rawopts_ $ cliopts_ opts)            = putStr (showModeHelp vtymode) >> exitSuccess
+          | "help" `inRawOpts` (rawopts_ $ cliopts_ opts)            = putStr (showModeHelp uimode) >> exitSuccess
           | "version" `inRawOpts` (rawopts_ $ cliopts_ opts)         = putStrLn prognameandversion >> exitSuccess
           | "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
-          | otherwise                                          = withJournalDo' opts vty
+          | otherwise                                          = withJournalDo' opts ui
 
-withJournalDo' :: VtyOpts -> (VtyOpts -> Journal -> IO ()) -> IO ()
+withJournalDo' :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO ()
 withJournalDo' opts cmd = do
   -- journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
   --   either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
@@ -42,17 +42,17 @@ withJournalDo' opts cmd = do
   (head `fmap` journalFilePathFromOpts (cliopts_ opts)) >>= readJournalFile Nothing Nothing True >>=
     either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
 
-helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"
+helpmsg = "(right) drill down, (left) back up, (q)uit"
 
 instance Show Vty where show = const "a Vty"
 
--- | The application state when running the vty command.
+-- | The application state when running the ui command.
 data AppState = AppState {
      av :: Vty                   -- ^ the vty context
     ,aw :: Int                   -- ^ window width
     ,ah :: Int                   -- ^ window height
     ,amsg :: String              -- ^ status message
-    ,aopts :: VtyOpts            -- ^ command-line opts
+    ,aopts :: UIOpts            -- ^ command-line opts
     ,aargs :: [String]           -- ^ command-line args at startup
     ,ajournal :: Journal         -- ^ parsed journal
     ,abuf :: [String]            -- ^ lines of the current buffered view
@@ -75,11 +75,11 @@ data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts
             -- | LedgerScreen      -- ^ shows the raw journal entries
               deriving (Eq,Show)
 
--- | Run the vty (curses-style) ui.
+-- | Run the curses-style ui.
-vty :: VtyOpts -> Journal -> IO ()
+ui :: UIOpts -> Journal -> IO ()
-vty opts j = do
+ui opts j = do
   cfg <- standardIOConfig
-  v <- mkVty cfg
+  vty <- mkVty cfg
 
   -- let line0 = string (defAttr ` withForeColor ` green) "first line"
   --     line1 = string (defAttr ` withBackColor ` blue) "second line"
@@ -95,7 +95,7 @@ vty opts j = do
   d <- getCurrentDay
   let a = enter d BalanceScreen (words' $ query_ $ reportopts_ $ cliopts_ opts)
           AppState {
-                  av=v
+                  av=vty
                  ,aw=w
                  ,ah=h
                  ,amsg=helpmsg
@@ -110,15 +110,15 @@ vty opts j = do
 -- | Update the screen, wait for the next event, repeat.
 go :: AppState -> IO ()
 go a@AppState{av=av,aopts=opts} = do
-  when (not $ debug_vty_ opts) $ update av (renderScreen a)
+  when (not $ debug_ui_ opts) $ update av (renderScreen a)
   k <- nextEvent av
   d <- getCurrentDay
   case k of
     EvResize x y                -> go $ resize' x y a
     EvKey (KChar 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg}
-    EvKey (KChar 'b') []       -> go $ resetTrailAndEnter d BalanceScreen a
+    -- EvKey (KChar 'b') []       -> go $ resetTrailAndEnter d BalanceScreen a
-    EvKey (KChar 'r') []       -> go $ resetTrailAndEnter d RegisterScreen a
+    -- EvKey (KChar 'r') []       -> go $ resetTrailAndEnter d RegisterScreen a
-    EvKey (KChar 'p') []       -> go $ resetTrailAndEnter d PrintScreen a
+    -- EvKey (KChar 'p') []       -> go $ resetTrailAndEnter d PrintScreen a
     EvKey KRight []             -> go $ drilldown d a
     EvKey KEnter []             -> go $ drilldown d a
     EvKey KLeft  []             -> go $ backout d a
@@ -329,13 +329,13 @@ currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p
     where
       p = headDef nullposting $ filter ismatch $ journalPostings j
       ismatch p = postingDate p == parsedate (take 10 datedesc)
-                  && take 70 (showPostingWithBalanceForVty p nullmixedamt) == (datedesc ++ acctamt)
+                  && take 70 (showPostingWithBalanceForUI p nullmixedamt) == (datedesc ++ acctamt)
       datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above
       acctamt = drop 32 $ headDef "" rest
       (above,rest) = splitAt y buf
       y = posY a
 
-showPostingWithBalanceForVty p b =
+showPostingWithBalanceForUI p b =
   postingsReportItemAsText defcliopts $
   mkpostingsReportItem False False PrimaryDate Nothing p b
 
@@ -395,7 +395,9 @@ renderStatus w = string statusattr . take w . (++ repeat ' ')
 
 -- the all-important theming engine!
 
-theme = Restrained
+-- theme = Restrained
+theme = Colorful
+-- theme = Blood
 
 data UITheme = Restrained | Colorful | Blood
 

hledger-ui/Hledger/UI/Options.hs

@@ -3,7 +3,7 @@
 
 -}
 
-module Hledger.Vty.Options
+module Hledger.UI.Options
 where
 import System.Console.CmdArgs
 import System.Console.CmdArgs.Explicit
@@ -11,7 +11,7 @@ import System.Console.CmdArgs.Explicit
 import Hledger.Cli hiding (progname,version,prognameandversion)
 
 progname, version :: String
-progname = "hledger-vty"
+progname = "hledger-ui"
 #ifdef VERSION
 version = VERSION
 #else
@@ -20,16 +20,16 @@ version = ""
 prognameandversion :: String
 prognameandversion = progname ++ " " ++ version :: String
 
-vtyflags = [
+uiflags = [
-  flagNone ["debug-vty"]  (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
+  flagNone ["debug-ui"]  (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
  ]
 
---vtymode :: Mode [([Char], [Char])]
+--uimode :: Mode [([Char], [Char])]
-vtymode =  (mode "hledger-vty" [("command","vty")]
+uimode =  (mode "hledger-ui" [("command","ui")]
             "browse accounts, postings and entries in a full-window curses interface"
             (argsFlag "[PATTERNS]") []){
               modeGroupFlags = Group {
-                                groupUnnamed = vtyflags
+                                groupUnnamed = uiflags
                                ,groupHidden = []
                                ,groupNamed = [(generalflagsgroup1)]
                                }
@@ -38,31 +38,31 @@ vtymode =  (mode "hledger-vty" [("command","vty")]
                  ]
            }
 
--- hledger-vty options, used in hledger-vty and above
+-- hledger-ui options, used in hledger-ui and above
-data VtyOpts = VtyOpts {
+data UIOpts = UIOpts {
-     debug_vty_ :: Bool
+     debug_ui_ :: Bool
     ,cliopts_   :: CliOpts
  } deriving (Show)
 
-defvtyopts = VtyOpts
+defuiopts = UIOpts
     def
     def
 
 -- instance Default CliOpts where def = defcliopts
 
-toVtyOpts :: RawOpts -> IO VtyOpts
+toUIOpts :: RawOpts -> IO UIOpts
-toVtyOpts rawopts = do
+toUIOpts rawopts = do
   cliopts <- rawOptsToCliOpts rawopts
-  return defvtyopts {
+  return defuiopts {
-              debug_vty_ = boolopt "debug-vty" rawopts
+              debug_ui_ = boolopt "debug-ui" rawopts
              ,cliopts_   = cliopts
              }
 
-checkVtyOpts :: VtyOpts -> IO VtyOpts
+checkUIOpts :: UIOpts -> IO UIOpts
-checkVtyOpts opts = do
+checkUIOpts opts = do
   checkCliOpts $ cliopts_ opts
   return opts
 
-getHledgerVtyOpts :: IO VtyOpts
+getHledgerUIOpts :: IO UIOpts
-getHledgerVtyOpts = processArgs vtymode >>= return . decodeRawOpts >>= toVtyOpts >>= checkVtyOpts
+getHledgerUIOpts = processArgs uimode >>= return . decodeRawOpts >>= toUIOpts >>= checkUIOpts
 

hledger-ui/README

@@ -0,0 +1,4 @@
+A curses-style console interface for the hledger accounting tool.
+hledger-vty was revived in 2015 to become this package.
+It allows browsing the balance, register and print reports with cursor keys and scrolling.
+

hledger-ui/hledger-ui.cabal

@@ -1,4 +1,4 @@
-name:           hledger-vty
+name:           hledger-ui
 version: 0.26.98
 category:       Finance
 synopsis:       A curses-style console interface for the hledger accounting tool.
@@ -23,19 +23,21 @@ build-type:     Simple
 -- data-dir:       data
 -- data-files:
 extra-tmp-files:
-extra-source-files:
+extra-source-files: 
+                    CHANGES
+                    README
 
 source-repository head
   type:     darcs
   location: http://joyful.com/repos/hledger
 
-executable hledger-vty
+executable hledger-ui
-  main-is:        hledger-vty.hs
+  main-is:        hledger-ui.hs
   ghc-options:    -threaded -W
   other-modules:
-                  Hledger.Vty
+                  Hledger.UI
-                  Hledger.Vty.Main
+                  Hledger.UI.Main
-                  Hledger.Vty.Options
+                  Hledger.UI.Options
   build-depends:
                   hledger == 0.26.98
                  ,hledger-lib == 0.26.98
@@ -56,4 +58,4 @@ executable hledger-vty
                  -- ,split == 0.1.*
                  ,time
                  -- ,utf8-string >= 0.3.5 && < 0.4
-                 ,vty >= 5.2 && < 5.3
+                 ,vty >= 5.2 && < 5.4

hledger-ui/hledger-ui.hs

@@ -1,2 +1,2 @@
 #!/usr/bin/env runhaskell
-import Hledger.Vty (main)
+import Hledger.UI (main)

stack.yaml

@@ -1,7 +1,9 @@
 packages:
 - hledger-lib
 - hledger
+- hledger-ui
 - hledger-web
 flags: {}
 resolver: lts-3.0
 extra-deps:
+- vty-5.3.1