ui: revive the curses UI, now named hledger-ui
This commit is contained in:
parent
25146b09e2
commit
207ae772d4
11
README.md
11
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
|
||||
and a Haskell library (http://hackage.haskell.org/package/hledger-lib) for
|
||||
building your own programs and scripts (hledger is written in Haskell).
|
||||
hledger was inspired by and is largely compatible with Ledger.
|
||||
hledger is free software available under the GNU General Public License v3+.
|
||||
It is first a command-line tool, but there are also curses-style and
|
||||
web interfaces, and a Haskell library
|
||||
(http://hackage.haskell.org/package/hledger-lib) for building your own
|
||||
programs and scripts (hledger is written in Haskell). hledger was
|
||||
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,
|
||||
|
||||
@ -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
|
||||
]
|
||||
@ -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.
|
||||
@ -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
21
hledger-ui/Hledger/UI.hs
Normal 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
|
||||
]
|
||||
@ -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.
|
||||
vty :: VtyOpts -> Journal -> IO ()
|
||||
vty opts j = do
|
||||
-- | Run the curses-style ui.
|
||||
ui :: UIOpts -> Journal -> IO ()
|
||||
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 'r') [] -> go $ resetTrailAndEnter d RegisterScreen a
|
||||
EvKey (KChar 'p') [] -> go $ resetTrailAndEnter d PrintScreen a
|
||||
-- EvKey (KChar 'b') [] -> go $ resetTrailAndEnter d BalanceScreen a
|
||||
-- EvKey (KChar 'r') [] -> go $ resetTrailAndEnter d RegisterScreen 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
|
||||
|
||||
@ -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 = [
|
||||
flagNone ["debug-vty"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
|
||||
uiflags = [
|
||||
flagNone ["debug-ui"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
|
||||
]
|
||||
|
||||
--vtymode :: Mode [([Char], [Char])]
|
||||
vtymode = (mode "hledger-vty" [("command","vty")]
|
||||
--uimode :: Mode [([Char], [Char])]
|
||||
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
|
||||
data VtyOpts = VtyOpts {
|
||||
debug_vty_ :: Bool
|
||||
-- hledger-ui options, used in hledger-ui and above
|
||||
data UIOpts = UIOpts {
|
||||
debug_ui_ :: Bool
|
||||
,cliopts_ :: CliOpts
|
||||
} deriving (Show)
|
||||
|
||||
defvtyopts = VtyOpts
|
||||
defuiopts = UIOpts
|
||||
def
|
||||
def
|
||||
|
||||
-- instance Default CliOpts where def = defcliopts
|
||||
|
||||
toVtyOpts :: RawOpts -> IO VtyOpts
|
||||
toVtyOpts rawopts = do
|
||||
toUIOpts :: RawOpts -> IO UIOpts
|
||||
toUIOpts rawopts = do
|
||||
cliopts <- rawOptsToCliOpts rawopts
|
||||
return defvtyopts {
|
||||
debug_vty_ = boolopt "debug-vty" rawopts
|
||||
return defuiopts {
|
||||
debug_ui_ = boolopt "debug-ui" rawopts
|
||||
,cliopts_ = cliopts
|
||||
}
|
||||
|
||||
checkVtyOpts :: VtyOpts -> IO VtyOpts
|
||||
checkVtyOpts opts = do
|
||||
checkUIOpts :: UIOpts -> IO UIOpts
|
||||
checkUIOpts opts = do
|
||||
checkCliOpts $ cliopts_ opts
|
||||
return opts
|
||||
|
||||
getHledgerVtyOpts :: IO VtyOpts
|
||||
getHledgerVtyOpts = processArgs vtymode >>= return . decodeRawOpts >>= toVtyOpts >>= checkVtyOpts
|
||||
getHledgerUIOpts :: IO UIOpts
|
||||
getHledgerUIOpts = processArgs uimode >>= return . decodeRawOpts >>= toUIOpts >>= checkUIOpts
|
||||
|
||||
4
hledger-ui/README
Normal file
4
hledger-ui/README
Normal 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.
|
||||
|
||||
@ -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
|
||||
main-is: hledger-vty.hs
|
||||
executable hledger-ui
|
||||
main-is: hledger-ui.hs
|
||||
ghc-options: -threaded -W
|
||||
other-modules:
|
||||
Hledger.Vty
|
||||
Hledger.Vty.Main
|
||||
Hledger.Vty.Options
|
||||
Hledger.UI
|
||||
Hledger.UI.Main
|
||||
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
|
||||
@ -1,2 +1,2 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
import Hledger.Vty (main)
|
||||
import Hledger.UI (main)
|
||||
@ -1,7 +1,9 @@
|
||||
packages:
|
||||
- hledger-lib
|
||||
- hledger
|
||||
- hledger-ui
|
||||
- hledger-web
|
||||
flags: {}
|
||||
resolver: lts-3.0
|
||||
extra-deps:
|
||||
- vty-5.3.1
|
||||
|
||||
Loading…
Reference in New Issue
Block a user