optionsgeddon.. port to cmdargs and a fully modal cli
This commit is contained in:
Simon Michael
parent
c3954cad43
commit
059825a9b2
@ -18,78 +18,49 @@ import Data.Maybe
|
||||
import Data.Ord
|
||||
import Data.Tree
|
||||
import Graphics.Rendering.Chart
|
||||
import Safe (readDef)
|
||||
import System.Console.GetOpt
|
||||
import System.Exit (exitFailure)
|
||||
import Text.Printf
|
||||
|
||||
import Hledger
|
||||
import Prelude hiding (putStr, putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStr, putStrLn)
|
||||
import Hledger.Cli.Options
|
||||
import Hledger.Cli.Utils (withJournalDo)
|
||||
import Hledger.Cli.Version
|
||||
import Hledger.Cli hiding (progname,progversion)
|
||||
import Prelude hiding (putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStrLn)
|
||||
|
||||
|
||||
progname_chart = progname_cli ++ "-chart"
|
||||
|
||||
defchartoutput = "hledger.png"
|
||||
defchartitems = 10
|
||||
defchartsize = "600x400"
|
||||
|
||||
options_chart :: [OptDescr Opt]
|
||||
options_chart = [
|
||||
Option "o" ["output"] (ReqArg ChartOutput "FILE") ("output filename (default: "++defchartoutput++")")
|
||||
,Option "" ["items"] (ReqArg ChartItems "N") ("number of accounts to show (default: "++show defchartitems++")")
|
||||
,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("image size (default: "++defchartsize++")")
|
||||
]
|
||||
|
||||
usage_preamble_chart =
|
||||
"Usage: hledger-chart [OPTIONS] [PATTERNS]\n" ++
|
||||
"\n" ++
|
||||
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
|
||||
"generates simple pie chart images.\n" ++
|
||||
"\n"
|
||||
|
||||
usage_options_chart = usageInfo "hledger-chart options:" options_chart ++ "\n"
|
||||
|
||||
usage_chart = concat [
|
||||
usage_preamble_chart
|
||||
,usage_options_chart
|
||||
,usage_options_cli
|
||||
,usage_postscript_cli
|
||||
]
|
||||
import Hledger.Chart.Options
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(opts, args) <- parseArgumentsWith $ options_cli++options_chart
|
||||
run opts args
|
||||
opts <- getHledgerChartOpts
|
||||
when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
|
||||
runWith opts
|
||||
|
||||
runWith :: ChartOpts -> IO ()
|
||||
runWith opts = run opts
|
||||
where
|
||||
run opts args
|
||||
| Help `elem` opts = putStr usage_chart
|
||||
| Version `elem` opts = putStrLn $ progversionstr progname_chart
|
||||
| BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_chart
|
||||
| otherwise = withJournalDo opts args "chart" chart
|
||||
run opts
|
||||
| "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit chartmode
|
||||
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
|
||||
| otherwise = withJournalDo' opts chart
|
||||
|
||||
withJournalDo' :: ChartOpts -> (ChartOpts -> Journal -> IO ()) -> IO ()
|
||||
withJournalDo' opts cmd = do
|
||||
journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
|
||||
either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
|
||||
|
||||
-- | Generate an image with the pie chart and write it to a file
|
||||
chart :: [Opt] -> [String] -> Journal -> IO ()
|
||||
chart opts args j = do
|
||||
chart :: ChartOpts -> Journal -> IO ()
|
||||
chart opts j = do
|
||||
d <- getCurrentDay
|
||||
if null $ jtxns j
|
||||
then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure
|
||||
else do
|
||||
let chart = genPie opts (optsToFilterSpec opts args d) j
|
||||
let chart = genPie opts (optsToFilterSpec ropts d) j
|
||||
renderableToPNGFile (toRenderable chart) w h filename
|
||||
return ()
|
||||
where
|
||||
filename = getOption opts ChartOutput defchartoutput
|
||||
(w,h) = parseSize $ getOption opts ChartSize defchartsize
|
||||
|
||||
-- | Extract string option value from a list of options or use the default
|
||||
getOption :: [Opt] -> (String->Opt) -> String -> String
|
||||
getOption opts opt def =
|
||||
case reverse $ optValuesForConstructor opt opts of
|
||||
[] -> def
|
||||
x:_ -> x
|
||||
filename = chart_output_ opts
|
||||
(w,h) = parseSize $ chart_size_ opts
|
||||
ropts = reportopts_ $ cliopts_ opts
|
||||
|
||||
-- | Parse image size from a command-line option
|
||||
parseSize :: String -> (Int,Int)
|
||||
@ -99,26 +70,28 @@ parseSize str = (read w, read h)
|
||||
(w,_:h) = splitAt x str
|
||||
|
||||
-- | Generate pie chart
|
||||
genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout
|
||||
genPie :: ChartOpts -> FilterSpec -> Journal -> PieLayout
|
||||
genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
|
||||
, pie_plot_ = pie_chart }
|
||||
where
|
||||
pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems'
|
||||
pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems
|
||||
, pie_start_angle_ = (-90)
|
||||
, pie_colors_ = mkColours hue
|
||||
, pie_label_style_ = defaultFontStyle{font_size_=12}
|
||||
}
|
||||
chartitems' = debug "chart" $ top num samesignitems
|
||||
chartitems = debug "chart" $ top num samesignitems
|
||||
(samesignitems, sign) = sameSignNonZero rawitems
|
||||
rawitems = debug "raw" $ flatten $ balances $
|
||||
ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ journalToLedger filterspec j
|
||||
ledgerAccountTree (fromMaybe 99999 $ depth_ ropts) $ journalToLedger filterspec j
|
||||
top n t = topn ++ [other]
|
||||
where
|
||||
(topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t
|
||||
other = ("other", sum $ map snd rest)
|
||||
num = readDef (fromIntegral defchartitems) (getOption opts ChartItems (show defchartitems))
|
||||
num = chart_items_ opts
|
||||
hue = if sign > 0 then red else green where (red, green) = (0, 110)
|
||||
debug s = if Debug `elem` opts then ltrace s else id
|
||||
debug s = if debug_ copts then ltrace s else id
|
||||
copts = cliopts_ opts
|
||||
ropts = reportopts_ copts
|
||||
|
||||
-- | Select the nonzero items with same sign as the first, and make
|
||||
-- them positive. Also return a 1 or -1 corresponding to the original sign.
|
||||
|
||||
68
hledger-chart/Hledger/Chart/Options.hs
Normal file
68
hledger-chart/Hledger/Chart/Options.hs
Normal file
@ -0,0 +1,68 @@
|
||||
{-|
|
||||
|
||||
-}
|
||||
|
||||
module Hledger.Chart.Options
|
||||
where
|
||||
import Data.Maybe
|
||||
import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit
|
||||
|
||||
import Hledger.Cli hiding (progname,progversion)
|
||||
import qualified Hledger.Cli (progname)
|
||||
|
||||
progname = Hledger.Cli.progname ++ "-chart"
|
||||
progversion = progversionstr progname
|
||||
|
||||
defchartoutput = "hledger.png"
|
||||
defchartitems = 10
|
||||
defchartsize = "600x400"
|
||||
|
||||
chartflags = [
|
||||
flagReq ["chart-output","o"] (\s opts -> Right $ setopt "chart-output" s opts) "IMGFILE" ("output filename (default: "++defchartoutput++")")
|
||||
,flagReq ["chart-items"] (\s opts -> Right $ setopt "chart-items" s opts) "N" ("number of accounts to show (default: "++show defchartitems++")")
|
||||
,flagReq ["chart-size"] (\s opts -> Right $ setopt "chart-size" s opts) "WIDTHxHEIGHT" ("image size (default: "++defchartsize++")")
|
||||
]
|
||||
|
||||
chartmode = (mode "hledger-chart" [("command","chart")]
|
||||
"generate a pie chart image for the top account balances (of one sign only)"
|
||||
commandargsflag (chartflags++generalflags1)){
|
||||
modeHelpSuffix=[
|
||||
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
|
||||
]
|
||||
}
|
||||
|
||||
-- hledger-chart options, used in hledger-chart and above
|
||||
data ChartOpts = ChartOpts {
|
||||
chart_output_ :: FilePath
|
||||
,chart_items_ :: Int
|
||||
,chart_size_ :: String
|
||||
,cliopts_ :: CliOpts
|
||||
} deriving (Show)
|
||||
|
||||
defchartopts = ChartOpts
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
|
||||
-- instance Default CliOpts where def = defcliopts
|
||||
|
||||
toChartOpts :: RawOpts -> IO ChartOpts
|
||||
toChartOpts rawopts = do
|
||||
cliopts <- toCliOpts rawopts
|
||||
return defchartopts {
|
||||
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts
|
||||
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts
|
||||
,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" rawopts
|
||||
,cliopts_ = cliopts
|
||||
}
|
||||
|
||||
checkChartOpts :: ChartOpts -> IO ChartOpts
|
||||
checkChartOpts opts = do
|
||||
checkCliOpts $ cliopts_ opts
|
||||
return opts
|
||||
|
||||
getHledgerChartOpts :: IO ChartOpts
|
||||
getHledgerChartOpts = processArgs chartmode >>= return . decodeRawOpts >>= toChartOpts >>= checkChartOpts
|
||||
|
||||
@ -35,6 +35,7 @@ executable hledger-chart
|
||||
,hledger-lib == 0.15
|
||||
-- ,HUnit
|
||||
,base >= 3 && < 5
|
||||
,cmdargs >= 0.7 && < 0.8
|
||||
,containers
|
||||
-- ,csv
|
||||
-- ,directory
|
||||
|
||||
@ -115,6 +115,9 @@ orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
|
||||
parsePeriodExpr :: Day -> String -> Either ParseError (Interval, DateSpan)
|
||||
parsePeriodExpr refdate = parsewith (periodexpr refdate)
|
||||
|
||||
maybePeriod :: Day -> String -> Maybe (Interval,DateSpan)
|
||||
maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
|
||||
|
||||
-- | Show a DateSpan as a human-readable pseudo-period-expression string.
|
||||
dateSpanAsText :: DateSpan -> String
|
||||
dateSpanAsText (DateSpan Nothing Nothing) = "all"
|
||||
|
||||
@ -53,7 +53,7 @@ data Matcher = MatchAny -- ^ always match
|
||||
|
||||
-- | A query option changes a query's/report's behaviour and output in some way.
|
||||
|
||||
-- XXX could use regular cli Opts ?
|
||||
-- XXX could use regular CliOpts ?
|
||||
data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register focussed on this account
|
||||
| QueryOptInAcct AccountName -- ^ as above but include sub-accounts in the account register
|
||||
-- | QueryOptCostBasis -- ^ show amounts converted to cost where possible
|
||||
|
||||
@ -36,7 +36,7 @@ import Control.Monad.Error (ErrorT)
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import Data.Tree
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Typeable
|
||||
import qualified Data.Map as Map
|
||||
import System.Time (ClockTime)
|
||||
|
||||
|
||||
@ -15,6 +15,8 @@ module Hledger.Read (
|
||||
myJournal,
|
||||
myTimelog,
|
||||
someamount,
|
||||
journalenvvar,
|
||||
journaldefaultfilename
|
||||
)
|
||||
where
|
||||
import Control.Monad.Error
|
||||
|
||||
@ -12,48 +12,34 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Time.Calendar
|
||||
import Graphics.Vty
|
||||
import Safe (headDef)
|
||||
import System.Console.GetOpt
|
||||
import Safe
|
||||
import Text.Printf
|
||||
|
||||
import Hledger
|
||||
import Prelude hiding (putStr, putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStr, putStrLn)
|
||||
import Hledger.Cli
|
||||
import Hledger.Cli hiding (progname,progversion)
|
||||
import Hledger.Vty.Options
|
||||
import Prelude hiding (putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStrLn)
|
||||
|
||||
|
||||
progname_vty = progname_cli ++ "-vty"
|
||||
|
||||
options_vty :: [OptDescr Opt]
|
||||
options_vty = [
|
||||
Option "" ["debug-vty"] (NoArg DebugVty) "run with no terminal output, showing console"
|
||||
]
|
||||
|
||||
usage_preamble_vty =
|
||||
"Usage: hledger-vty [OPTIONS] [PATTERNS]\n" ++
|
||||
"\n" ++
|
||||
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
|
||||
"starts the full-window curses ui.\n" ++
|
||||
"\n"
|
||||
|
||||
usage_options_vty = usageInfo "hledger-vty options:" options_vty ++ "\n"
|
||||
|
||||
usage_vty = concat [
|
||||
usage_preamble_vty
|
||||
,usage_options_vty
|
||||
,usage_options_cli
|
||||
,usage_postscript_cli
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(opts, args) <- parseArgumentsWith $ options_cli++options_vty
|
||||
run opts args
|
||||
opts <- getHledgerVtyOpts
|
||||
when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
|
||||
runWith opts
|
||||
|
||||
runWith :: VtyOpts -> IO ()
|
||||
runWith opts = run opts
|
||||
where
|
||||
run opts args
|
||||
| Help `elem` opts = putStr usage_vty
|
||||
| Version `elem` opts = putStrLn $ progversionstr progname_vty
|
||||
| BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_vty
|
||||
| otherwise = withJournalDo opts args "vty" vty
|
||||
run opts
|
||||
| "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit vtymode
|
||||
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
|
||||
| otherwise = withJournalDo' opts vty
|
||||
|
||||
withJournalDo' :: VtyOpts -> (VtyOpts -> Journal -> IO ()) -> IO ()
|
||||
withJournalDo' opts cmd = do
|
||||
journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
|
||||
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"
|
||||
|
||||
@ -62,10 +48,10 @@ instance Show Vty where show = const "a Vty"
|
||||
-- | The application state when running the vty command.
|
||||
data AppState = AppState {
|
||||
av :: Vty -- ^ the vty context
|
||||
,aw :: Int -- ^ window width
|
||||
,ah :: Int -- ^ window height
|
||||
,aw :: Int -- ^ window width
|
||||
,ah :: Int -- ^ window height
|
||||
,amsg :: String -- ^ status message
|
||||
,aopts :: [Opt] -- ^ command-line opts
|
||||
,aopts :: VtyOpts -- ^ command-line opts
|
||||
,aargs :: [String] -- ^ command-line args at startup
|
||||
,ajournal :: Journal -- ^ parsed journal
|
||||
,abuf :: [String] -- ^ lines of the current buffered view
|
||||
@ -89,19 +75,19 @@ data Screen = BalanceScreen -- ^ like hledger balance, shows accounts
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Run the vty (curses-style) ui.
|
||||
vty :: [Opt] -> [String] -> Journal -> IO ()
|
||||
vty opts args j = do
|
||||
vty :: VtyOpts -> Journal -> IO ()
|
||||
vty opts j = do
|
||||
v <- mkVty
|
||||
DisplayRegion w h <- display_bounds $ terminal v
|
||||
d <- getCurrentDay
|
||||
let a = enter d BalanceScreen args
|
||||
let a = enter d BalanceScreen (patterns_ $ reportopts_ $ cliopts_ opts)
|
||||
AppState {
|
||||
av=v
|
||||
,aw=fromIntegral w
|
||||
,ah=fromIntegral h
|
||||
,amsg=helpmsg
|
||||
,aopts=opts
|
||||
,aargs=args
|
||||
,aargs=patterns_ $ reportopts_ $ cliopts_ opts
|
||||
,ajournal=j
|
||||
,abuf=[]
|
||||
,alocs=[]
|
||||
@ -111,7 +97,7 @@ vty opts args j = do
|
||||
-- | Update the screen, wait for the next event, repeat.
|
||||
go :: AppState -> IO ()
|
||||
go a@AppState{av=av,aopts=opts} = do
|
||||
when (notElem DebugVty opts) $ update av (renderScreen a)
|
||||
when (not $ debug_vty_ opts) $ update av (renderScreen a)
|
||||
k <- next_event av
|
||||
d <- getCurrentDay
|
||||
case k of
|
||||
@ -268,10 +254,11 @@ resetTrailAndEnter d scr a = enter d scr (aargs a) $ clearLocs a
|
||||
updateData :: Day -> AppState -> AppState
|
||||
updateData d a@AppState{aopts=opts,ajournal=j} =
|
||||
case screen a of
|
||||
BalanceScreen -> a{abuf=accountsReportAsText opts $ accountsReport opts fspec j}
|
||||
RegisterScreen -> a{abuf=lines $ postingsReportAsText opts $ postingsReport opts fspec j}
|
||||
PrintScreen -> a{abuf=lines $ showTransactions opts fspec j}
|
||||
where fspec = optsToFilterSpec opts (currentArgs a) d
|
||||
BalanceScreen -> a{abuf=accountsReportAsText ropts $ accountsReport ropts fspec j}
|
||||
RegisterScreen -> a{abuf=lines $ postingsReportAsText ropts $ postingsReport ropts fspec j}
|
||||
PrintScreen -> a{abuf=lines $ showTransactions ropts fspec j}
|
||||
where fspec = optsToFilterSpec ropts{patterns_=currentArgs a} d
|
||||
ropts = reportopts_ $ cliopts_ opts
|
||||
|
||||
backout :: Day -> AppState -> AppState
|
||||
backout d a | screen a == BalanceScreen = a
|
||||
|
||||
55
hledger-vty/Hledger/Vty/Options.hs
Normal file
55
hledger-vty/Hledger/Vty/Options.hs
Normal file
@ -0,0 +1,55 @@
|
||||
{-|
|
||||
|
||||
-}
|
||||
|
||||
module Hledger.Vty.Options
|
||||
where
|
||||
import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit
|
||||
|
||||
import Hledger.Cli hiding (progname,progversion)
|
||||
import qualified Hledger.Cli (progname)
|
||||
|
||||
progname = Hledger.Cli.progname ++ "-vty"
|
||||
progversion = progversionstr progname
|
||||
|
||||
vtyflags = [
|
||||
flagNone ["debug-vty"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
|
||||
]
|
||||
|
||||
vtymode = (mode "hledger-vty" [("command","vty")]
|
||||
"browse accounts, postings and entries in a full-window curses interface"
|
||||
commandargsflag (vtyflags++generalflags1)){
|
||||
modeHelpSuffix=[
|
||||
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
|
||||
]
|
||||
}
|
||||
|
||||
-- hledger-vty options, used in hledger-vty and above
|
||||
data VtyOpts = VtyOpts {
|
||||
debug_vty_ :: Bool
|
||||
,cliopts_ :: CliOpts
|
||||
} deriving (Show)
|
||||
|
||||
defvtyopts = VtyOpts
|
||||
def
|
||||
def
|
||||
|
||||
-- instance Default CliOpts where def = defcliopts
|
||||
|
||||
toVtyOpts :: RawOpts -> IO VtyOpts
|
||||
toVtyOpts rawopts = do
|
||||
cliopts <- toCliOpts rawopts
|
||||
return defvtyopts {
|
||||
debug_vty_ = boolopt "debug-vty" rawopts
|
||||
,cliopts_ = cliopts
|
||||
}
|
||||
|
||||
checkVtyOpts :: VtyOpts -> IO VtyOpts
|
||||
checkVtyOpts opts = do
|
||||
checkCliOpts $ cliopts_ opts
|
||||
return opts
|
||||
|
||||
getHledgerVtyOpts :: IO VtyOpts
|
||||
getHledgerVtyOpts = processArgs vtymode >>= return . decodeRawOpts >>= toVtyOpts >>= checkVtyOpts
|
||||
|
||||
@ -35,6 +35,7 @@ executable hledger-vty
|
||||
,hledger-lib == 0.15
|
||||
-- ,HUnit
|
||||
,base >= 3 && < 5
|
||||
,cmdargs >= 0.7 && < 0.8
|
||||
-- ,containers
|
||||
-- ,csv
|
||||
-- ,directory
|
||||
|
||||
@ -7,6 +7,7 @@ module Hledger.Web (
|
||||
module Hledger.Web.AppRun,
|
||||
module Hledger.Web.EmbeddedFiles,
|
||||
module Hledger.Web.Handlers,
|
||||
module Hledger.Web.Options,
|
||||
module Hledger.Web.Settings,
|
||||
module Hledger.Web.StaticFiles,
|
||||
tests_Hledger_Web
|
||||
@ -18,6 +19,7 @@ import Hledger.Web.App
|
||||
import Hledger.Web.AppRun
|
||||
import Hledger.Web.EmbeddedFiles
|
||||
import Hledger.Web.Handlers
|
||||
import Hledger.Web.Options
|
||||
import Hledger.Web.Settings
|
||||
import Hledger.Web.StaticFiles
|
||||
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
|
||||
module Hledger.Web.App
|
||||
( App (..)
|
||||
, AppRoute (..)
|
||||
@ -22,8 +21,8 @@ import Text.Hamlet hiding (hamletFile)
|
||||
import Yesod.Core
|
||||
import Yesod.Helpers.Static
|
||||
|
||||
import Hledger.Cli.Options
|
||||
import Hledger.Data
|
||||
import Hledger.Web.Options
|
||||
import Hledger.Web.Settings
|
||||
import Hledger.Web.StaticFiles
|
||||
|
||||
@ -34,7 +33,7 @@ import Hledger.Web.StaticFiles
|
||||
data App = App
|
||||
{getStatic :: Static -- ^ Settings for static file serving.
|
||||
,appRoot :: T.Text
|
||||
,appOpts :: [Opt]
|
||||
,appOpts :: WebOpts
|
||||
,appArgs :: [String]
|
||||
,appJournal :: Journal
|
||||
}
|
||||
|
||||
@ -18,6 +18,7 @@ import Hledger
|
||||
import Hledger.Cli
|
||||
import Hledger.Web.App
|
||||
import Hledger.Web.Handlers
|
||||
import Hledger.Web.Options
|
||||
import Hledger.Web.Settings
|
||||
|
||||
-- This line actually creates our YesodSite instance. It is the second half
|
||||
@ -38,7 +39,7 @@ withDevelApp = toDyn (withApp a :: (Application -> IO ()) -> IO ())
|
||||
where a = App{
|
||||
getStatic=static Hledger.Web.Settings.staticdir
|
||||
,appRoot=Hledger.Web.Settings.defapproot
|
||||
,appOpts=[]
|
||||
,appOpts=defwebopts
|
||||
,appArgs=[]
|
||||
,appJournal=nulljournal
|
||||
}
|
||||
@ -53,7 +54,7 @@ withWaiHandlerDevelApp func = do
|
||||
let a = App{
|
||||
getStatic=static Hledger.Web.Settings.staticdir
|
||||
,appRoot=Settings.defapproot
|
||||
,appOpts=[File f]
|
||||
,appOpts=defwebopts{cliopts_=defcliopts{file_=Just f}}
|
||||
,appArgs=[]
|
||||
,appJournal=j
|
||||
}
|
||||
|
||||
@ -29,6 +29,7 @@ import Yesod.Json
|
||||
import Hledger hiding (today)
|
||||
import Hledger.Cli
|
||||
import Hledger.Web.App
|
||||
import Hledger.Web.Options
|
||||
import Hledger.Web.Settings
|
||||
|
||||
|
||||
@ -60,7 +61,7 @@ getJournalR = do
|
||||
where andsubs = if subs then " (and subaccounts)" else ""
|
||||
where
|
||||
filter = if filtering then ", filtered" else ""
|
||||
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport opts j m
|
||||
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||
defaultLayout $ do
|
||||
setTitle "hledger-web journal"
|
||||
addHamlet [$hamlet|
|
||||
@ -93,7 +94,7 @@ getJournalEntriesR = do
|
||||
let
|
||||
sidecontent = sidebar vd
|
||||
title = "Journal entries" ++ if m /= MatchAny then ", filtered" else "" :: String
|
||||
maincontent = entriesReportAsHtml opts vd $ entriesReport opts nullfilterspec $ filterJournalTransactions2 m j
|
||||
maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
|
||||
defaultLayout $ do
|
||||
setTitle "hledger-web journal"
|
||||
addHamlet [$hamlet|
|
||||
@ -117,7 +118,7 @@ getJournalOnlyR = do
|
||||
vd@VD{..} <- getViewData
|
||||
defaultLayout $ do
|
||||
setTitle "hledger-web journal only"
|
||||
addHamlet $ entriesReportAsHtml opts vd $ entriesReport opts nullfilterspec $ filterJournalTransactions2 m j
|
||||
addHamlet $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
@ -133,7 +134,7 @@ getRegisterR = do
|
||||
(a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts
|
||||
andsubs = if subs then " (and subaccounts)" else ""
|
||||
filter = if filtering then ", filtered" else ""
|
||||
maincontent = registerReportHtml opts vd $ accountTransactionsReport opts j m $ fromMaybe MatchAny $ inAccountMatcher qopts
|
||||
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe MatchAny $ inAccountMatcher qopts
|
||||
defaultLayout $ do
|
||||
setTitle "hledger-web register"
|
||||
addHamlet [$hamlet|
|
||||
@ -158,8 +159,8 @@ getRegisterOnlyR = do
|
||||
defaultLayout $ do
|
||||
setTitle "hledger-web register only"
|
||||
addHamlet $
|
||||
case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport opts j m m'
|
||||
Nothing -> registerReportHtml opts vd $ journalTransactionsReport opts j m
|
||||
case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m'
|
||||
Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
@ -171,7 +172,7 @@ getAccountsR = do
|
||||
let j' = filterJournalPostings2 m j
|
||||
html = do
|
||||
setTitle "hledger-web accounts"
|
||||
addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 opts am j'
|
||||
addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'
|
||||
json = jsonMap [("accounts", toJSON $ journalAccountNames j')]
|
||||
defaultLayoutJson html json
|
||||
|
||||
@ -187,10 +188,10 @@ getAccountsJsonR = do
|
||||
|
||||
-- | Render the sidebar used on most views.
|
||||
sidebar :: ViewData -> Hamlet AppRoute
|
||||
sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 opts am j
|
||||
sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j
|
||||
|
||||
-- | Render a "AccountsReport" as HTML.
|
||||
accountsReportAsHtml :: [Opt] -> ViewData -> AccountsReport -> Hamlet AppRoute
|
||||
accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> Hamlet AppRoute
|
||||
accountsReportAsHtml _ vd@VD{..} (items',total) =
|
||||
[$hamlet|
|
||||
<div#accountsheading
|
||||
@ -271,7 +272,7 @@ accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRe
|
||||
accountUrl r a = (r, [("q",pack $ accountQuery a)])
|
||||
|
||||
-- | Render a "EntriesReport" as HTML for the journal entries view.
|
||||
entriesReportAsHtml :: [Opt] -> ViewData -> EntriesReport -> Hamlet AppRoute
|
||||
entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> Hamlet AppRoute
|
||||
entriesReportAsHtml _ vd items = [$hamlet|
|
||||
<table.journalreport>
|
||||
$forall i <- numbered items
|
||||
@ -289,7 +290,7 @@ entriesReportAsHtml _ vd items = [$hamlet|
|
||||
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
|
||||
|
||||
-- | Render an "TransactionsReport" as HTML for the formatted journal view.
|
||||
journalTransactionsReportAsHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute
|
||||
journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute
|
||||
journalTransactionsReportAsHtml _ vd (_,items) = [$hamlet|
|
||||
<table.journalreport
|
||||
<tr.headings
|
||||
@ -327,14 +328,14 @@ $forall p <- tpostings t
|
||||
showamt = not split || not (isZeroMixedAmount amt)
|
||||
|
||||
-- Generate html for an account register, including a balance chart and transaction list.
|
||||
registerReportHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute
|
||||
registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute
|
||||
registerReportHtml opts vd r@(_,items) = [$hamlet|
|
||||
^{registerChartHtml items}
|
||||
^{registerItemsHtml opts vd r}
|
||||
|]
|
||||
|
||||
-- Generate html for a transaction list from an "TransactionsReport".
|
||||
registerItemsHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute
|
||||
registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute
|
||||
registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
|
||||
<table.registerreport
|
||||
<tr.headings
|
||||
@ -825,7 +826,7 @@ nulltemplate = [$hamlet||]
|
||||
|
||||
-- | A bundle of data useful for hledger-web request handlers and templates.
|
||||
data ViewData = VD {
|
||||
opts :: [Opt] -- ^ the command-line options at startup
|
||||
opts :: WebOpts -- ^ the command-line options at startup
|
||||
,here :: AppRoute -- ^ the current route
|
||||
,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request
|
||||
,today :: Day -- ^ today's date (for queries containing relative dates)
|
||||
@ -848,7 +849,7 @@ viewdataWithDateAndParams d q a p =
|
||||
let (querymatcher,queryopts) = parseQuery d q
|
||||
(acctsmatcher,acctsopts) = parseQuery d a
|
||||
in VD {
|
||||
opts = [NoElide]
|
||||
opts = defwebopts{cliopts_=defcliopts{reportopts_=defreportopts{no_elide_=True}}}
|
||||
,j = nulljournal
|
||||
,here = RootR
|
||||
,msg = Nothing
|
||||
@ -865,8 +866,8 @@ viewdataWithDateAndParams d q a p =
|
||||
getViewData :: Handler ViewData
|
||||
getViewData = do
|
||||
app <- getYesod
|
||||
let opts = appOpts app ++ [NoElide]
|
||||
(j, err) <- getCurrentJournal opts
|
||||
let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app
|
||||
(j, err) <- getCurrentJournal $ copts{reportopts_=ropts{no_elide_=True}}
|
||||
msg <- getMessageOr err
|
||||
Just here <- getCurrentRoute
|
||||
today <- liftIO getCurrentDay
|
||||
@ -884,7 +885,7 @@ getViewData = do
|
||||
-- | Update our copy of the journal if the file changed. If there is an
|
||||
-- error while reloading, keep the old one and return the error, and set a
|
||||
-- ui message.
|
||||
getCurrentJournal :: [Opt] -> Handler (Journal, Maybe String)
|
||||
getCurrentJournal :: CliOpts -> Handler (Journal, Maybe String)
|
||||
getCurrentJournal opts = do
|
||||
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
||||
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
|
||||
|
||||
66
hledger-web/Hledger/Web/Options.hs
Normal file
66
hledger-web/Hledger/Web/Options.hs
Normal file
@ -0,0 +1,66 @@
|
||||
{-|
|
||||
|
||||
-}
|
||||
|
||||
module Hledger.Web.Options
|
||||
where
|
||||
import Data.Maybe
|
||||
import Data.Text (unpack)
|
||||
import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit
|
||||
|
||||
import Hledger.Cli hiding (progname,progversion)
|
||||
import qualified Hledger.Cli (progname)
|
||||
|
||||
import Hledger.Web.Settings
|
||||
|
||||
progname = Hledger.Cli.progname ++ "-web"
|
||||
progversion = progversionstr progname
|
||||
|
||||
defbaseurl = unpack defapproot
|
||||
defbaseurl' = (reverse $ drop 4 $ reverse defbaseurl) ++ "PORT"
|
||||
|
||||
webflags = [
|
||||
flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurl'++")")
|
||||
,flagReq ["port"] (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this tcp port (default: "++show defport++")")
|
||||
]
|
||||
|
||||
webmode = (mode "hledger-web" [("command","web")]
|
||||
"start serving the hledger web interface"
|
||||
commandargsflag (webflags++generalflags1)){
|
||||
modeHelpSuffix=[
|
||||
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
|
||||
]
|
||||
}
|
||||
|
||||
-- hledger-web options, used in hledger-web and above
|
||||
data WebOpts = WebOpts {
|
||||
base_url_ :: String
|
||||
,port_ :: Int
|
||||
,cliopts_ :: CliOpts
|
||||
} deriving (Show)
|
||||
|
||||
defwebopts = WebOpts
|
||||
def
|
||||
def
|
||||
def
|
||||
|
||||
-- instance Default WebOpts where def = defwebopts
|
||||
|
||||
toWebOpts :: RawOpts -> IO WebOpts
|
||||
toWebOpts rawopts = do
|
||||
cliopts <- toCliOpts rawopts
|
||||
return defwebopts {
|
||||
base_url_ = fromMaybe defbaseurl $ maybestringopt "base-url" rawopts
|
||||
,port_ = fromMaybe defport $ maybeintopt "port" rawopts
|
||||
,cliopts_ = cliopts
|
||||
}
|
||||
|
||||
checkWebOpts :: WebOpts -> IO WebOpts
|
||||
checkWebOpts opts = do
|
||||
checkCliOpts $ cliopts_ opts
|
||||
return opts
|
||||
|
||||
getHledgerWebOpts :: IO WebOpts
|
||||
getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= toWebOpts >>= checkWebOpts
|
||||
|
||||
@ -64,6 +64,7 @@ executable hledger-web
|
||||
,HUnit
|
||||
,base >= 4 && < 5
|
||||
,bytestring
|
||||
,cmdargs >= 0.7 && < 0.8
|
||||
-- ,containers
|
||||
-- ,csv
|
||||
,directory
|
||||
|
||||
@ -9,6 +9,7 @@ module Main
|
||||
where
|
||||
|
||||
-- import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Data.Text(pack)
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
@ -16,58 +17,41 @@ import Network.Wai.Handler.Warp (run)
|
||||
#else
|
||||
import Network.Wai.Middleware.Debug (debug)
|
||||
#endif
|
||||
import System.Console.GetOpt
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO.Storage (withStore, putValue)
|
||||
import Text.Printf
|
||||
import Yesod.Helpers.Static
|
||||
|
||||
import Hledger.Cli
|
||||
import Hledger.Cli.Tests (runTestsOrExit)
|
||||
import Hledger.Data
|
||||
import Prelude hiding (putStr, putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStr, putStrLn)
|
||||
import Hledger
|
||||
import Hledger.Cli hiding (progname,progversion)
|
||||
import Hledger.Cli.Tests
|
||||
import Prelude hiding (putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStrLn)
|
||||
import Hledger.Web
|
||||
|
||||
|
||||
progname_web = progname_cli ++ "-web"
|
||||
|
||||
options_web :: [OptDescr Opt]
|
||||
options_web = [
|
||||
Option "" ["base-url"] (ReqArg BaseUrl "URL") "use this base url (default http://localhost:PORT)"
|
||||
,Option "" ["port"] (ReqArg Port "N") "serve on tcp port N (default 5000)"
|
||||
]
|
||||
|
||||
usage_preamble_web =
|
||||
"Usage: hledger-web [OPTIONS] [PATTERNS]\n" ++
|
||||
"\n" ++
|
||||
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
|
||||
"starts a web ui server. Also attempts to start a web browser (unless --debug).\n" ++
|
||||
"\n"
|
||||
|
||||
usage_options_web = usageInfo "hledger-web options:" options_web ++ "\n"
|
||||
|
||||
usage_web = concat [
|
||||
usage_preamble_web
|
||||
,usage_options_web
|
||||
,usage_options_cli
|
||||
,usage_postscript_cli
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(opts, args) <- parseArgumentsWith $ options_cli++options_web
|
||||
run opts args
|
||||
opts <- getHledgerWebOpts
|
||||
when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
|
||||
runWith opts
|
||||
|
||||
runWith :: WebOpts -> IO ()
|
||||
runWith opts = run opts
|
||||
where
|
||||
run opts args
|
||||
| Help `elem` opts = putStr usage_web
|
||||
| Version `elem` opts = putStrLn $ progversionstr progname_web
|
||||
| BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_web
|
||||
| otherwise = withJournalDo opts args "web" web
|
||||
run opts
|
||||
| "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit webmode
|
||||
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
|
||||
| otherwise = withJournalDo' opts web
|
||||
|
||||
withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
|
||||
withJournalDo' opts cmd = do
|
||||
journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
|
||||
either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
|
||||
|
||||
-- | The web command.
|
||||
web :: [Opt] -> [String] -> Journal -> IO ()
|
||||
web opts args j = do
|
||||
web :: WebOpts -> Journal -> IO ()
|
||||
web opts j = do
|
||||
created <- createFilesIfMissing
|
||||
if created
|
||||
then do
|
||||
@ -75,13 +59,10 @@ web opts args j = do
|
||||
exitFailure
|
||||
else do
|
||||
putStrLn $ "Running self-tests..."
|
||||
runTestsOrExit opts args
|
||||
runTestsOrExit $ cliopts_ opts
|
||||
putStrLn $ "Using support files in "++datadir
|
||||
let host = defhost
|
||||
port = fromMaybe defport $ portFromOpts opts
|
||||
baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts
|
||||
-- unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return ()
|
||||
server baseurl port opts args j
|
||||
-- unless (debug_ $ cliopts_ opts) $ forkIO (browser baseurl) >> return ()
|
||||
server (base_url_ opts) (port_ opts) opts j
|
||||
|
||||
-- browser :: String -> IO ()
|
||||
-- browser baseurl = do
|
||||
@ -89,17 +70,18 @@ web opts args j = do
|
||||
-- putStrLn "Attempting to start a web browser"
|
||||
-- openBrowserOn baseurl >> return ()
|
||||
|
||||
server :: String -> Int -> [Opt] -> [String] -> Journal -> IO ()
|
||||
server baseurl port opts args j = do
|
||||
server :: String -> Int -> WebOpts -> Journal -> IO ()
|
||||
server baseurl port opts j = do
|
||||
printf "Starting http server on port %d with base url %s\n" port baseurl
|
||||
let a = App{getStatic=static staticdir
|
||||
,appRoot=pack baseurl
|
||||
,appOpts=opts
|
||||
,appArgs=args
|
||||
,appArgs=patterns_ $ reportopts_ $ cliopts_ opts
|
||||
,appJournal=j
|
||||
}
|
||||
withStore "hledger" $ do
|
||||
putValue "hledger" "journal" j
|
||||
return ()
|
||||
#if PRODUCTION
|
||||
withApp a (run port)
|
||||
#else
|
||||
|
||||
@ -37,7 +37,6 @@ import Hledger.Cli.Options
|
||||
import Hledger.Cli.Utils
|
||||
import Hledger.Cli.Version
|
||||
|
||||
|
||||
-- | hledger and hledger-lib's unit tests aggregated from all modules
|
||||
-- plus some more which are easier to define here for now.
|
||||
tests_Hledger_Cli :: Test
|
||||
@ -108,15 +107,14 @@ tests_Hledger_Cli = TestList
|
||||
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
|
||||
|
||||
,"balance report tests" ~:
|
||||
let (opts,args) `gives` es = do
|
||||
let opts `gives` es = do
|
||||
j <- samplejournal
|
||||
d <- getCurrentDay
|
||||
accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts args d) j) `is` es
|
||||
accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts d) j) `is` es
|
||||
in TestList
|
||||
[
|
||||
|
||||
"balance report with no args" ~:
|
||||
([], []) `gives`
|
||||
defreportopts `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
," $-2 cash"
|
||||
@ -132,7 +130,7 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report can be limited with --depth" ~:
|
||||
([Depth "1"], []) `gives`
|
||||
defreportopts{depth_=Just 1} `gives`
|
||||
[" $-1 assets"
|
||||
," $2 expenses"
|
||||
," $-2 income"
|
||||
@ -142,7 +140,7 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report with account pattern o" ~:
|
||||
([], ["o"]) `gives`
|
||||
defreportopts{patterns_=["o"]} `gives`
|
||||
[" $1 expenses:food"
|
||||
," $-2 income"
|
||||
," $-1 gifts"
|
||||
@ -152,7 +150,7 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report with account pattern o and --depth 1" ~:
|
||||
([Depth "1"], ["o"]) `gives`
|
||||
defreportopts{patterns_=["o"],depth_=Just 1} `gives`
|
||||
[" $1 expenses"
|
||||
," $-2 income"
|
||||
,"--------------------"
|
||||
@ -160,7 +158,7 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report with account pattern a" ~:
|
||||
([], ["a"]) `gives`
|
||||
defreportopts{patterns_=["a"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
," $-2 cash"
|
||||
@ -171,7 +169,7 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report with account pattern e" ~:
|
||||
([], ["e"]) `gives`
|
||||
defreportopts{patterns_=["e"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
," $-2 cash"
|
||||
@ -187,7 +185,7 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report with unmatched parent of two matched subaccounts" ~:
|
||||
([], ["cash","saving"]) `gives`
|
||||
defreportopts{patterns_=["cash","saving"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
," $-2 cash"
|
||||
@ -196,14 +194,14 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report with multi-part account name" ~:
|
||||
([], ["expenses:food"]) `gives`
|
||||
defreportopts{patterns_=["expenses:food"]} `gives`
|
||||
[" $1 expenses:food"
|
||||
,"--------------------"
|
||||
," $1"
|
||||
]
|
||||
|
||||
,"balance report with negative account pattern" ~:
|
||||
([], ["not:assets"]) `gives`
|
||||
defreportopts{patterns_=["not:assets"]} `gives`
|
||||
[" $2 expenses"
|
||||
," $1 food"
|
||||
," $1 supplies"
|
||||
@ -216,20 +214,20 @@ tests_Hledger_Cli = TestList
|
||||
]
|
||||
|
||||
,"balance report negative account pattern always matches full name" ~:
|
||||
([], ["not:e"]) `gives`
|
||||
defreportopts{patterns_=["not:e"]} `gives`
|
||||
["--------------------"
|
||||
," 0"
|
||||
]
|
||||
|
||||
,"balance report negative patterns affect totals" ~:
|
||||
([], ["expenses","not:food"]) `gives`
|
||||
defreportopts{patterns_=["expenses","not:food"]} `gives`
|
||||
[" $1 expenses:supplies"
|
||||
,"--------------------"
|
||||
," $1"
|
||||
]
|
||||
|
||||
,"balance report with -E shows zero-balance accounts" ~:
|
||||
([Empty], ["assets"]) `gives`
|
||||
defreportopts{patterns_=["assets"],empty_=True} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank"
|
||||
," 0 checking"
|
||||
@ -247,7 +245,7 @@ tests_Hledger_Cli = TestList
|
||||
," c:d "
|
||||
]) >>= either error' return
|
||||
let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
|
||||
accountsReportAsText [] (accountsReport [] nullfilterspec j') `is`
|
||||
accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j') `is`
|
||||
[" $500 a:b"
|
||||
," $-500 c:d"
|
||||
,"--------------------"
|
||||
@ -261,7 +259,7 @@ tests_Hledger_Cli = TestList
|
||||
," test:a 1"
|
||||
," test:b"
|
||||
])
|
||||
accountsReportAsText [] (accountsReport [] nullfilterspec j) `is`
|
||||
accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j) `is`
|
||||
[" 1 test:a"
|
||||
," -1 test:b"
|
||||
,"--------------------"
|
||||
@ -294,11 +292,10 @@ tests_Hledger_Cli = TestList
|
||||
|
||||
"print expenses" ~:
|
||||
do
|
||||
let args = ["expenses"]
|
||||
opts = []
|
||||
let opts = defreportopts{patterns_=["expenses"]}
|
||||
j <- samplejournal
|
||||
d <- getCurrentDay
|
||||
showTransactions opts (optsToFilterSpec opts args d) j `is` unlines
|
||||
showTransactions opts (optsToFilterSpec opts d) j `is` unlines
|
||||
["2008/06/03 * eat & shop"
|
||||
," expenses:food $1"
|
||||
," expenses:supplies $1"
|
||||
@ -308,9 +305,10 @@ tests_Hledger_Cli = TestList
|
||||
|
||||
, "print report with depth arg" ~:
|
||||
do
|
||||
let opts = defreportopts{depth_=Just 2}
|
||||
j <- samplejournal
|
||||
d <- getCurrentDay
|
||||
showTransactions [] (optsToFilterSpec [Depth "2"] [] d) j `is` unlines
|
||||
showTransactions opts (optsToFilterSpec opts d) j `is` unlines
|
||||
["2008/01/01 income"
|
||||
," income:salary $-1"
|
||||
,""
|
||||
@ -338,7 +336,8 @@ tests_Hledger_Cli = TestList
|
||||
"register report with no args" ~:
|
||||
do
|
||||
j <- samplejournal
|
||||
(postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
|
||||
let opts = defreportopts
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/01/01 income assets:bank:checking $1 $1"
|
||||
," income:salary $-1 0"
|
||||
,"2008/06/01 gift assets:bank:checking $1 $1"
|
||||
@ -354,9 +353,9 @@ tests_Hledger_Cli = TestList
|
||||
|
||||
,"register report with cleared option" ~:
|
||||
do
|
||||
let opts = [Cleared]
|
||||
let opts = defreportopts{cleared_=True}
|
||||
j <- readJournal' sample_journal_str
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/06/03 eat & shop expenses:food $1 $1"
|
||||
," expenses:supplies $1 $2"
|
||||
," assets:cash $-2 0"
|
||||
@ -366,9 +365,9 @@ tests_Hledger_Cli = TestList
|
||||
|
||||
,"register report with uncleared option" ~:
|
||||
do
|
||||
let opts = [UnCleared]
|
||||
let opts = defreportopts{uncleared_=True}
|
||||
j <- readJournal' sample_journal_str
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/01/01 income assets:bank:checking $1 $1"
|
||||
," income:salary $-1 0"
|
||||
,"2008/06/01 gift assets:bank:checking $1 $1"
|
||||
@ -388,19 +387,22 @@ tests_Hledger_Cli = TestList
|
||||
," e 1"
|
||||
," f"
|
||||
]
|
||||
registerdates (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` ["2008/01/01","2008/02/02"]
|
||||
let opts = defreportopts
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/02/02"]
|
||||
|
||||
,"register report with account pattern" ~:
|
||||
do
|
||||
j <- samplejournal
|
||||
(postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] ["cash"] date1) j) `is` unlines
|
||||
let opts = defreportopts{patterns_=["cash"]}
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/06/03 eat & shop assets:cash $-2 $-2"
|
||||
]
|
||||
|
||||
,"register report with account pattern, case insensitive" ~:
|
||||
do
|
||||
j <- samplejournal
|
||||
(postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] ["cAsH"] date1) j) `is` unlines
|
||||
let opts = defreportopts{patterns_=["cAsH"]}
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/06/03 eat & shop assets:cash $-2 $-2"
|
||||
]
|
||||
|
||||
@ -408,8 +410,8 @@ tests_Hledger_Cli = TestList
|
||||
do
|
||||
j <- samplejournal
|
||||
let gives displayexpr =
|
||||
(registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is`)
|
||||
where opts = [Display displayexpr]
|
||||
(registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is`)
|
||||
where opts = defreportopts{display_=Just displayexpr}
|
||||
"d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"]
|
||||
"d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
|
||||
"d=[2008/6/2]" `gives` ["2008/06/02"]
|
||||
@ -421,16 +423,16 @@ tests_Hledger_Cli = TestList
|
||||
j <- samplejournal
|
||||
let periodexpr `gives` dates = do
|
||||
j' <- samplejournal
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j') `is` dates
|
||||
where opts = [Period periodexpr]
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j') `is` dates
|
||||
where opts = defreportopts{period_=maybePeriod date1 periodexpr}
|
||||
"" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
|
||||
"2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
|
||||
"2007" `gives` []
|
||||
"june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]
|
||||
"monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
|
||||
"quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
|
||||
let opts = [Period "yearly"]
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
|
||||
let opts = defreportopts{period_=maybePeriod date1 "yearly"}
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1"
|
||||
," assets:cash $-2 $-1"
|
||||
," expenses:food $1 0"
|
||||
@ -439,18 +441,18 @@ tests_Hledger_Cli = TestList
|
||||
," income:salary $-1 $-1"
|
||||
," liabilities:debts $1 0"
|
||||
]
|
||||
let opts = [Period "quarterly"]
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
|
||||
let opts = [Period "quarterly",Empty]
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
|
||||
let opts = defreportopts{period_=maybePeriod date1 "quarterly"}
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
|
||||
let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}
|
||||
registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
|
||||
|
||||
]
|
||||
|
||||
, "register report with depth arg" ~:
|
||||
do
|
||||
j <- samplejournal
|
||||
let opts = [Depth "2"]
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
|
||||
let opts = defreportopts{depth_=Just 2}
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2008/01/01 income assets:bank $1 $1"
|
||||
," income:salary $-1 0"
|
||||
,"2008/06/01 gift assets:bank $1 $1"
|
||||
@ -471,7 +473,8 @@ tests_Hledger_Cli = TestList
|
||||
,"unicode in balance layout" ~: do
|
||||
j <- readJournal'
|
||||
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
accountsReportAsText [] (accountsReport [] (optsToFilterSpec [] [] date1) j) `is`
|
||||
let opts = defreportopts
|
||||
accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts date1) j) `is`
|
||||
[" -100 актив:наличные"
|
||||
," 100 расходы:покупки"
|
||||
,"--------------------"
|
||||
@ -481,7 +484,8 @@ tests_Hledger_Cli = TestList
|
||||
,"unicode in register layout" ~: do
|
||||
j <- readJournal'
|
||||
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
(postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
|
||||
let opts = defreportopts
|
||||
(postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
|
||||
["2009/01/01 медвежья шкура расходы:покупки 100 100"
|
||||
," актив:наличные -100 0"]
|
||||
|
||||
@ -921,4 +925,3 @@ journalWithAmounts as =
|
||||
[]
|
||||
(TOD 0 0)
|
||||
where parse = fromparse . parseWithCtx nullctx someamount
|
||||
|
||||
|
||||
@ -49,8 +49,8 @@ data PostingState = PostingState {
|
||||
-- | Read transactions from the terminal, prompting for each field,
|
||||
-- and append them to the journal file. If the journal came from stdin, this
|
||||
-- command has no effect.
|
||||
add :: [Opt] -> [String] -> Journal -> IO ()
|
||||
add opts args j
|
||||
add :: CliOpts -> Journal -> IO ()
|
||||
add opts j
|
||||
| f == "-" = return ()
|
||||
| otherwise = do
|
||||
hPutStrLn stderr $
|
||||
@ -58,7 +58,7 @@ add opts args j
|
||||
++"To complete a transaction, enter . when prompted for an account.\n"
|
||||
++"To quit, press control-d or control-c."
|
||||
today <- getCurrentDay
|
||||
getAndAddTransactions j opts args today
|
||||
getAndAddTransactions j opts today
|
||||
`catch` (\e -> unless (isEOFError e) $ ioError e)
|
||||
where f = journalFilePath j
|
||||
|
||||
@ -66,29 +66,29 @@ add opts args j
|
||||
-- validating, displaying and appending them to the journal file, until
|
||||
-- end of input (then raise an EOF exception). Any command-line arguments
|
||||
-- are used as the first transaction's description.
|
||||
getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()
|
||||
getAndAddTransactions j opts args defaultDate = do
|
||||
(t, d) <- getTransaction j opts args defaultDate
|
||||
getAndAddTransactions :: Journal -> CliOpts -> Day -> IO ()
|
||||
getAndAddTransactions j opts defaultDate = do
|
||||
(t, d) <- getTransaction j opts defaultDate
|
||||
j <- journalAddTransaction j opts t
|
||||
getAndAddTransactions j opts args d
|
||||
getAndAddTransactions j opts d
|
||||
|
||||
-- | Read a transaction from the command line, with history-aware prompting.
|
||||
getTransaction :: Journal -> [Opt] -> [String] -> Day
|
||||
getTransaction :: Journal -> CliOpts -> Day
|
||||
-> IO (Transaction,Day)
|
||||
getTransaction j opts args defaultDate = do
|
||||
getTransaction j opts defaultDate = do
|
||||
today <- getCurrentDay
|
||||
datestr <- runInteractionDefault $ askFor "date"
|
||||
(Just $ showDate defaultDate)
|
||||
(Just $ \s -> null s ||
|
||||
isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
|
||||
description <- runInteractionDefault $ askFor "description" (Just "") Nothing
|
||||
let historymatches = transactionsSimilarTo j args description
|
||||
let historymatches = transactionsSimilarTo j (patterns_ $ reportopts_ opts) description
|
||||
bestmatch | null historymatches = Nothing
|
||||
| otherwise = Just $ snd $ head historymatches
|
||||
bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch
|
||||
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
|
||||
accept x = x == "." || (not . null) x &&
|
||||
if NoNewAccts `elem` opts
|
||||
if no_new_accounts_ opts
|
||||
then isJust $ Foldable.find (== x) ant
|
||||
else True
|
||||
where (ant,_,_,_) = groupPostings $ journalPostings j
|
||||
@ -190,11 +190,11 @@ askFor prompt def validator = do
|
||||
|
||||
-- | Append this transaction to the journal's file, and to the journal's
|
||||
-- transaction list.
|
||||
journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal
|
||||
journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal
|
||||
journalAddTransaction j@Journal{jtxns=ts} opts t = do
|
||||
let f = journalFilePath j
|
||||
appendToJournalFile f $ showTransaction t
|
||||
when (Debug `elem` opts) $ do
|
||||
when (debug_ opts) $ do
|
||||
putStrLn $ printf "\nAdded transaction to %s:" f
|
||||
putStrLn =<< registerFromString (show t)
|
||||
return j{jtxns=ts++[t]}
|
||||
@ -219,8 +219,8 @@ registerFromString :: String -> IO String
|
||||
registerFromString s = do
|
||||
d <- getCurrentDay
|
||||
j <- readJournal' s
|
||||
return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] d) j
|
||||
where opts = [Empty]
|
||||
return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts d) j
|
||||
where opts = defreportopts{empty_=True}
|
||||
|
||||
-- | Return a similarity measure, from 0 to 1, for two strings.
|
||||
-- This is Simon White's letter pairs algorithm from
|
||||
|
||||
@ -115,26 +115,27 @@ import Hledger.Cli.Reports
|
||||
|
||||
|
||||
-- | Print a balance report.
|
||||
balance :: [Opt] -> [String] -> Journal -> IO ()
|
||||
balance opts args j = do
|
||||
balance :: CliOpts -> Journal -> IO ()
|
||||
balance CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
let lines = case parseFormatFromOpts opts of
|
||||
let lines = case formatFromOpts ropts of
|
||||
Left err -> [err]
|
||||
Right _ -> accountsReportAsText opts $ accountsReport opts (optsToFilterSpec opts args d) j
|
||||
Right _ -> accountsReportAsText ropts $ accountsReport ropts (optsToFilterSpec ropts d) j
|
||||
putStr $ unlines lines
|
||||
|
||||
-- | Render a balance report as plain text suitable for console output.
|
||||
accountsReportAsText :: [Opt] -> AccountsReport -> [String]
|
||||
accountsReportAsText :: ReportOpts -> AccountsReport -> [String]
|
||||
accountsReportAsText opts (items, total) = concat lines ++ t
|
||||
where
|
||||
lines = map (accountsReportItemAsText opts format) items
|
||||
format = formatFromOpts opts
|
||||
t = if NoTotal `elem` opts
|
||||
then []
|
||||
else ["--------------------"
|
||||
-- TODO: This must use the format somehow
|
||||
, padleft 20 $ showMixedAmountWithoutPrice total
|
||||
]
|
||||
lines = case formatFromOpts opts of
|
||||
Right f -> map (accountsReportItemAsText opts f) items
|
||||
Left err -> [[err]]
|
||||
t = if no_total_ opts
|
||||
then []
|
||||
else ["--------------------"
|
||||
-- TODO: This must use the format somehow
|
||||
,padleft 20 $ showMixedAmountWithoutPrice total
|
||||
]
|
||||
|
||||
{-
|
||||
This implementation turned out to be a bit convoluted but implements the following algorithm for formatting:
|
||||
@ -147,7 +148,7 @@ This implementation turned out to be a bit convoluted but implements the followi
|
||||
b USD -1 ; Account 'b' has two amounts. The account name is printed on the last line.
|
||||
-}
|
||||
-- | Render one balance report line item as plain text.
|
||||
accountsReportItemAsText :: [Opt] -> [FormatString] -> AccountsReportItem -> [String]
|
||||
accountsReportItemAsText :: ReportOpts -> [FormatString] -> AccountsReportItem -> [String]
|
||||
accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) =
|
||||
case amounts of
|
||||
[] -> []
|
||||
@ -159,7 +160,7 @@ accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) =
|
||||
asText [a] = [formatAccountsReportItem opts (Just accountName) depth a format]
|
||||
asText (a:as) = (formatAccountsReportItem opts Nothing depth a format) : asText as
|
||||
|
||||
formatAccountsReportItem :: [Opt] -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String
|
||||
formatAccountsReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String
|
||||
formatAccountsReportItem _ _ _ _ [] = ""
|
||||
formatAccountsReportItem opts accountName depth amount (f:fs) = s ++ (formatAccountsReportItem opts accountName depth amount fs)
|
||||
where
|
||||
@ -167,7 +168,7 @@ formatAccountsReportItem opts accountName depth amount (f:fs) = s ++ (formatAcco
|
||||
FormatLiteral l -> l
|
||||
FormatField leftJustified min max field -> formatAccount opts accountName depth amount leftJustified min max field
|
||||
|
||||
formatAccount :: [Opt] -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String
|
||||
formatAccount :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String
|
||||
formatAccount opts accountName depth balance leftJustified min max field = case field of
|
||||
Format.Account -> formatValue leftJustified min max a
|
||||
DepthSpacer -> case min of
|
||||
@ -176,7 +177,7 @@ formatAccount opts accountName depth balance leftJustified min max field = case
|
||||
Total -> formatValue leftJustified min max $ showAmountWithoutPrice balance
|
||||
_ -> ""
|
||||
where
|
||||
a = maybe "" (accountNameDrop (dropFromOpts opts)) accountName
|
||||
a = maybe "" (accountNameDrop (drop_ opts)) accountName
|
||||
|
||||
tests_Hledger_Cli_Balance = TestList
|
||||
[
|
||||
|
||||
@ -8,8 +8,7 @@ import Prelude hiding (getContents)
|
||||
import Control.Monad (when, guard, liftM)
|
||||
import Data.Maybe
|
||||
import Data.Time.Format (parseTime)
|
||||
import Safe (atDef, atMay, maximumDef)
|
||||
import Safe (readDef, readMay)
|
||||
import Safe
|
||||
import System.Directory (doesFileExist)
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath (takeBaseName, replaceExtension)
|
||||
@ -23,13 +22,14 @@ import Text.Printf (hPrintf)
|
||||
import Hledger.Cli.Format
|
||||
import qualified Hledger.Cli.Format as Format
|
||||
import Hledger.Cli.Version
|
||||
import Hledger.Cli.Options (Opt(Debug), progname_cli, rulesFileFromOpts)
|
||||
import Hledger.Cli.Options
|
||||
import Hledger.Cli.Reports
|
||||
import Hledger.Data.Amount (nullmixedamt, costOfMixedAmount)
|
||||
import Hledger.Data.Dates (firstJust, showDate, parsedate)
|
||||
import Hledger.Data (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
|
||||
import Hledger.Data.Journal (nullctx)
|
||||
import Hledger.Read.JournalReader (someamount,ledgeraccountname)
|
||||
import Hledger.Utils (choice', strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error', regexMatchesCI, regexReplaceCI)
|
||||
import Hledger.Utils
|
||||
import Hledger.Utils.UTF8 (getContents)
|
||||
|
||||
{- |
|
||||
@ -84,20 +84,19 @@ type CsvRecord = [String]
|
||||
|
||||
-- | Read the CSV file named as an argument and print equivalent journal transactions,
|
||||
-- using/creating a .rules file.
|
||||
convert :: [Opt] -> [String] -> Journal -> IO ()
|
||||
convert opts args _ = do
|
||||
when (null args) $ error' "please specify a csv data file."
|
||||
let csvfile = head args
|
||||
convert :: CliOpts -> Journal -> IO ()
|
||||
convert opts _ = do
|
||||
let csvfile = headDef "" $ patterns_ $ reportopts_ opts
|
||||
when (null csvfile) $ error' "please specify a csv data file."
|
||||
let
|
||||
rulesFileSpecified = isJust $ rulesFileFromOpts opts
|
||||
rulesFileSpecified = isJust $ rules_file_ opts
|
||||
rulesfile = rulesFileFor opts csvfile
|
||||
usingStdin = csvfile == "-"
|
||||
when (usingStdin && (not rulesFileSpecified)) $ error' "please specify a files file when converting stdin"
|
||||
csvparse <- parseCsv csvfile
|
||||
let records = case csvparse of
|
||||
Left e -> error' $ show e
|
||||
Right rs -> reverse $ filter (/= [""]) rs
|
||||
let debug = Debug `elem` opts
|
||||
rulesfile = rulesFileFor opts csvfile
|
||||
exists <- doesFileExist rulesfile
|
||||
if (not exists) then do
|
||||
hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile
|
||||
@ -106,12 +105,12 @@ convert opts args _ = do
|
||||
hPrintf stderr "using conversion rules file %s\n" rulesfile
|
||||
rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile
|
||||
let invalid = validateRules rules
|
||||
when debug $ hPrintf stderr "rules: %s\n" (show rules)
|
||||
when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)
|
||||
when (isJust invalid) $ error (fromJust invalid)
|
||||
let requiredfields = max 2 (maxFieldIndex rules + 1)
|
||||
badrecords = take 1 $ filter ((< requiredfields).length) records
|
||||
if null badrecords
|
||||
then mapM_ (printTxn debug rules) records
|
||||
then mapM_ (printTxn (debug_ opts) rules) records
|
||||
else do
|
||||
hPrintf stderr (unlines [
|
||||
"Warning, at least one CSV record does not contain a field referenced by the"
|
||||
@ -142,17 +141,13 @@ maxFieldIndex r = maximumDef (-1) $ catMaybes [
|
||||
,effectiveDateField r
|
||||
]
|
||||
|
||||
rulesFileFor :: [Opt] -> FilePath -> FilePath
|
||||
rulesFileFor opts csvfile =
|
||||
case opt of
|
||||
Just path -> path
|
||||
Nothing -> replaceExtension csvfile ".rules"
|
||||
where
|
||||
opt = rulesFileFromOpts opts
|
||||
rulesFileFor :: CliOpts -> FilePath -> FilePath
|
||||
rulesFileFor CliOpts{rules_file_=Just f} _ = f
|
||||
rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules"
|
||||
|
||||
initialRulesFileContent :: String
|
||||
initialRulesFileContent =
|
||||
"# csv conversion rules file generated by "++(progversionstr progname_cli)++"\n" ++
|
||||
"# csv conversion rules file generated by "++(progversionstr progname)++"\n" ++
|
||||
"# Add rules to this file for more accurate conversion, see\n"++
|
||||
"# http://hledger.org/MANUAL.html#convert\n" ++
|
||||
"\n" ++
|
||||
|
||||
@ -13,6 +13,7 @@ import Data.Ord
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Cli.Options
|
||||
import Hledger.Cli.Reports
|
||||
import Hledger.Data
|
||||
import Prelude hiding (putStr)
|
||||
import Hledger.Utils.UTF8 (putStr)
|
||||
@ -22,12 +23,12 @@ barchar = '*'
|
||||
|
||||
-- | Print a histogram of some statistic per reporting interval, such as
|
||||
-- number of postings per day.
|
||||
histogram :: [Opt] -> [String] -> Journal -> IO ()
|
||||
histogram opts args j = do
|
||||
histogram :: CliOpts -> Journal -> IO ()
|
||||
histogram CliOpts{reportopts_=reportopts_} j = do
|
||||
d <- getCurrentDay
|
||||
putStr $ showHistogram opts (optsToFilterSpec opts args d) j
|
||||
putStr $ showHistogram reportopts_ (optsToFilterSpec reportopts_ d) j
|
||||
|
||||
showHistogram :: [Opt] -> FilterSpec -> Journal -> String
|
||||
showHistogram :: ReportOpts -> FilterSpec -> Journal -> String
|
||||
showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps
|
||||
where
|
||||
i = intervalFromOpts opts
|
||||
@ -40,13 +41,13 @@ showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps
|
||||
-- should count transactions, not postings ?
|
||||
ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
|
||||
filterempties
|
||||
| Empty `elem` opts = id
|
||||
| empty_ opts = id
|
||||
| otherwise = filter (not . isZeroMixedAmount . pamount)
|
||||
matchapats = matchpats apats . paccount
|
||||
apats = acctpats filterspec
|
||||
filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
|
||||
| otherwise = id
|
||||
depth = fromMaybe 99999 $ depthFromOpts opts
|
||||
depth = fromMaybe 99999 $ depth_ opts
|
||||
|
||||
printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
|
||||
|
||||
|
||||
@ -39,7 +39,9 @@ See "Hledger.Data.Ledger" for more examples.
|
||||
|
||||
module Hledger.Cli.Main where
|
||||
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Cli.Add
|
||||
import Hledger.Cli.Balance
|
||||
@ -52,38 +54,49 @@ import Hledger.Cli.Options
|
||||
import Hledger.Cli.Tests
|
||||
import Hledger.Cli.Utils
|
||||
import Hledger.Cli.Version
|
||||
import Hledger.Utils
|
||||
import Prelude hiding (putStr, putStrLn)
|
||||
import Hledger.Utils.UTF8 (putStr, putStrLn)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(opts, args) <- parseArgumentsWith options_cli
|
||||
case validateOpts opts of
|
||||
Just err -> error' err
|
||||
Nothing -> run opts args
|
||||
opts <- getHledgerOpts
|
||||
when (debug_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
|
||||
runWith opts
|
||||
|
||||
run opts args =
|
||||
run opts args
|
||||
runWith :: CliOpts -> IO ()
|
||||
runWith opts = run' opts
|
||||
where
|
||||
run opts _
|
||||
| Help `elem` opts = putStr usage_cli
|
||||
| Version `elem` opts = putStrLn $ progversionstr progname_cli
|
||||
| BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_cli
|
||||
run _ [] = argsError "a command is required."
|
||||
run opts (cmd:args)
|
||||
| cmd `isPrefixOf` "balance" = withJournalDo opts args cmd balance
|
||||
| cmd `isPrefixOf` "convert" = withJournalDo opts args cmd convert
|
||||
| cmd `isPrefixOf` "print" = withJournalDo opts args cmd print'
|
||||
| cmd `isPrefixOf` "register" = withJournalDo opts args cmd register
|
||||
| cmd `isPrefixOf` "histogram" = withJournalDo opts args cmd histogram
|
||||
| cmd `isPrefixOf` "add" = withJournalDo opts args cmd add
|
||||
| cmd `isPrefixOf` "stats" = withJournalDo opts args cmd stats
|
||||
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
|
||||
| otherwise = argsError $ "command "++cmd++" is unrecognized."
|
||||
cmd = command_ opts
|
||||
run' opts
|
||||
| null cmd = printModeHelpAndExit mainmode
|
||||
| any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance
|
||||
| any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram
|
||||
| cmd `isPrefixOf` "add" = showModeHelpOr addmode $ withJournalDo opts add
|
||||
| cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ withJournalDo opts convert
|
||||
| any (cmd `isPrefixOf`) ["entries","print"] = showModeHelpOr entriesmode $ withJournalDo opts print'
|
||||
| any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register
|
||||
| cmd `isPrefixOf` "stats" = showModeHelpOr statsmode $ withJournalDo opts stats
|
||||
| cmd `isPrefixOf` "test" = showModeHelpOr testmode $ runtests opts >> return ()
|
||||
| cmd `isPrefixOf` "binaryfilename" = showModeHelpOr binaryfilenamemode $ putStrLn $ binaryfilename progname
|
||||
| otherwise = showModeHelpOr mainmode $ optserror $ "command "++cmd++" is not recognized"
|
||||
showModeHelpOr mode f = do
|
||||
when ("help" `in_` (rawopts_ opts)) $ printModeHelpAndExit mode
|
||||
when ("version" `in_` (rawopts_ opts)) $ printVersionAndExit
|
||||
f
|
||||
|
||||
validateOpts :: [Opt] -> Maybe String
|
||||
validateOpts opts =
|
||||
case parseFormatFromOpts opts of
|
||||
Left err -> Just $ unlines ["Invalid format", err]
|
||||
Right _ -> Nothing
|
||||
{- tests:
|
||||
|
||||
hledger -> main help
|
||||
hledger --help -> main help
|
||||
hledger --help command -> command help
|
||||
hledger command --help -> command help
|
||||
hledger badcommand -> unrecognized command, try --help (non-zero exit)
|
||||
hledger badcommand --help -> main help
|
||||
hledger --help badcommand -> main help
|
||||
hledger --mainflag command -> works
|
||||
hledger command --mainflag -> works
|
||||
hledger command --commandflag -> works
|
||||
hledger command --mainflag --commandflag -> works
|
||||
XX hledger --mainflag command --commandflag -> works
|
||||
XX hledger --commandflag command -> works
|
||||
XX hledger --commandflag command --mainflag -> works
|
||||
|
||||
-}
|
||||
@ -1,234 +1,401 @@
|
||||
{-|
|
||||
Command-line options for the application.
|
||||
|
||||
Command-line options for the hledger program, and option-parsing utilities.
|
||||
|
||||
-}
|
||||
|
||||
module Hledger.Cli.Options
|
||||
where
|
||||
import Data.Char (toLower)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Time.Calendar
|
||||
import System.Console.GetOpt
|
||||
import Safe
|
||||
import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import System.Console.CmdArgs.Text
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import Test.HUnit
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Cli.Format as Format
|
||||
import Hledger.Read (myJournalPath, myTimelogPath)
|
||||
import Hledger.Cli.Reports
|
||||
import Hledger.Cli.Version
|
||||
import Hledger.Data
|
||||
import Hledger.Read
|
||||
import Hledger.Utils
|
||||
|
||||
|
||||
progname_cli = "hledger"
|
||||
progname = "hledger"
|
||||
progversion = progversionstr progname
|
||||
|
||||
-- | The program name which, if we are invoked as (via symlink or
|
||||
-- renaming), causes us to default to reading the user's time log instead
|
||||
-- of their journal.
|
||||
progname_cli_time = "hours"
|
||||
-- 1. cmdargs mode and flag definitions, for the main and subcommand modes.
|
||||
-- Flag values are parsed initially to simple RawOpts to permit reuse.
|
||||
|
||||
usage_preamble_cli =
|
||||
"Usage: hledger [OPTIONS] COMMAND [PATTERNS]\n" ++
|
||||
" hledger [OPTIONS] convert CSVFILE\n" ++
|
||||
"\n" ++
|
||||
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
|
||||
"runs the specified command (may be abbreviated):\n" ++
|
||||
"\n" ++
|
||||
" add - prompt for new transactions and add them to the journal\n" ++
|
||||
" balance - show accounts, with balances\n" ++
|
||||
" convert - show the specified CSV file as a hledger journal\n" ++
|
||||
" histogram - show a barchart of transactions per day or other interval\n" ++
|
||||
" print - show transactions in journal format\n" ++
|
||||
" register - show transactions as a register with running balance\n" ++
|
||||
" stats - show various statistics for a journal\n" ++
|
||||
" test - run self-tests\n" ++
|
||||
"\n"
|
||||
type RawOpts = [(String,String)]
|
||||
|
||||
usage_options_cli = usageInfo "hledger options:" options_cli
|
||||
defmode :: Mode RawOpts
|
||||
defmode = Mode {
|
||||
modeNames = []
|
||||
,modeHelp = ""
|
||||
,modeHelpSuffix = []
|
||||
,modeValue = []
|
||||
,modeCheck = Right
|
||||
,modeReform = const Nothing
|
||||
,modeGroupFlags = toGroup []
|
||||
,modeArgs = Nothing
|
||||
,modeGroupModes = toGroup []
|
||||
}
|
||||
|
||||
usage_postscript_cli =
|
||||
"\n" ++
|
||||
"DATES can be y/m/d or smart dates like \"last month\". PATTERNS are regular\n" ++
|
||||
"expressions which filter by account name. Prefix a pattern with desc: to\n" ++
|
||||
"filter by transaction description instead, prefix with not: to negate it.\n" ++
|
||||
"When using both, not: comes last.\n"
|
||||
mainmode = defmode {
|
||||
modeNames = [progname]
|
||||
,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. When mixing general and command-specific flags, put them all after COMMAND."
|
||||
,modeHelpSuffix = help_postscript
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
,modeArgs = Just mainargsflag
|
||||
,modeGroupModes = Group {
|
||||
groupUnnamed = [
|
||||
]
|
||||
,groupHidden = [
|
||||
binaryfilenamemode
|
||||
]
|
||||
,groupNamed = [
|
||||
("Misc commands", [
|
||||
addmode
|
||||
,convertmode
|
||||
,testmode
|
||||
])
|
||||
,("\nReport commands", [
|
||||
accountsmode
|
||||
,entriesmode
|
||||
,postingsmode
|
||||
-- ,transactionsmode
|
||||
,activitymode
|
||||
,statsmode
|
||||
])
|
||||
]
|
||||
}
|
||||
}
|
||||
|
||||
usage_cli = concat [
|
||||
usage_preamble_cli
|
||||
,usage_options_cli
|
||||
,usage_postscript_cli
|
||||
]
|
||||
|
||||
-- | Command-line options we accept.
|
||||
options_cli :: [OptDescr Opt]
|
||||
options_cli = [
|
||||
Option "f" ["file"] (ReqArg File "FILE") "use a different journal/timelog file; - means stdin"
|
||||
,Option "b" ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date"
|
||||
,Option "e" ["end"] (ReqArg End "DATE") "report on transactions before this date"
|
||||
,Option "p" ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++
|
||||
"and/or with the specified reporting interval\n")
|
||||
,Option "C" ["cleared"] (NoArg Cleared) "report only on cleared transactions"
|
||||
,Option "U" ["uncleared"] (NoArg UnCleared) "report only on uncleared transactions"
|
||||
,Option "B" ["cost","basis"] (NoArg CostBasis) "report cost of commodities"
|
||||
,Option "" ["alias"] (ReqArg Alias "ACCT=ALIAS") "display ACCT's name as ALIAS in reports"
|
||||
,Option "" ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this"
|
||||
,Option "d" ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++
|
||||
"EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")
|
||||
,Option "" ["effective"] (NoArg Effective) "use transactions' effective dates, if any"
|
||||
,Option "E" ["empty"] (NoArg Empty) "show empty/zero things which are normally elided"
|
||||
,Option "" ["no-elide"] (NoArg NoElide) "no eliding at all, stronger than -E (eg for balance report)"
|
||||
,Option "R" ["real"] (NoArg Real) "report only on real (non-virtual) transactions"
|
||||
,Option "" ["flat"] (NoArg Flat) "balance: show full account names, unindented"
|
||||
,Option "" ["drop"] (ReqArg Drop "N") "balance: with --flat, elide first N account name components"
|
||||
,Option "" ["no-total"] (NoArg NoTotal) "balance: hide the final total"
|
||||
,Option "D" ["daily"] (NoArg DailyOpt) "register, stats: report by day"
|
||||
,Option "W" ["weekly"] (NoArg WeeklyOpt) "register, stats: report by week"
|
||||
,Option "M" ["monthly"] (NoArg MonthlyOpt) "register, stats: report by month"
|
||||
,Option "Q" ["quarterly"] (NoArg QuarterlyOpt) "register, stats: report by quarter"
|
||||
,Option "Y" ["yearly"] (NoArg YearlyOpt) "register, stats: report by year"
|
||||
,Option "" ["no-new-accounts"] (NoArg NoNewAccts) "add: don't allow creating new accounts"
|
||||
,Option "r" ["rules"] (ReqArg RulesFile "FILE") "convert: rules file to use (default:JOURNAL.rules)"
|
||||
,Option "F" ["format"] (ReqArg ReportFormat "STR") "use STR as the format"
|
||||
,Option "v" ["verbose"] (NoArg Verbose) "show more verbose output"
|
||||
,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose"
|
||||
,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"
|
||||
,Option "V" ["version"] (NoArg Version) "show version information"
|
||||
,Option "h" ["help"] (NoArg Help) "show command-line usage"
|
||||
help_postscript = [
|
||||
-- "DATES can be Y/M/D or smart dates like \"last month\"."
|
||||
-- ,"PATTERNS are regular"
|
||||
-- ,"expressions which filter by account name. Prefix a pattern with desc: to"
|
||||
-- ,"filter by transaction description instead, prefix with not: to negate it."
|
||||
-- ,"When using both, not: comes last."
|
||||
]
|
||||
|
||||
-- | An option value from a command-line flag.
|
||||
data Opt =
|
||||
File {value::String}
|
||||
| NoNewAccts
|
||||
| Begin {value::String}
|
||||
| End {value::String}
|
||||
| Period {value::String}
|
||||
| Cleared
|
||||
| UnCleared
|
||||
| CostBasis
|
||||
| Alias {value::String}
|
||||
| Depth {value::String}
|
||||
| Display {value::String}
|
||||
| Effective
|
||||
| Empty
|
||||
| NoElide
|
||||
| Real
|
||||
| Flat
|
||||
| Drop {value::String}
|
||||
| NoTotal
|
||||
| DailyOpt
|
||||
| WeeklyOpt
|
||||
| MonthlyOpt
|
||||
| QuarterlyOpt
|
||||
| YearlyOpt
|
||||
| RulesFile {value::String}
|
||||
| ReportFormat {value::String}
|
||||
| Help
|
||||
| Verbose
|
||||
| Version
|
||||
| BinaryFilename
|
||||
| Debug
|
||||
-- XXX add-on options, must be defined here for now
|
||||
-- vty
|
||||
| DebugVty
|
||||
-- web
|
||||
| BaseUrl {value::String}
|
||||
| Port {value::String}
|
||||
-- chart
|
||||
| ChartOutput {value::String}
|
||||
| ChartItems {value::String}
|
||||
| ChartSize {value::String}
|
||||
deriving (Show,Eq)
|
||||
generalflagstitle = "\nGeneral flags"
|
||||
generalflags1 = fileflags ++ reportflags ++ helpflags
|
||||
generalflags2 = fileflags ++ helpflags
|
||||
generalflags3 = helpflags
|
||||
|
||||
-- these make me nervous
|
||||
optsWithConstructor f opts = concatMap get opts
|
||||
where get o = [o | f v == o] where v = value o
|
||||
fileflags = [
|
||||
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"
|
||||
,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "display ACCT's name as ALIAS in reports"
|
||||
]
|
||||
|
||||
optsWithConstructors fs opts = concatMap get opts
|
||||
where get o = [o | any (== o) fs]
|
||||
reportflags = [
|
||||
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date"
|
||||
,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date"
|
||||
,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXPR" "report on transactions during the specified period and/or with the specified reporting interval"
|
||||
,flagNone ["daily","D"] (\opts -> setboolopt "daily" opts) "report by day"
|
||||
,flagNone ["weekly","W"] (\opts -> setboolopt "weekly" opts) "report by week"
|
||||
,flagNone ["monthly","M"] (\opts -> setboolopt "monthly" opts) "report by month"
|
||||
,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "report by quarter"
|
||||
,flagNone ["yearly","Y"] (\opts -> setboolopt "yearly" opts) "report by year"
|
||||
,flagNone ["cleared","C"] (\opts -> setboolopt "cleared" opts) "report only on cleared transactions"
|
||||
,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "report only on uncleared transactions"
|
||||
,flagNone ["cost","B"] (\opts -> setboolopt "cost" opts) "report cost of commodities"
|
||||
,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/transactions deeper than this"
|
||||
,flagReq ["display","d"] (\s opts -> Right $ setopt "display" s opts) "DISPLAYEXPR" "show only transactions matching the expr, which is 'dOP[DATE]' where OP is <, <=, =, >=, >"
|
||||
,flagNone ["effective"] (\opts -> setboolopt "effective" opts) "use transactions' effective dates, if any"
|
||||
,flagNone ["empty","E"] (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally elided"
|
||||
,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
|
||||
]
|
||||
|
||||
optValuesForConstructor f opts = concatMap get opts
|
||||
where get o = [v | f v == o] where v = value o
|
||||
helpflags = [
|
||||
flagHelpSimple (setboolopt "help")
|
||||
,flagNone ["debug"] (setboolopt "debug") "Show extra debug output"
|
||||
,flagVersion (setboolopt "version")
|
||||
]
|
||||
|
||||
optValuesForConstructors fs opts = concatMap get opts
|
||||
where get o = [v | any (\f -> f v == o) fs] where v = value o
|
||||
mainargsflag = flagArg f ""
|
||||
where f s opts = let as = words' s
|
||||
cmd = headDef "" as
|
||||
args = drop (length cmd + 1) s
|
||||
in Right $ setopt "command" cmd $ setopt "args" args opts
|
||||
|
||||
-- | Parse the command-line arguments into options and arguments using the
|
||||
-- specified option descriptors. Any smart dates in the options are
|
||||
-- converted to explicit YYYY/MM/DD format based on the current time. If
|
||||
-- parsing fails, raise an error, displaying the problem along with the
|
||||
-- provided usage string.
|
||||
parseArgumentsWith :: [OptDescr Opt] -> IO ([Opt], [String])
|
||||
parseArgumentsWith options = do
|
||||
rawargs <- map fromPlatformString `fmap` getArgs
|
||||
parseArgumentsWith' options rawargs
|
||||
commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]"
|
||||
|
||||
parseArgumentsWith' options rawargs = do
|
||||
let (opts,args,errs) = getOpt Permute options rawargs
|
||||
opts' <- fixOptDates opts
|
||||
let opts'' = if Debug `elem` opts' then Verbose:opts' else opts'
|
||||
if null errs
|
||||
then return (opts'',args)
|
||||
else argsError (concat errs) >> return ([],[])
|
||||
commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]}
|
||||
|
||||
argsError :: String -> IO ()
|
||||
argsError = ioError . userError' . (++ " Run with --help to see usage.")
|
||||
addmode = (commandmode ["add"]) {
|
||||
modeHelp = "prompt for new transactions and append them to the journal"
|
||||
,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = [
|
||||
flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"
|
||||
]
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags2)]
|
||||
}
|
||||
}
|
||||
|
||||
-- | Convert any fuzzy dates within these option values to explicit ones,
|
||||
-- based on today's date.
|
||||
fixOptDates :: [Opt] -> IO [Opt]
|
||||
fixOptDates opts = do
|
||||
convertmode = (commandmode ["convert"]) {
|
||||
modeValue = [("command","convert")]
|
||||
,modeHelp = "show the specified CSV file as hledger journal entries"
|
||||
,modeArgs = Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "CSVFILE"
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = [
|
||||
flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "FILE" "rules file to use (default: CSVFILE.rules)"
|
||||
]
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags3)]
|
||||
}
|
||||
}
|
||||
|
||||
testmode = (commandmode ["test"]) {
|
||||
modeHelp = "run self-tests, or just the ones matching REGEXPS"
|
||||
,modeArgs = Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]"
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags3)]
|
||||
}
|
||||
}
|
||||
|
||||
accountsmode = (commandmode ["accounts","balance"]) {
|
||||
modeHelp = "(or balance) show matched accounts and their balances"
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = [
|
||||
flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
|
||||
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
|
||||
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
|
||||
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
|
||||
,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
|
||||
]
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
}
|
||||
|
||||
entriesmode = (commandmode ["entries","print"]) {
|
||||
modeHelp = "(or print) show matched journal entries"
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
}
|
||||
|
||||
postingsmode = (commandmode ["postings","register"]) {
|
||||
modeHelp = "(or register) show matched postings and running total"
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
}
|
||||
|
||||
transactionsmode = (commandmode ["transactions"]) {
|
||||
modeHelp = "show matched transactions and balance in some account(s)"
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
}
|
||||
|
||||
activitymode = (commandmode ["activity","histogram"]) {
|
||||
modeHelp = "show a barchart of transactions per interval"
|
||||
,modeHelpSuffix = ["The default interval is daily."]
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
}
|
||||
|
||||
statsmode = (commandmode ["stats"]) {
|
||||
modeHelp = "show quick statistics for a journal (or part of it)"
|
||||
,modeArgs = Just commandargsflag
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags1)]
|
||||
}
|
||||
}
|
||||
|
||||
binaryfilenamemode = (commandmode ["binaryfilename"]) {
|
||||
modeHelp = "show the download filename for this hledger build, and exit"
|
||||
,modeArgs = Nothing
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
,groupHidden = []
|
||||
,groupNamed = [(generalflagstitle, generalflags3)]
|
||||
}
|
||||
}
|
||||
|
||||
-- 2. ADT holding options used in this package and above, parsed from RawOpts.
|
||||
-- This represents the command-line options that were provided, with all
|
||||
-- parsing completed, but before adding defaults or derived values (XXX add)
|
||||
|
||||
-- cli options, used in hledger and above
|
||||
data CliOpts = CliOpts {
|
||||
rawopts_ :: RawOpts
|
||||
,command_ :: String
|
||||
,file_ :: Maybe FilePath
|
||||
,alias_ :: [String]
|
||||
,debug_ :: Bool
|
||||
,no_new_accounts_ :: Bool -- add
|
||||
,rules_file_ :: Maybe FilePath -- convert
|
||||
,reportopts_ :: ReportOpts
|
||||
} deriving (Show)
|
||||
|
||||
defcliopts = CliOpts
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
|
||||
instance Default CliOpts where def = defcliopts
|
||||
|
||||
-- | Parse raw option string values to the desired final data types.
|
||||
-- Any relative smart dates will be converted to fixed dates based on
|
||||
-- today's date. Parsing failures will raise an error.
|
||||
toCliOpts :: RawOpts -> IO CliOpts
|
||||
toCliOpts rawopts = do
|
||||
d <- getCurrentDay
|
||||
return $ map (fixopt d) opts
|
||||
where
|
||||
fixopt d (Begin s) = Begin $ fixSmartDateStr d s
|
||||
fixopt d (End s) = End $ fixSmartDateStr d s
|
||||
fixopt d (Display s) = -- hacky
|
||||
Display $ regexReplaceBy "\\[.+?\\]" fixbracketeddatestr s
|
||||
where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
||||
fixopt _ o = o
|
||||
return defcliopts {
|
||||
rawopts_ = rawopts
|
||||
,command_ = stringopt "command" rawopts
|
||||
,file_ = maybestringopt "file" rawopts
|
||||
,alias_ = listofstringopt "alias" rawopts
|
||||
,debug_ = boolopt "debug" rawopts
|
||||
,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
|
||||
,rules_file_ = maybestringopt "rules-file" rawopts -- convert
|
||||
,reportopts_ = defreportopts {
|
||||
begin_ = maybesmartdateopt d "begin" rawopts
|
||||
,end_ = maybesmartdateopt d "end" rawopts
|
||||
,period_ = maybeperiodopt d rawopts
|
||||
,cleared_ = boolopt "cleared" rawopts
|
||||
,uncleared_ = boolopt "uncleared" rawopts
|
||||
,cost_ = boolopt "cost" rawopts
|
||||
,depth_ = maybeintopt "depth" rawopts
|
||||
,display_ = maybedisplayopt d rawopts
|
||||
,effective_ = boolopt "effective" rawopts
|
||||
,empty_ = boolopt "empty" rawopts
|
||||
,no_elide_ = boolopt "no-elide" rawopts
|
||||
,real_ = boolopt "real" rawopts
|
||||
,flat_ = boolopt "flat" rawopts -- balance
|
||||
,drop_ = intopt "drop" rawopts -- balance
|
||||
,no_total_ = boolopt "no-total" rawopts -- balance
|
||||
,daily_ = boolopt "daily" rawopts
|
||||
,weekly_ = boolopt "weekly" rawopts
|
||||
,monthly_ = boolopt "monthly" rawopts
|
||||
,quarterly_ = boolopt "quarterly" rawopts
|
||||
,yearly_ = boolopt "yearly" rawopts
|
||||
,format_ = maybestringopt "format" rawopts
|
||||
,patterns_ = words'' prefixes $ singleQuoteIfNeeded $ stringopt "args" rawopts
|
||||
}
|
||||
}
|
||||
|
||||
-- | Figure out the overall date span we should report on, based on any
|
||||
-- begin/end/period options provided. If there is a period option, the
|
||||
-- others are ignored.
|
||||
dateSpanFromOpts :: Day -> [Opt] -> DateSpan
|
||||
dateSpanFromOpts refdate opts
|
||||
| not (null popts) = case parsePeriodExpr refdate $ last popts of
|
||||
Right (_, s) -> s
|
||||
Left e -> parseerror e
|
||||
| otherwise = DateSpan lastb laste
|
||||
-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457
|
||||
-- just handles commonest cases
|
||||
moveFlagsAfterCommand ("-f":f:cmd:rest) = cmd:"-f":f:rest
|
||||
moveFlagsAfterCommand (first:cmd:rest) | "-f" `isPrefixOf` first = cmd:first:rest
|
||||
moveFlagsAfterCommand as = as
|
||||
|
||||
-- | Convert possibly encoded option values to regular unicode strings.
|
||||
decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val))
|
||||
|
||||
-- | Get all command-line options, failing on any parse errors.
|
||||
getHledgerOpts :: IO CliOpts
|
||||
-- getHledgerOpts = processArgs mainmode >>= return . decodeRawOpts >>= toOpts >>= checkOpts
|
||||
getHledgerOpts = do
|
||||
args <- getArgs
|
||||
toCliOpts (decodeRawOpts $ processValue mainmode $ moveFlagsAfterCommand args) >>= checkCliOpts
|
||||
|
||||
-- utils
|
||||
|
||||
optserror = error' . (++ " (run with --help for usage)")
|
||||
|
||||
setopt name val = (++ [(name,singleQuoteIfNeeded val)])
|
||||
|
||||
setboolopt name = (++ [(name,"")])
|
||||
|
||||
in_ :: String -> RawOpts -> Bool
|
||||
in_ name = isJust . lookup name
|
||||
|
||||
boolopt = in_
|
||||
|
||||
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
|
||||
|
||||
stringopt name = fromMaybe "" . maybestringopt name
|
||||
|
||||
listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name]
|
||||
|
||||
maybeintopt :: String -> RawOpts -> Maybe Int
|
||||
maybeintopt name rawopts =
|
||||
let ms = maybestringopt name rawopts in
|
||||
case ms of Nothing -> Nothing
|
||||
Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s
|
||||
|
||||
intopt name = fromMaybe 0 . maybeintopt name
|
||||
|
||||
maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day
|
||||
maybesmartdateopt d name rawopts =
|
||||
case maybestringopt name rawopts of
|
||||
Nothing -> Nothing
|
||||
Just s -> either
|
||||
(\e -> optserror $ "could not parse "++name++" date: "++show e)
|
||||
Just
|
||||
$ fixSmartDateStrEither' d s
|
||||
|
||||
maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExpr
|
||||
maybedisplayopt d rawopts =
|
||||
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
|
||||
where
|
||||
popts = optValuesForConstructor Period opts
|
||||
bopts = optValuesForConstructor Begin opts
|
||||
eopts = optValuesForConstructor End opts
|
||||
lastb = listtomaybeday bopts
|
||||
laste = listtomaybeday eopts
|
||||
listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs
|
||||
where parse = parsedate . fixSmartDateStr refdate
|
||||
fixbracketeddatestr "" = ""
|
||||
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
||||
|
||||
-- | Figure out the reporting interval, if any, specified by the options.
|
||||
-- If there is a period option, the others are ignored.
|
||||
intervalFromOpts :: [Opt] -> Interval
|
||||
intervalFromOpts opts =
|
||||
case (periodopts, intervalopts) of
|
||||
((p:_), _) -> case parsePeriodExpr (parsedate "0001/01/01") p of
|
||||
Right (i, _) -> i
|
||||
Left e -> parseerror e
|
||||
(_, (DailyOpt:_)) -> Days 1
|
||||
(_, (WeeklyOpt:_)) -> Weeks 1
|
||||
(_, (MonthlyOpt:_)) -> Months 1
|
||||
(_, (QuarterlyOpt:_)) -> Quarters 1
|
||||
(_, (YearlyOpt:_)) -> Years 1
|
||||
(_, _) -> NoInterval
|
||||
where
|
||||
periodopts = reverse $ optValuesForConstructor Period opts
|
||||
intervalopts = reverse $ filter (`elem` [DailyOpt,WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
|
||||
maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)
|
||||
maybeperiodopt d rawopts =
|
||||
case maybestringopt "period" rawopts of
|
||||
Nothing -> Nothing
|
||||
Just s -> either
|
||||
(\e -> optserror $ "could not parse period option: "++show e)
|
||||
Just
|
||||
$ parsePeriodExpr d s
|
||||
|
||||
rulesFileFromOpts :: [Opt] -> Maybe FilePath
|
||||
rulesFileFromOpts opts = listtomaybe $ optValuesForConstructor RulesFile opts
|
||||
where
|
||||
listtomaybe [] = Nothing
|
||||
listtomaybe vs = Just $ head vs
|
||||
-- | Do final validation of processed opts, raising an error if there is trouble.
|
||||
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
|
||||
checkCliOpts opts@CliOpts{reportopts_=ropts} = do
|
||||
case formatFromOpts ropts of
|
||||
Left err -> optserror $ "could not parse format option: "++err
|
||||
Right _ -> return ()
|
||||
return opts
|
||||
|
||||
-- | Default balance format string: "%20(total) %2(depth_spacer)%-(account)"
|
||||
-- | Parse any format option provided, possibly raising an error, or get
|
||||
-- the default value.
|
||||
formatFromOpts :: ReportOpts -> Either String [FormatString]
|
||||
formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_
|
||||
|
||||
-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"
|
||||
defaultBalanceFormatString :: [FormatString]
|
||||
defaultBalanceFormatString = [
|
||||
FormatField False (Just 20) Nothing Total
|
||||
@ -237,81 +404,14 @@ defaultBalanceFormatString = [
|
||||
, FormatField True Nothing Nothing Format.Account
|
||||
]
|
||||
|
||||
-- | Parses the --format string to either an error message or a format string.
|
||||
parseFormatFromOpts :: [Opt] -> Either String [FormatString]
|
||||
parseFormatFromOpts opts = listtomaybe $ optValuesForConstructor ReportFormat opts
|
||||
where
|
||||
listtomaybe :: [String] -> Either String [FormatString]
|
||||
listtomaybe [] = Right defaultBalanceFormatString
|
||||
listtomaybe vs = parseFormatString $ head vs
|
||||
|
||||
-- | Returns the format string. If the string can't be parsed it fails with error'.
|
||||
formatFromOpts :: [Opt] -> [FormatString]
|
||||
formatFromOpts opts = case parseFormatFromOpts opts of
|
||||
Left err -> error' err
|
||||
Right format -> format
|
||||
|
||||
-- | Get the value of the (last) depth option, if any.
|
||||
depthFromOpts :: [Opt] -> Maybe Int
|
||||
depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
|
||||
where
|
||||
listtomaybeint [] = Nothing
|
||||
listtomaybeint vs = Just $ read $ last vs
|
||||
|
||||
-- | Get the value of the (last) drop option, if any, otherwise 0.
|
||||
dropFromOpts :: [Opt] -> Int
|
||||
dropFromOpts opts = fromMaybe 0 $ listtomaybeint $ optValuesForConstructor Drop opts
|
||||
where
|
||||
listtomaybeint [] = Nothing
|
||||
listtomaybeint vs = Just $ read $ last vs
|
||||
|
||||
-- | Get the value of the (last) display option, if any.
|
||||
displayExprFromOpts :: [Opt] -> Maybe String
|
||||
displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
|
||||
where
|
||||
listtomaybe [] = Nothing
|
||||
listtomaybe vs = Just $ last vs
|
||||
|
||||
-- | Get the value of the (last) baseurl option, if any.
|
||||
baseUrlFromOpts :: [Opt] -> Maybe String
|
||||
baseUrlFromOpts opts = listtomaybe $ optValuesForConstructor BaseUrl opts
|
||||
where
|
||||
listtomaybe [] = Nothing
|
||||
listtomaybe vs = Just $ last vs
|
||||
|
||||
-- | Get the value of the (last) port option, if any.
|
||||
portFromOpts :: [Opt] -> Maybe Int
|
||||
portFromOpts opts = listtomaybeint $ optValuesForConstructor Port opts
|
||||
where
|
||||
listtomaybeint [] = Nothing
|
||||
listtomaybeint vs = Just $ read $ last vs
|
||||
|
||||
|
||||
-- | Get a maybe boolean representing the last cleared/uncleared option if any.
|
||||
clearedValueFromOpts opts | null os = Nothing
|
||||
| last os == Cleared = Just True
|
||||
| otherwise = Just False
|
||||
where os = optsWithConstructors [Cleared,UnCleared] opts
|
||||
|
||||
-- | Detect which date we will report on, based on --effective.
|
||||
whichDateFromOpts :: [Opt] -> WhichDate
|
||||
whichDateFromOpts opts = if Effective `elem` opts then EffectiveDate else ActualDate
|
||||
|
||||
-- | Were we invoked as \"hours\" ?
|
||||
usingTimeProgramName :: IO Bool
|
||||
usingTimeProgramName = do
|
||||
progname <- getProgName
|
||||
return $ map toLower progname == progname_cli_time
|
||||
|
||||
-- | Get the journal file path from options, an environment variable, or a default
|
||||
journalFilePathFromOpts :: [Opt] -> IO String
|
||||
journalFilePathFromOpts :: CliOpts -> IO String
|
||||
journalFilePathFromOpts opts = do
|
||||
istimequery <- usingTimeProgramName
|
||||
f <- if istimequery then myTimelogPath else myJournalPath
|
||||
return $ last $ f : optValuesForConstructor File opts
|
||||
f <- myJournalPath
|
||||
return $ fromMaybe f $ file_ opts
|
||||
|
||||
aliasesFromOpts :: [Opt] -> [(AccountName,AccountName)]
|
||||
aliasesFromOpts opts = map parseAlias $ optValuesForConstructor Alias opts
|
||||
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
|
||||
aliasesFromOpts = map parseAlias . alias_
|
||||
where
|
||||
-- similar to ledgerAlias
|
||||
parseAlias :: String -> (AccountName,AccountName)
|
||||
@ -322,57 +422,11 @@ aliasesFromOpts opts = map parseAlias $ optValuesForConstructor Alias opts
|
||||
alias' = case alias of ('=':rest) -> rest
|
||||
_ -> orig
|
||||
|
||||
-- | Gather filter pattern arguments into a list of account patterns and a
|
||||
-- list of description patterns. We interpret pattern arguments as
|
||||
-- follows: those prefixed with "desc:" are description patterns, all
|
||||
-- others are account patterns; also patterns prefixed with "not:" are
|
||||
-- negated. not: should come after desc: if both are used.
|
||||
parsePatternArgs :: [String] -> ([String],[String])
|
||||
parsePatternArgs args = (as, ds')
|
||||
where
|
||||
descprefix = "desc:"
|
||||
(ds, as) = partition (descprefix `isPrefixOf`) args
|
||||
ds' = map (drop (length descprefix)) ds
|
||||
printModeHelpAndExit mode = putStrLn progversion >> putStr help >> exitSuccess
|
||||
where help = showText defaultWrap $ helpText HelpFormatDefault mode
|
||||
|
||||
-- | Convert application options to the library's generic filter specification.
|
||||
optsToFilterSpec :: [Opt] -> [String] -> Day -> FilterSpec
|
||||
optsToFilterSpec opts args d = FilterSpec {
|
||||
datespan=dateSpanFromOpts d opts
|
||||
,cleared=clearedValueFromOpts opts
|
||||
,real=Real `elem` opts
|
||||
,empty=Empty `elem` opts
|
||||
,acctpats=apats
|
||||
,descpats=dpats
|
||||
,depth = depthFromOpts opts
|
||||
}
|
||||
where (apats,dpats) = parsePatternArgs args
|
||||
|
||||
-- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts
|
||||
-- where
|
||||
-- listtomaybe [] = Nothing
|
||||
-- listtomaybe vs = Just $ last vs
|
||||
printVersionAndExit = putStrLn progversion >> exitSuccess
|
||||
|
||||
tests_Hledger_Cli_Options = TestList
|
||||
[
|
||||
"dateSpanFromOpts" ~: do
|
||||
let todaysdate = parsedate "2008/11/26"
|
||||
let gives = is . show . dateSpanFromOpts todaysdate
|
||||
[] `gives` "DateSpan Nothing Nothing"
|
||||
[Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||
[Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||
[Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||
|
||||
,"intervalFromOpts" ~: do
|
||||
let gives = is . intervalFromOpts
|
||||
[] `gives` NoInterval
|
||||
[DailyOpt] `gives` Days 1
|
||||
[WeeklyOpt] `gives` Weeks 1
|
||||
[MonthlyOpt] `gives` Months 1
|
||||
[QuarterlyOpt] `gives` Quarters 1
|
||||
[YearlyOpt] `gives` Years 1
|
||||
[Period "weekly"] `gives` Weeks 1
|
||||
[Period "monthly"] `gives` Months 1
|
||||
[Period "quarterly"] `gives` Quarters 1
|
||||
[WeeklyOpt, Period "yearly"] `gives` Years 1
|
||||
|
||||
]
|
||||
|
||||
@ -18,15 +18,14 @@ import Hledger.Cli.Options
|
||||
import Hledger.Cli.Reports
|
||||
|
||||
-- | Print journal transactions in standard format.
|
||||
print' :: [Opt] -> [String] -> Journal -> IO ()
|
||||
print' opts args j = do
|
||||
print' :: CliOpts -> Journal -> IO ()
|
||||
print' CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
putStr $ showTransactions opts (optsToFilterSpec opts args d) j
|
||||
putStr $ showTransactions ropts (optsToFilterSpec ropts d) j
|
||||
|
||||
showTransactions :: [Opt] -> FilterSpec -> Journal -> String
|
||||
showTransactions :: ReportOpts -> FilterSpec -> Journal -> String
|
||||
showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j
|
||||
|
||||
entriesReportAsText :: [Opt] -> FilterSpec -> EntriesReport -> String
|
||||
entriesReportAsText opts _ items = concatMap (showTransactionForPrint effective) items
|
||||
where effective = Effective `elem` opts
|
||||
entriesReportAsText :: ReportOpts -> FilterSpec -> EntriesReport -> String
|
||||
entriesReportAsText opts _ items = concatMap (showTransactionForPrint (effective_ opts)) items
|
||||
|
||||
|
||||
@ -25,13 +25,13 @@ import Hledger.Cli.Reports
|
||||
|
||||
|
||||
-- | Print a (posting) register report.
|
||||
register :: [Opt] -> [String] -> Journal -> IO ()
|
||||
register opts args j = do
|
||||
register :: CliOpts -> Journal -> IO ()
|
||||
register CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
putStr $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts args d) j
|
||||
putStr $ postingsReportAsText ropts $ postingsReport ropts (optsToFilterSpec ropts d) j
|
||||
|
||||
-- | Render a register report as plain text suitable for console output.
|
||||
postingsReportAsText :: [Opt] -> PostingsReport -> String
|
||||
postingsReportAsText :: ReportOpts -> PostingsReport -> String
|
||||
postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd
|
||||
|
||||
-- | Render one register report line item as plain text. Eg:
|
||||
@ -41,7 +41,7 @@ postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd
|
||||
-- ^ displayed for first postings^
|
||||
-- only, otherwise blank
|
||||
-- @
|
||||
postingsReportItemAsText :: [Opt] -> PostingsReportItem -> String
|
||||
postingsReportItemAsText :: ReportOpts -> PostingsReportItem -> String
|
||||
postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal]
|
||||
where
|
||||
datedesc = case dd of Nothing -> replicate datedescwidth ' '
|
||||
@ -57,7 +57,7 @@ postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba
|
||||
bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
|
||||
|
||||
-- XXX
|
||||
showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText [] $ mkpostingsReportItem showtxninfo p b
|
||||
showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b
|
||||
|
||||
tests_Hledger_Cli_Register :: Test
|
||||
tests_Hledger_Cli_Register = TestList
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-|
|
||||
|
||||
Generate several common kinds of report from a journal, as \"*Report\" -
|
||||
@ -9,6 +10,17 @@ on the command-line options, should move to hledger-lib later.
|
||||
-}
|
||||
|
||||
module Hledger.Cli.Reports (
|
||||
ReportOpts(..),
|
||||
DisplayExpr,
|
||||
FormatStr,
|
||||
defreportopts,
|
||||
dateSpanFromOpts,
|
||||
intervalFromOpts,
|
||||
clearedValueFromOpts,
|
||||
whichDateFromOpts,
|
||||
journalSelectingDateFromOpts,
|
||||
journalSelectingAmountFromOpts,
|
||||
optsToFilterSpec,
|
||||
-- * Entries report
|
||||
EntriesReport,
|
||||
EntriesReportItem,
|
||||
@ -42,14 +54,138 @@ import Data.Ord
|
||||
import Data.Time.Calendar
|
||||
import Data.Tree
|
||||
import Safe (headMay, lastMay)
|
||||
import System.Console.CmdArgs -- for defaults support
|
||||
import Test.HUnit
|
||||
import Text.ParserCombinators.Parsec
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
import Hledger.Cli.Options
|
||||
import Hledger.Cli.Utils
|
||||
-- import Hledger.Cli.Utils
|
||||
|
||||
-- report options, used in hledger-lib and above
|
||||
data ReportOpts = ReportOpts {
|
||||
begin_ :: Maybe Day
|
||||
,end_ :: Maybe Day
|
||||
,period_ :: Maybe (Interval,DateSpan)
|
||||
,cleared_ :: Bool
|
||||
,uncleared_ :: Bool
|
||||
,cost_ :: Bool
|
||||
,depth_ :: Maybe Int
|
||||
,display_ :: Maybe DisplayExpr
|
||||
,effective_ :: Bool
|
||||
,empty_ :: Bool
|
||||
,no_elide_ :: Bool
|
||||
,real_ :: Bool
|
||||
,flat_ :: Bool -- balance
|
||||
,drop_ :: Int -- balance
|
||||
,no_total_ :: Bool -- balance
|
||||
,daily_ :: Bool
|
||||
,weekly_ :: Bool
|
||||
,monthly_ :: Bool
|
||||
,quarterly_ :: Bool
|
||||
,yearly_ :: Bool
|
||||
,format_ :: Maybe FormatStr
|
||||
,patterns_ :: [String]
|
||||
} deriving (Show)
|
||||
|
||||
type DisplayExpr = String
|
||||
type FormatStr = String
|
||||
|
||||
defreportopts = ReportOpts
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
|
||||
instance Default ReportOpts where def = defreportopts
|
||||
|
||||
-- | Figure out the date span we should report on, based on any
|
||||
-- begin/end/period options provided. A period option will cause begin and
|
||||
-- end options to be ignored.
|
||||
dateSpanFromOpts :: Day -> ReportOpts -> DateSpan
|
||||
dateSpanFromOpts _ ReportOpts{..} =
|
||||
case period_ of Just (_,span) -> span
|
||||
Nothing -> DateSpan begin_ end_
|
||||
|
||||
-- | Figure out the reporting interval, if any, specified by the options.
|
||||
-- --period overrides --daily overrides --weekly overrides --monthly etc.
|
||||
intervalFromOpts :: ReportOpts -> Interval
|
||||
intervalFromOpts ReportOpts{..} =
|
||||
case period_ of
|
||||
Just (interval,_) -> interval
|
||||
Nothing -> i
|
||||
where i | daily_ = Days 1
|
||||
| weekly_ = Weeks 1
|
||||
| monthly_ = Months 1
|
||||
| quarterly_ = Quarters 1
|
||||
| yearly_ = Years 1
|
||||
| otherwise = NoInterval
|
||||
|
||||
-- | Get a maybe boolean representing the last cleared/uncleared option if any.
|
||||
clearedValueFromOpts :: ReportOpts -> Maybe Bool
|
||||
clearedValueFromOpts ReportOpts{..} | cleared_ = Just True
|
||||
| uncleared_ = Just False
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Detect which date we will report on, based on --effective.
|
||||
whichDateFromOpts :: ReportOpts -> WhichDate
|
||||
whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate
|
||||
|
||||
-- | Convert this journal's transactions' primary date to either the
|
||||
-- actual or effective date, as per options.
|
||||
journalSelectingDateFromOpts :: ReportOpts -> Journal -> Journal
|
||||
journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts)
|
||||
|
||||
-- | Convert this journal's postings' amounts to the cost basis amounts if
|
||||
-- specified by options.
|
||||
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
|
||||
journalSelectingAmountFromOpts opts
|
||||
| cost_ opts = journalConvertAmountsToCost
|
||||
| otherwise = id
|
||||
|
||||
-- | Convert application options to the library's generic filter specification.
|
||||
optsToFilterSpec :: ReportOpts -> Day -> FilterSpec
|
||||
optsToFilterSpec opts@ReportOpts{..} d = FilterSpec {
|
||||
datespan=dateSpanFromOpts d opts
|
||||
,cleared= clearedValueFromOpts opts
|
||||
,real=real_
|
||||
,empty=empty_
|
||||
,acctpats=apats
|
||||
,descpats=dpats
|
||||
,depth = depth_
|
||||
}
|
||||
where (apats,dpats) = parsePatternArgs patterns_
|
||||
|
||||
-- | Gather filter pattern arguments into a list of account patterns and a
|
||||
-- list of description patterns. We interpret pattern arguments as
|
||||
-- follows: those prefixed with "desc:" are description patterns, all
|
||||
-- others are account patterns; also patterns prefixed with "not:" are
|
||||
-- negated. not: should come after desc: if both are used.
|
||||
parsePatternArgs :: [String] -> ([String],[String])
|
||||
parsePatternArgs args = (as, ds')
|
||||
where
|
||||
descprefix = "desc:"
|
||||
(ds, as) = partition (descprefix `isPrefixOf`) args
|
||||
ds' = map (drop (length descprefix)) ds
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
@ -60,7 +196,7 @@ type EntriesReport = [EntriesReportItem]
|
||||
type EntriesReportItem = Transaction
|
||||
|
||||
-- | Select transactions for an entries report.
|
||||
entriesReport :: [Opt] -> FilterSpec -> Journal -> EntriesReport
|
||||
entriesReport :: ReportOpts -> FilterSpec -> Journal -> EntriesReport
|
||||
entriesReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j'
|
||||
where
|
||||
j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
||||
@ -79,12 +215,12 @@ type PostingsReportItem = (Maybe (Day, String) -- transaction date and descripti
|
||||
|
||||
-- | Select postings from the journal and add running balance and other
|
||||
-- information to make a postings report. Used by eg hledger's register command.
|
||||
postingsReport :: [Opt] -> FilterSpec -> Journal -> PostingsReport
|
||||
postingsReport :: ReportOpts -> FilterSpec -> Journal -> PostingsReport
|
||||
postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting startbal (+))
|
||||
where
|
||||
ps | interval == NoInterval = displayableps
|
||||
| otherwise = summarisePostingsByInterval interval depth empty filterspan displayableps
|
||||
(precedingps, displayableps, _) = postingsMatchingDisplayExpr (displayExprFromOpts opts)
|
||||
(precedingps, displayableps, _) = postingsMatchingDisplayExpr (display_ opts)
|
||||
$ depthClipPostings depth
|
||||
$ journalPostings
|
||||
$ filterJournalPostings fspec{depth=Nothing}
|
||||
@ -93,7 +229,7 @@ postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting st
|
||||
j
|
||||
startbal = sumPostings precedingps
|
||||
filterspan = datespan fspec
|
||||
(interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
|
||||
(interval, depth, empty) = (intervalFromOpts opts, depth_ opts, empty_ opts)
|
||||
|
||||
totallabel = "Total"
|
||||
balancelabel = "Balance"
|
||||
@ -238,7 +374,7 @@ triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
|
||||
-- "postingsReport" except it uses matchers and transaction-based report
|
||||
-- items and the items are most recent first. Used by eg hledger-web's
|
||||
-- journal view.
|
||||
journalTransactionsReport :: [Opt] -> Journal -> Matcher -> TransactionsReport
|
||||
journalTransactionsReport :: ReportOpts -> Journal -> Matcher -> TransactionsReport
|
||||
journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
|
||||
where
|
||||
ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
|
||||
@ -261,16 +397,16 @@ journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
|
||||
-- Currently, reporting intervals are not supported, and report items are
|
||||
-- most recent first. Used by eg hledger-web's account register view.
|
||||
--
|
||||
accountTransactionsReport :: [Opt] -> Journal -> Matcher -> Matcher -> TransactionsReport
|
||||
accountTransactionsReport :: ReportOpts -> Journal -> Matcher -> Matcher -> TransactionsReport
|
||||
accountTransactionsReport opts j m thisacctmatcher = (label, items)
|
||||
where
|
||||
-- transactions affecting this account, in date order
|
||||
ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns j
|
||||
-- starting balance: if we are filtering by a start date and nothing else,
|
||||
-- the sum of postings to this account before that date; otherwise zero.
|
||||
(startbal,label) | matcherIsNull m = (nullmixedamt, balancelabel)
|
||||
| matcherIsStartDateOnly effective m = (sumPostings priorps, balancelabel)
|
||||
| otherwise = (nullmixedamt, totallabel)
|
||||
(startbal,label) | matcherIsNull m = (nullmixedamt, balancelabel)
|
||||
| matcherIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
|
||||
| otherwise = (nullmixedamt, totallabel)
|
||||
where
|
||||
priorps = -- ltrace "priorps" $
|
||||
filter (matchesPosting
|
||||
@ -278,8 +414,7 @@ accountTransactionsReport opts j m thisacctmatcher = (label, items)
|
||||
MatchAnd [thisacctmatcher, tostartdatematcher]))
|
||||
$ transactionsPostings ts
|
||||
tostartdatematcher = MatchDate True (DateSpan Nothing startdate)
|
||||
startdate = matcherStartDate effective m
|
||||
effective = Effective `elem` opts
|
||||
startdate = matcherStartDate (effective_ opts) m
|
||||
items = reverse $ accountTransactionsReportItems m (Just thisacctmatcher) startbal negate ts
|
||||
|
||||
-- | Generate transactions report items from a list of transactions,
|
||||
@ -344,25 +479,25 @@ type AccountsReportItem = (AccountName -- full account name
|
||||
-- | Select accounts, and get their balances at the end of the selected
|
||||
-- period, and misc. display information, for an accounts report. Used by
|
||||
-- eg hledger's balance command.
|
||||
accountsReport :: [Opt] -> FilterSpec -> Journal -> AccountsReport
|
||||
accountsReport :: ReportOpts -> FilterSpec -> Journal -> AccountsReport
|
||||
accountsReport opts filterspec j = accountsReport' opts j (journalToLedger filterspec)
|
||||
|
||||
-- | Select accounts, and get their balances at the end of the selected
|
||||
-- period, and misc. display information, for an accounts report. Like
|
||||
-- "accountsReport" but uses the new matchers. Used by eg hledger-web's
|
||||
-- accounts sidebar.
|
||||
accountsReport2 :: [Opt] -> Matcher -> Journal -> AccountsReport
|
||||
accountsReport2 :: ReportOpts -> Matcher -> Journal -> AccountsReport
|
||||
accountsReport2 opts matcher j = accountsReport' opts j (journalToLedger2 matcher)
|
||||
|
||||
-- Accounts report helper.
|
||||
accountsReport' :: [Opt] -> Journal -> (Journal -> Ledger) -> AccountsReport
|
||||
accountsReport' :: ReportOpts -> Journal -> (Journal -> Ledger) -> AccountsReport
|
||||
accountsReport' opts j jtol = (items, total)
|
||||
where
|
||||
items = map mkitem interestingaccts
|
||||
interestingaccts | NoElide `elem` opts = acctnames
|
||||
interestingaccts | no_elide_ opts = acctnames
|
||||
| otherwise = filter (isInteresting opts l) acctnames
|
||||
acctnames = sort $ tail $ flatten $ treemap aname accttree
|
||||
accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
|
||||
accttree = ledgerAccountTree (fromMaybe 99999 $ depth_ opts) l
|
||||
total = sum $ map abalance $ ledgerTopAccounts l
|
||||
l = jtol $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
||||
|
||||
@ -370,14 +505,14 @@ accountsReport' opts j jtol = (items, total)
|
||||
mkitem :: AccountName -> AccountsReportItem
|
||||
mkitem a = (a, adisplay, indent, abal)
|
||||
where
|
||||
adisplay | Flat `elem` opts = a
|
||||
adisplay | flat_ opts = a
|
||||
| otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
|
||||
where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
|
||||
indent | Flat `elem` opts = 0
|
||||
indent | flat_ opts = 0
|
||||
| otherwise = length interestingparents
|
||||
interestingparents = filter (`elem` interestingaccts) parents
|
||||
parents = parentAccountNames a
|
||||
abal | Flat `elem` opts = exclusiveBalance acct
|
||||
abal | flat_ opts = exclusiveBalance acct
|
||||
| otherwise = abalance acct
|
||||
where acct = ledgerAccount l a
|
||||
|
||||
@ -386,24 +521,24 @@ exclusiveBalance = sumPostings . apostings
|
||||
|
||||
-- | Is the named account considered interesting for this ledger's accounts report,
|
||||
-- following the eliding style of ledger's balance command ?
|
||||
isInteresting :: [Opt] -> Ledger -> AccountName -> Bool
|
||||
isInteresting opts l a | Flat `elem` opts = isInterestingFlat opts l a
|
||||
isInteresting :: ReportOpts -> Ledger -> AccountName -> Bool
|
||||
isInteresting opts l a | flat_ opts = isInterestingFlat opts l a
|
||||
| otherwise = isInterestingIndented opts l a
|
||||
|
||||
isInterestingFlat :: [Opt] -> Ledger -> AccountName -> Bool
|
||||
isInterestingFlat :: ReportOpts -> Ledger -> AccountName -> Bool
|
||||
isInterestingFlat opts l a = notempty || emptyflag
|
||||
where
|
||||
acct = ledgerAccount l a
|
||||
notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
|
||||
emptyflag = Empty `elem` opts
|
||||
emptyflag = empty_ opts
|
||||
|
||||
isInterestingIndented :: [Opt] -> Ledger -> AccountName -> Bool
|
||||
isInterestingIndented :: ReportOpts -> Ledger -> AccountName -> Bool
|
||||
isInterestingIndented opts l a
|
||||
| numinterestingsubs==1 && not atmaxdepth = notlikesub
|
||||
| otherwise = notzero || emptyflag
|
||||
where
|
||||
atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts
|
||||
emptyflag = Empty `elem` opts
|
||||
atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depth_ opts
|
||||
emptyflag = empty_ opts
|
||||
acct = ledgerAccount l a
|
||||
notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
|
||||
notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
|
||||
|
||||
@ -15,6 +15,7 @@ import Text.Printf
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Hledger.Cli.Options
|
||||
import Hledger.Cli.Reports
|
||||
import Hledger.Data
|
||||
import Prelude hiding (putStr)
|
||||
import Hledger.Utils.UTF8 (putStr)
|
||||
@ -22,19 +23,19 @@ import Hledger.Utils.UTF8 (putStr)
|
||||
|
||||
-- like Register.summarisePostings
|
||||
-- | Print various statistics for the journal.
|
||||
stats :: [Opt] -> [String] -> Journal -> IO ()
|
||||
stats opts args j = do
|
||||
stats :: CliOpts -> Journal -> IO ()
|
||||
stats CliOpts{reportopts_=reportopts_} j = do
|
||||
d <- getCurrentDay
|
||||
let filterspec = optsToFilterSpec opts args d
|
||||
let filterspec = optsToFilterSpec reportopts_ d
|
||||
l = journalToLedger filterspec j
|
||||
reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec)
|
||||
intervalspans = splitSpan (intervalFromOpts opts) reportspan
|
||||
showstats = showLedgerStats opts args l d
|
||||
intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
|
||||
showstats = showLedgerStats l d
|
||||
s = intercalate "\n" $ map showstats intervalspans
|
||||
putStr s
|
||||
|
||||
showLedgerStats :: [Opt] -> [String] -> Ledger -> Day -> DateSpan -> String
|
||||
showLedgerStats _ _ l today span =
|
||||
showLedgerStats :: Ledger -> Day -> DateSpan -> String
|
||||
showLedgerStats l today span =
|
||||
unlines (map (uncurry (printf fmt)) stats)
|
||||
where
|
||||
fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s"
|
||||
|
||||
@ -38,22 +38,22 @@ import Hledger.Utils
|
||||
|
||||
|
||||
-- | Run unit tests and exit with success or failure.
|
||||
runtests :: [Opt] -> [String] -> IO ()
|
||||
runtests opts args = do
|
||||
(hunitcounts,_) <- runtests' opts args
|
||||
runtests :: CliOpts -> IO ()
|
||||
runtests opts = do
|
||||
(hunitcounts,_) <- runtests' opts
|
||||
if errors hunitcounts > 0 || (failures hunitcounts > 0)
|
||||
then exitFailure
|
||||
else exitWith ExitSuccess
|
||||
|
||||
-- | Run unit tests and exit on failure.
|
||||
runTestsOrExit :: [Opt] -> [String] -> IO ()
|
||||
runTestsOrExit opts args = do
|
||||
(hunitcounts,_) <- runtests' opts args
|
||||
runTestsOrExit :: CliOpts -> IO ()
|
||||
runTestsOrExit opts = do
|
||||
(hunitcounts,_) <- runtests' opts
|
||||
when (errors hunitcounts > 0 || (failures hunitcounts > 0)) $ exitFailure
|
||||
|
||||
runtests' :: Num b => t -> [String] -> IO (Counts, b)
|
||||
runtests' _ args = liftM (flip (,) 0) $ runTestTT ts
|
||||
runtests' :: Num b => CliOpts -> IO (Counts, b)
|
||||
runtests' opts = liftM (flip (,) 0) $ runTestTT ts
|
||||
where
|
||||
ts = TestList $ filter matchname $ tflatten tests_Hledger_Cli -- show flat test names
|
||||
-- ts = tfilter matchname $ TestList tests -- show hierarchical test names
|
||||
matchname = matchpats args . tname
|
||||
matchname = matchpats (patterns_ $ reportopts_ opts) . tname
|
||||
|
||||
@ -10,8 +10,6 @@ module Hledger.Cli.Utils
|
||||
(
|
||||
withJournalDo,
|
||||
readJournal',
|
||||
journalSelectingDateFromOpts,
|
||||
journalSelectingAmountFromOpts,
|
||||
journalReload,
|
||||
journalReloadIfChanged,
|
||||
journalFileIsNewer,
|
||||
@ -25,10 +23,10 @@ module Hledger.Cli.Utils
|
||||
)
|
||||
where
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Safe (readMay)
|
||||
import System.Console.CmdArgs
|
||||
import System.Directory (getModificationTime, getDirectoryContents, copyFile)
|
||||
import System.Exit
|
||||
import System.FilePath ((</>), splitFileName, takeDirectory)
|
||||
@ -46,34 +44,22 @@ import Hledger.Utils
|
||||
|
||||
-- | Parse the user's specified journal file and run a hledger command on
|
||||
-- it, or throw an error.
|
||||
withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()
|
||||
withJournalDo opts args _ cmd = do
|
||||
withJournalDo :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO ()
|
||||
withJournalDo opts cmd = do
|
||||
-- We kludgily read the file before parsing to grab the full text, unless
|
||||
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
|
||||
-- to let the add command work.
|
||||
journalFilePathFromOpts opts >>= readJournalFile Nothing >>=
|
||||
either error' (cmd opts args . journalApplyAliases (aliasesFromOpts opts))
|
||||
either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts))
|
||||
|
||||
-- -- | Get a journal from the given string and options, or throw an error.
|
||||
-- readJournalWithOpts :: [Opt] -> String -> IO Journal
|
||||
-- readJournalWithOpts :: CliOpts -> String -> IO Journal
|
||||
-- readJournalWithOpts opts s = readJournal Nothing s >>= either error' return
|
||||
|
||||
-- | Get a journal from the given string, or throw an error.
|
||||
readJournal' :: String -> IO Journal
|
||||
readJournal' s = readJournal Nothing s >>= either error' return
|
||||
|
||||
-- | Convert this journal's transactions' primary date to either the
|
||||
-- actual or effective date, as per options.
|
||||
journalSelectingDateFromOpts :: [Opt] -> Journal -> Journal
|
||||
journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts)
|
||||
|
||||
-- | Convert this journal's postings' amounts to the cost basis amounts if
|
||||
-- specified by options.
|
||||
journalSelectingAmountFromOpts :: [Opt] -> Journal -> Journal
|
||||
journalSelectingAmountFromOpts opts
|
||||
| CostBasis `elem` opts = journalConvertAmountsToCost
|
||||
| otherwise = id
|
||||
|
||||
-- | Re-read a journal from its data file, or return an error string.
|
||||
journalReload :: Journal -> IO (Either String Journal)
|
||||
journalReload j = readJournalFile Nothing $ journalFilePath j
|
||||
@ -83,14 +69,14 @@ journalReload j = readJournalFile Nothing $ journalFilePath j
|
||||
-- stdin). The provided options are mostly ignored. Return a journal or
|
||||
-- the error message while reading it, and a flag indicating whether it
|
||||
-- was re-read or not.
|
||||
journalReloadIfChanged :: [Opt] -> Journal -> IO (Either String Journal, Bool)
|
||||
journalReloadIfChanged opts j = do
|
||||
journalReloadIfChanged :: CliOpts -> Journal -> IO (Either String Journal, Bool)
|
||||
journalReloadIfChanged _ j = do
|
||||
let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f
|
||||
return $ if newer then Just f else Nothing
|
||||
changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j)
|
||||
if not $ null changedfiles
|
||||
then do
|
||||
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (head changedfiles)
|
||||
whenLoud $ printf "%s has changed, reloading\n" (head changedfiles)
|
||||
jE <- journalReload j
|
||||
return (jE, True)
|
||||
else
|
||||
|
||||
@ -60,6 +60,7 @@ library
|
||||
hledger-lib == 0.15
|
||||
,base >= 3 && < 5
|
||||
,containers
|
||||
,cmdargs >= 0.7 && < 0.8
|
||||
,csv
|
||||
,directory
|
||||
,filepath
|
||||
@ -110,6 +111,7 @@ executable hledger
|
||||
hledger-lib == 0.15
|
||||
,base >= 3 && < 5
|
||||
,containers
|
||||
,cmdargs >= 0.7 && < 0.8
|
||||
,csv
|
||||
,directory
|
||||
,filepath
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# Conversion from CSV to Ledger with in-field and out-field
|
||||
rm -rf unused.journal$$ convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert --rules convert.rules$$ - ; rm -rf *$$
|
||||
rm -rf convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; bin/hledger convert --rules-file convert.rules$$ - ; rm -rf *$$
|
||||
<<<
|
||||
10/2009/09,Flubber Co,50,
|
||||
11/2009/09,Flubber Co,,50
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# Conversion from CSV to Ledger
|
||||
rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert input.csv$$ ; rm -rf input.rules *$$
|
||||
rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; bin/hledger convert input.csv$$ ; rm -rf input.rules *$$
|
||||
>>>
|
||||
2009/09/10 Flubber Co
|
||||
income:unknown $-50
|
||||
|
||||
@ -12,8 +12,8 @@ bin/hledger -f- print
|
||||
|
||||
>>>=0
|
||||
|
||||
# 2. convert to cost basis
|
||||
bin/hledger -f- print -B
|
||||
# 2. convert to cost
|
||||
bin/hledger -f- print --cost
|
||||
<<<
|
||||
2011/01/01
|
||||
expenses:foreign currency €100 @ $1.35
|
||||
@ -135,7 +135,7 @@ bin/hledger -f - balance -B
|
||||
0
|
||||
>>>=0
|
||||
# 10. transaction in two commodities should balance out properly
|
||||
bin/hledger -f - balance --basis
|
||||
bin/hledger -f - balance --cost
|
||||
<<<
|
||||
2011/01/01 x
|
||||
a 10£ @@ 16$
|
||||
|
||||
Loading…
Reference in New Issue
Block a user