slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Simon Michael 2015-08-13 11:22:40 -07:00
parent 25146b09e2
commit 207ae772d4
13 changed files with 88 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
README.md
View File

@ -5,11 +5,12 @@
hledger is a computer program for easily tracking money, time, or other commodities, 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). 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 hledger aims to help both computer experts and regular folks
to gain clarity and control in their finances and time management, to gain clarity and control in their finances and time management,

21
extra/hledger-vty/Hledger/Vty.hs
View File

@ -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
]

5
extra/hledger-vty/README
View File

@ -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.

8
extra/hledger-vty/stack.yaml
View File

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

21
hledger-ui/Hledger/UI.hs Normal file
View File

@ -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
]

48
extra/hledger-vty/Hledger/Vty/Main.hs → hledger-ui/Hledger/UI/Main.hs
View File

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

38
extra/hledger-vty/Hledger/Vty/Options.hs → hledger-ui/Hledger/UI/Options.hs
View File

@ -3,7 +3,7 @@
-} -}
module Hledger.Vty.Options module Hledger.UI.Options
where where
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
@ -11,7 +11,7 @@ import System.Console.CmdArgs.Explicit
import Hledger.Cli hiding (progname,version,prognameandversion) import Hledger.Cli hiding (progname,version,prognameandversion)
progname, version :: String progname, version :: String
progname = "hledger-vty" progname = "hledger-ui"
#ifdef VERSION #ifdef VERSION
version = VERSION version = VERSION
#else #else
@ -20,16 +20,16 @@ version = ""
prognameandversion :: String prognameandversion :: String
prognameandversion = progname ++ " " ++ version :: 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" "browse accounts, postings and entries in a full-window curses interface"
(argsFlag "[PATTERNS]") []){ (argsFlag "[PATTERNS]") []){
modeGroupFlags = Group { modeGroupFlags = Group {
groupUnnamed = vtyflags groupUnnamed = uiflags
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagsgroup1)] ,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 ,cliopts_ :: CliOpts
} deriving (Show) } deriving (Show)
defvtyopts = VtyOpts defuiopts = UIOpts
def def
def def
-- instance Default CliOpts where def = defcliopts -- instance Default CliOpts where def = defcliopts
toVtyOpts :: RawOpts -> IO VtyOpts toUIOpts :: RawOpts -> IO UIOpts
toVtyOpts rawopts = do toUIOpts rawopts = do
cliopts <- rawOptsToCliOpts rawopts cliopts <- rawOptsToCliOpts rawopts
return defvtyopts { return defuiopts {
debug_vty_ = boolopt "debug-vty" rawopts debug_ui_ = boolopt "debug-ui" rawopts
,cliopts_ = cliopts ,cliopts_ = cliopts
} }
checkVtyOpts :: VtyOpts -> IO VtyOpts checkUIOpts :: UIOpts -> IO UIOpts
checkVtyOpts opts = do checkUIOpts opts = do
checkCliOpts $ cliopts_ opts checkCliOpts $ cliopts_ opts
return opts return opts
getHledgerVtyOpts :: IO VtyOpts getHledgerUIOpts :: IO UIOpts
getHledgerVtyOpts = processArgs vtymode >>= return . decodeRawOpts >>= toVtyOpts >>= checkVtyOpts getHledgerUIOpts = processArgs uimode >>= return . decodeRawOpts >>= toUIOpts >>= checkUIOpts

0
extra/hledger-vty/LICENSE → hledger-ui/LICENSE
View File

4
hledger-ui/README Normal file
View File

@ -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.

0
extra/hledger-vty/Setup.hs → hledger-ui/Setup.hs
View File

16
extra/hledger-vty/hledger-vty.cabal → hledger-ui/hledger-ui.cabal
View File

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

2
extra/hledger-vty/hledger-vty.hs → hledger-ui/hledger-ui.hs
View File

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

2
stack.yaml
View File

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