cli, report & raw options cleanups
This commit is contained in:
parent
3fa4824218
commit
882a9dbf1c
@ -16,6 +16,7 @@ module Hledger.Data (
|
|||||||
module Hledger.Data.Journal,
|
module Hledger.Data.Journal,
|
||||||
module Hledger.Data.Ledger,
|
module Hledger.Data.Ledger,
|
||||||
module Hledger.Data.Posting,
|
module Hledger.Data.Posting,
|
||||||
|
module Hledger.Data.RawOptions,
|
||||||
module Hledger.Data.TimeLog,
|
module Hledger.Data.TimeLog,
|
||||||
module Hledger.Data.Transaction,
|
module Hledger.Data.Transaction,
|
||||||
module Hledger.Data.Types,
|
module Hledger.Data.Types,
|
||||||
@ -32,10 +33,12 @@ import Hledger.Data.Dates
|
|||||||
import Hledger.Data.Journal
|
import Hledger.Data.Journal
|
||||||
import Hledger.Data.Ledger
|
import Hledger.Data.Ledger
|
||||||
import Hledger.Data.Posting
|
import Hledger.Data.Posting
|
||||||
|
import Hledger.Data.RawOptions
|
||||||
import Hledger.Data.TimeLog
|
import Hledger.Data.TimeLog
|
||||||
import Hledger.Data.Transaction
|
import Hledger.Data.Transaction
|
||||||
import Hledger.Data.Types
|
import Hledger.Data.Types
|
||||||
|
|
||||||
|
tests_Hledger_Data :: Test
|
||||||
tests_Hledger_Data = TestList
|
tests_Hledger_Data = TestList
|
||||||
[
|
[
|
||||||
tests_Hledger_Data_Account
|
tests_Hledger_Data_Account
|
||||||
|
|||||||
69
hledger-lib/Hledger/Data/RawOptions.hs
Normal file
69
hledger-lib/Hledger/Data/RawOptions.hs
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-}
|
||||||
|
{-|
|
||||||
|
|
||||||
|
hledger's cmdargs modes parse command-line arguments to an
|
||||||
|
intermediate format, RawOpts (an association list), rather than a
|
||||||
|
fixed ADT like CliOpts. This allows the modes and flags to be reused
|
||||||
|
more easily by hledger commands/scripts in this and other packages.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Hledger.Data.RawOptions (
|
||||||
|
RawOpts,
|
||||||
|
setopt,
|
||||||
|
setboolopt,
|
||||||
|
inRawOpts,
|
||||||
|
boolopt,
|
||||||
|
stringopt,
|
||||||
|
maybestringopt,
|
||||||
|
listofstringopt,
|
||||||
|
intopt,
|
||||||
|
maybeintopt,
|
||||||
|
optserror
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Maybe
|
||||||
|
import Safe
|
||||||
|
|
||||||
|
import Hledger.Utils
|
||||||
|
|
||||||
|
|
||||||
|
-- | The result of running cmdargs: an association list of option names to string values.
|
||||||
|
type RawOpts = [(String,String)]
|
||||||
|
|
||||||
|
setopt :: String -> String -> RawOpts -> RawOpts
|
||||||
|
setopt name val = (++ [(name,singleQuoteIfNeeded val)])
|
||||||
|
|
||||||
|
setboolopt :: String -> RawOpts -> RawOpts
|
||||||
|
setboolopt name = (++ [(name,"")])
|
||||||
|
|
||||||
|
-- | Is the named option present ?
|
||||||
|
inRawOpts :: String -> RawOpts -> Bool
|
||||||
|
inRawOpts name = isJust . lookup name
|
||||||
|
|
||||||
|
boolopt :: String -> RawOpts -> Bool
|
||||||
|
boolopt = inRawOpts
|
||||||
|
|
||||||
|
maybestringopt :: String -> RawOpts -> Maybe String
|
||||||
|
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
|
||||||
|
|
||||||
|
stringopt :: String -> RawOpts -> String
|
||||||
|
stringopt name = fromMaybe "" . maybestringopt name
|
||||||
|
|
||||||
|
listofstringopt :: String -> RawOpts -> [String]
|
||||||
|
listofstringopt name rawopts = [v | (k,v) <- rawopts, k==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 :: String -> RawOpts -> Int
|
||||||
|
intopt name = fromMaybe 0 . maybeintopt name
|
||||||
|
|
||||||
|
-- | Raise an error, showing the specified message plus a hint about --help.
|
||||||
|
optserror :: String -> a
|
||||||
|
optserror = error' . (++ " (run with --help for usage)")
|
||||||
|
|
||||||
@ -1,16 +1,16 @@
|
|||||||
{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}
|
{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
Reusable report-related options.
|
Options common to most hledger reports.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Reports.ReportOptions (
|
module Hledger.Reports.ReportOptions (
|
||||||
ReportOpts(..),
|
ReportOpts(..),
|
||||||
BalanceType(..),
|
BalanceType(..),
|
||||||
DisplayExp,
|
|
||||||
FormatStr,
|
FormatStr,
|
||||||
defreportopts,
|
defreportopts,
|
||||||
|
rawOptsToReportOpts,
|
||||||
dateSpanFromOpts,
|
dateSpanFromOpts,
|
||||||
intervalFromOpts,
|
intervalFromOpts,
|
||||||
clearedValueFromOpts,
|
clearedValueFromOpts,
|
||||||
@ -23,14 +23,15 @@ module Hledger.Reports.ReportOptions (
|
|||||||
transactionDateFn,
|
transactionDateFn,
|
||||||
postingDateFn,
|
postingDateFn,
|
||||||
|
|
||||||
-- * Tests
|
|
||||||
tests_Hledger_Reports_ReportOptions
|
tests_Hledger_Reports_ReportOptions
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Data.Data (Data)
|
||||||
|
import Data.Typeable (Typeable)
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Safe (headMay, lastMay)
|
import Safe (headMay, lastMay)
|
||||||
import System.Console.CmdArgs -- for defaults support
|
import System.Console.CmdArgs.Default -- some additional default stuff
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
@ -38,6 +39,16 @@ import Hledger.Query
|
|||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
|
|
||||||
|
|
||||||
|
type FormatStr = String
|
||||||
|
|
||||||
|
-- | Which balance is being shown in a multi-column balance report.
|
||||||
|
data BalanceType = PeriodBalance -- ^ The change of balance in each period.
|
||||||
|
| CumulativeBalance -- ^ The accumulated balance at each period's end, starting from zero at the report start date.
|
||||||
|
| HistoricalBalance -- ^ The historical balance at each period's end, starting from the account balances at the report start date.
|
||||||
|
deriving (Eq,Show,Data,Typeable)
|
||||||
|
|
||||||
|
instance Default BalanceType where def = PeriodBalance
|
||||||
|
|
||||||
-- | Standard options for customising report filtering and output,
|
-- | Standard options for customising report filtering and output,
|
||||||
-- corresponding to hledger's command-line options and query language
|
-- corresponding to hledger's command-line options and query language
|
||||||
-- arguments. Used in hledger-lib and above.
|
-- arguments. Used in hledger-lib and above.
|
||||||
@ -54,31 +65,26 @@ data ReportOpts = ReportOpts {
|
|||||||
,empty_ :: Bool
|
,empty_ :: Bool
|
||||||
,no_elide_ :: Bool
|
,no_elide_ :: Bool
|
||||||
,real_ :: Bool
|
,real_ :: Bool
|
||||||
,balancetype_ :: BalanceType -- for balance command
|
|
||||||
,flat_ :: Bool -- for balance command
|
|
||||||
,drop_ :: Int -- "
|
|
||||||
,no_total_ :: Bool -- "
|
|
||||||
,daily_ :: Bool
|
,daily_ :: Bool
|
||||||
,weekly_ :: Bool
|
,weekly_ :: Bool
|
||||||
,monthly_ :: Bool
|
,monthly_ :: Bool
|
||||||
,quarterly_ :: Bool
|
,quarterly_ :: Bool
|
||||||
,yearly_ :: Bool
|
,yearly_ :: Bool
|
||||||
,format_ :: Maybe FormatStr
|
,format_ :: Maybe FormatStr
|
||||||
,related_ :: Bool
|
|
||||||
,average_ :: Bool
|
|
||||||
,query_ :: String -- all arguments, as a string
|
,query_ :: String -- all arguments, as a string
|
||||||
|
-- register
|
||||||
|
,average_ :: Bool
|
||||||
|
,related_ :: Bool
|
||||||
|
-- balance
|
||||||
|
,balancetype_ :: BalanceType
|
||||||
|
,flat_ :: Bool
|
||||||
|
,drop_ :: Int
|
||||||
|
,no_total_ :: Bool
|
||||||
} deriving (Show, Data, Typeable)
|
} deriving (Show, Data, Typeable)
|
||||||
|
|
||||||
type DisplayExp = String
|
instance Default ReportOpts where def = defreportopts
|
||||||
type FormatStr = String
|
|
||||||
|
|
||||||
-- | Which balance is being shown in a multi-column balance report.
|
|
||||||
data BalanceType = PeriodBalance -- ^ The change of balance in each period.
|
|
||||||
| CumulativeBalance -- ^ The accumulated balance at each period's end, starting from zero at the report start date.
|
|
||||||
| HistoricalBalance -- ^ The historical balance at each period's end, starting from the account balances at the report start date.
|
|
||||||
deriving (Eq,Show,Data,Typeable)
|
|
||||||
instance Default BalanceType where def = PeriodBalance
|
|
||||||
|
|
||||||
|
defreportopts :: ReportOpts
|
||||||
defreportopts = ReportOpts
|
defreportopts = ReportOpts
|
||||||
def
|
def
|
||||||
def
|
def
|
||||||
@ -106,7 +112,73 @@ defreportopts = ReportOpts
|
|||||||
def
|
def
|
||||||
def
|
def
|
||||||
|
|
||||||
instance Default ReportOpts where def = defreportopts
|
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
|
||||||
|
rawOptsToReportOpts rawopts = do
|
||||||
|
d <- getCurrentDay
|
||||||
|
return 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
|
||||||
|
,date2_ = boolopt "date2" rawopts
|
||||||
|
,empty_ = boolopt "empty" rawopts
|
||||||
|
,no_elide_ = boolopt "no-elide" rawopts
|
||||||
|
,real_ = boolopt "real" rawopts
|
||||||
|
,daily_ = boolopt "daily" rawopts
|
||||||
|
,weekly_ = boolopt "weekly" rawopts
|
||||||
|
,monthly_ = boolopt "monthly" rawopts
|
||||||
|
,quarterly_ = boolopt "quarterly" rawopts
|
||||||
|
,yearly_ = boolopt "yearly" rawopts
|
||||||
|
,format_ = maybestringopt "format" rawopts
|
||||||
|
,query_ = unwords $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
|
||||||
|
,average_ = boolopt "average" rawopts
|
||||||
|
,related_ = boolopt "related" rawopts
|
||||||
|
,balancetype_ = balancetypeopt rawopts
|
||||||
|
,flat_ = boolopt "flat" rawopts
|
||||||
|
,drop_ = intopt "drop" rawopts
|
||||||
|
,no_total_ = boolopt "no-total" rawopts
|
||||||
|
}
|
||||||
|
|
||||||
|
balancetypeopt :: RawOpts -> BalanceType
|
||||||
|
balancetypeopt rawopts
|
||||||
|
| length [o | o <- ["cumulative","historical"], isset o] > 1
|
||||||
|
= optserror "please specify at most one of --cumulative and --historical"
|
||||||
|
| isset "cumulative" = CumulativeBalance
|
||||||
|
| isset "historical" = HistoricalBalance
|
||||||
|
| otherwise = PeriodBalance
|
||||||
|
where
|
||||||
|
isset = flip boolopt rawopts
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
type DisplayExp = String
|
||||||
|
|
||||||
|
maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp
|
||||||
|
maybedisplayopt d rawopts =
|
||||||
|
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
|
||||||
|
where
|
||||||
|
fixbracketeddatestr "" = ""
|
||||||
|
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
-- | Figure out the date span we should report on, based on any
|
-- | Figure out the date span we should report on, based on any
|
||||||
-- begin/end/period options provided. A period option will cause begin and
|
-- begin/end/period options provided. A period option will cause begin and
|
||||||
@ -182,6 +254,7 @@ queryFromOptsOnly d opts@ReportOpts{..} = simplifyQuery flagsq
|
|||||||
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
||||||
++ (maybe [] ((:[]) . Depth) depth_)
|
++ (maybe [] ((:[]) . Depth) depth_)
|
||||||
|
|
||||||
|
tests_queryFromOpts :: [Test]
|
||||||
tests_queryFromOpts = [
|
tests_queryFromOpts = [
|
||||||
"queryFromOpts" ~: do
|
"queryFromOpts" ~: do
|
||||||
assertEqual "" Any (queryFromOpts nulldate defreportopts)
|
assertEqual "" Any (queryFromOpts nulldate defreportopts)
|
||||||
@ -204,6 +277,7 @@ queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts
|
|||||||
flagsqopts = []
|
flagsqopts = []
|
||||||
argsqopts = snd $ parseQuery d query_
|
argsqopts = snd $ parseQuery d query_
|
||||||
|
|
||||||
|
tests_queryOptsFromOpts :: [Test]
|
||||||
tests_queryOptsFromOpts = [
|
tests_queryOptsFromOpts = [
|
||||||
"queryOptsFromOpts" ~: do
|
"queryOptsFromOpts" ~: do
|
||||||
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)
|
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)
|
||||||
|
|||||||
@ -43,6 +43,7 @@ library
|
|||||||
Hledger.Data.Journal
|
Hledger.Data.Journal
|
||||||
Hledger.Data.Ledger
|
Hledger.Data.Ledger
|
||||||
Hledger.Data.Posting
|
Hledger.Data.Posting
|
||||||
|
Hledger.Data.RawOptions
|
||||||
Hledger.Data.TimeLog
|
Hledger.Data.TimeLog
|
||||||
Hledger.Data.Transaction
|
Hledger.Data.Transaction
|
||||||
Hledger.Data.Types
|
Hledger.Data.Types
|
||||||
|
|||||||
@ -62,16 +62,16 @@ import Hledger.Cli.Options
|
|||||||
import Hledger.Cli.Tests
|
import Hledger.Cli.Tests
|
||||||
import Hledger.Cli.Utils
|
import Hledger.Cli.Utils
|
||||||
import Hledger.Cli.Version
|
import Hledger.Cli.Version
|
||||||
|
import Hledger.Data.Dates (getCurrentDay)
|
||||||
|
import Hledger.Data.RawOptions (optserror)
|
||||||
|
import Hledger.Reports.ReportOptions (dateSpanFromOpts, intervalFromOpts, queryFromOpts)
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
import Hledger.Reports
|
|
||||||
import Hledger.Data.Dates
|
|
||||||
|
|
||||||
|
|
||||||
-- | The overall cmdargs mode describing command-line options for hledger.
|
-- | The overall cmdargs mode describing command-line options for hledger.
|
||||||
mainmode addons = defMode {
|
mainmode addons = defMode {
|
||||||
modeNames = [progname]
|
modeNames = [progname]
|
||||||
,modeHelp = unlines [
|
,modeHelp = unlines []
|
||||||
]
|
|
||||||
,modeHelpSuffix = [""]
|
,modeHelpSuffix = [""]
|
||||||
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
||||||
,modeGroupModes = Group {
|
,modeGroupModes = Group {
|
||||||
|
|||||||
@ -1,72 +1,54 @@
|
|||||||
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-}
|
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
Common command-line options and utilities used by hledger's subcommands and addons.
|
Common cmdargs modes and flags, a command-line options type, and
|
||||||
|
related utilities used by hledger commands.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Cli.Options (
|
module Hledger.Cli.Options (
|
||||||
|
|
||||||
-- * cmdargs modes & flags
|
-- * cmdargs flags & modes
|
||||||
-- | These tell cmdargs how to parse the command line arguments for each hledger subcommand.
|
|
||||||
argsFlag,
|
|
||||||
defAddonCommandMode,
|
|
||||||
defCommandMode,
|
|
||||||
defMode,
|
|
||||||
generalflagsgroup1,
|
|
||||||
generalflagsgroup2,
|
|
||||||
generalflagsgroup3,
|
|
||||||
helpflags,
|
helpflags,
|
||||||
inputflags,
|
inputflags,
|
||||||
reportflags,
|
reportflags,
|
||||||
|
generalflagsgroup1,
|
||||||
-- * Raw options
|
generalflagsgroup2,
|
||||||
-- | To allow the cmdargs modes to be reused and extended by other
|
generalflagsgroup3,
|
||||||
-- packages (eg, add-ons which want to mimic the standard hledger
|
defMode,
|
||||||
-- options), our cmdargs modes parse to an extensible association
|
defCommandMode,
|
||||||
-- list (RawOpts) rather than a closed ADT like CliOpts.
|
defAddonCommandMode,
|
||||||
RawOpts,
|
argsFlag,
|
||||||
boolopt,
|
|
||||||
inRawOpts,
|
|
||||||
intopt,
|
|
||||||
listofstringopt,
|
|
||||||
maybeintopt,
|
|
||||||
maybestringopt,
|
|
||||||
setboolopt,
|
|
||||||
setopt,
|
|
||||||
stringopt,
|
|
||||||
|
|
||||||
-- * CLI options
|
|
||||||
-- | Raw options are converted to a more convenient,
|
|
||||||
-- package-specific options structure. This is the \"opts\" used
|
|
||||||
-- throughout hledger CLI code.
|
|
||||||
CliOpts(..),
|
|
||||||
defcliopts,
|
|
||||||
|
|
||||||
-- * CLI option accessors
|
|
||||||
-- | Some options require more processing. Possibly these should be merged into argsToCliOpts.
|
|
||||||
OutputWidth(..),
|
|
||||||
Width(..),
|
|
||||||
aliasesFromOpts,
|
|
||||||
defaultWidth,
|
|
||||||
defaultWidthWithFlag,
|
|
||||||
formatFromOpts,
|
|
||||||
journalFilePathFromOpts,
|
|
||||||
rulesFilePathFromOpts,
|
|
||||||
widthFromOpts,
|
|
||||||
|
|
||||||
-- * utilities
|
|
||||||
checkCliOpts,
|
|
||||||
debugArgs,
|
|
||||||
decodeRawOpts,
|
|
||||||
getCliOpts,
|
|
||||||
getHledgerAddonCommands,
|
|
||||||
optserror,
|
|
||||||
rawOptsToCliOpts,
|
|
||||||
showModeHelp,
|
showModeHelp,
|
||||||
withAliases,
|
withAliases,
|
||||||
|
|
||||||
-- * tests
|
-- * CLI options
|
||||||
|
CliOpts(..),
|
||||||
|
defcliopts,
|
||||||
|
-- getCliOpts,
|
||||||
|
decodeRawOpts,
|
||||||
|
rawOptsToCliOpts,
|
||||||
|
checkCliOpts,
|
||||||
|
|
||||||
|
-- possibly these should move into argsToCliOpts
|
||||||
|
-- * CLI option accessors
|
||||||
|
-- | These do the extra processing required for some options.
|
||||||
|
aliasesFromOpts,
|
||||||
|
journalFilePathFromOpts,
|
||||||
|
rulesFilePathFromOpts,
|
||||||
|
-- | For register:
|
||||||
|
OutputWidth(..),
|
||||||
|
Width(..),
|
||||||
|
defaultWidth,
|
||||||
|
defaultWidthWithFlag,
|
||||||
|
widthFromOpts,
|
||||||
|
-- | For balance:
|
||||||
|
formatFromOpts,
|
||||||
|
|
||||||
|
-- * Other utils
|
||||||
|
getHledgerAddonCommands,
|
||||||
|
|
||||||
|
-- * Tests
|
||||||
tests_Hledger_Cli_Options
|
tests_Hledger_Cli_Options
|
||||||
|
|
||||||
)
|
)
|
||||||
@ -74,18 +56,17 @@ where
|
|||||||
|
|
||||||
import qualified Control.Exception as C
|
import qualified Control.Exception as C
|
||||||
-- import Control.Monad (filterM)
|
-- import Control.Monad (filterM)
|
||||||
import Control.Monad (when)
|
-- import Control.Monad (when)
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.List.Split
|
import Data.List.Split
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Time.Calendar
|
|
||||||
import Safe
|
import Safe
|
||||||
import System.Console.CmdArgs
|
import System.Console.CmdArgs
|
||||||
import System.Console.CmdArgs.Explicit
|
import System.Console.CmdArgs.Explicit
|
||||||
import System.Console.CmdArgs.Text
|
import System.Console.CmdArgs.Text
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Exit
|
-- import System.Exit
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.ParserCombinators.Parsec as P
|
import Text.ParserCombinators.Parsec as P
|
||||||
|
|
||||||
@ -93,17 +74,11 @@ import Hledger
|
|||||||
import Hledger.Data.OutputFormat as OutputFormat
|
import Hledger.Data.OutputFormat as OutputFormat
|
||||||
import Hledger.Cli.Version
|
import Hledger.Cli.Version
|
||||||
|
|
||||||
--
|
|
||||||
-- 1. cmdargs mode and flag (option) definitions for the hledger CLI,
|
|
||||||
-- can be reused by other packages as well.
|
|
||||||
--
|
|
||||||
|
|
||||||
-- | Our cmdargs modes parse arguments into an association list for better reuse.
|
-- common cmdargs flags
|
||||||
type RawOpts = [(String,String)]
|
|
||||||
|
|
||||||
-- common flags and flag groups
|
|
||||||
|
|
||||||
-- | Common help flags: --help, --debug, --version...
|
-- | Common help flags: --help, --debug, --version...
|
||||||
|
helpflags :: [Flag RawOpts]
|
||||||
helpflags = [
|
helpflags = [
|
||||||
flagNone ["help","h","?"] (setboolopt "help") "Display general help or (with --help after COMMAND) command help."
|
flagNone ["help","h","?"] (setboolopt "help") "Display general help or (with --help after COMMAND) command help."
|
||||||
-- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"
|
-- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"
|
||||||
@ -112,6 +87,7 @@ helpflags = [
|
|||||||
]
|
]
|
||||||
|
|
||||||
-- | Common input-related flags: --file, --rules-file, --alias...
|
-- | Common input-related flags: --file, --rules-file, --alias...
|
||||||
|
inputflags :: [Flag RawOpts]
|
||||||
inputflags = [
|
inputflags = [
|
||||||
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"
|
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"
|
||||||
,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)"
|
,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)"
|
||||||
@ -119,6 +95,7 @@ inputflags = [
|
|||||||
]
|
]
|
||||||
|
|
||||||
-- | Common report-related flags: --period, --cost, --display etc.
|
-- | Common report-related flags: --period, --cost, --display etc.
|
||||||
|
reportflags :: [Flag RawOpts]
|
||||||
reportflags = [
|
reportflags = [
|
||||||
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date"
|
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 ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date"
|
||||||
@ -138,9 +115,13 @@ reportflags = [
|
|||||||
,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
|
,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
argsFlag :: FlagHelp -> Arg RawOpts
|
||||||
argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc
|
argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc
|
||||||
|
|
||||||
|
generalflagstitle :: String
|
||||||
generalflagstitle = "\nGeneral flags"
|
generalflagstitle = "\nGeneral flags"
|
||||||
|
|
||||||
|
generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts])
|
||||||
generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags)
|
generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags)
|
||||||
generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags)
|
generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags)
|
||||||
generalflagsgroup3 = (generalflagstitle, helpflags)
|
generalflagsgroup3 = (generalflagstitle, helpflags)
|
||||||
@ -169,6 +150,7 @@ defMode = Mode {
|
|||||||
}
|
}
|
||||||
|
|
||||||
-- | A basic subcommand mode with the given command name(s).
|
-- | A basic subcommand mode with the given command name(s).
|
||||||
|
defCommandMode :: [Name] -> Mode RawOpts
|
||||||
defCommandMode names = defMode {
|
defCommandMode names = defMode {
|
||||||
modeNames=names
|
modeNames=names
|
||||||
,modeValue=[("command", headDef "" names)]
|
,modeValue=[("command", headDef "" names)]
|
||||||
@ -176,6 +158,7 @@ defCommandMode names = defMode {
|
|||||||
}
|
}
|
||||||
|
|
||||||
-- | A basic subcommand mode suitable for an add-on command.
|
-- | A basic subcommand mode suitable for an add-on command.
|
||||||
|
defAddonCommandMode :: Name -> Mode RawOpts
|
||||||
defAddonCommandMode addon = defMode {
|
defAddonCommandMode addon = defMode {
|
||||||
modeNames = [addon]
|
modeNames = [addon]
|
||||||
,modeHelp = fromMaybe "" $ lookup (striphs addon) standardAddonsHelp
|
,modeHelp = fromMaybe "" $ lookup (striphs addon) standardAddonsHelp
|
||||||
@ -188,6 +171,7 @@ defAddonCommandMode addon = defMode {
|
|||||||
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
||||||
}
|
}
|
||||||
|
|
||||||
|
striphs :: String -> String
|
||||||
striphs = regexReplace "\\.l?hs$" ""
|
striphs = regexReplace "\\.l?hs$" ""
|
||||||
|
|
||||||
-- | Built-in descriptions for some of the known external addons,
|
-- | Built-in descriptions for some of the known external addons,
|
||||||
@ -207,6 +191,11 @@ standardAddonsHelp = [
|
|||||||
,("rewrite", "add specified postings to matched transaction entries")
|
,("rewrite", "add specified postings to matched transaction entries")
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- | Get a mode's help message as a nicely wrapped string.
|
||||||
|
showModeHelp :: Mode a -> String
|
||||||
|
showModeHelp = (showText defaultWrap :: [Text] -> String) .
|
||||||
|
(helpText [] HelpFormatDefault :: Mode a -> [Text])
|
||||||
|
|
||||||
-- | Add command aliases to the command's help string.
|
-- | Add command aliases to the command's help string.
|
||||||
withAliases :: String -> [String] -> String
|
withAliases :: String -> [String] -> String
|
||||||
s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")"
|
s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")"
|
||||||
@ -223,14 +212,13 @@ s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")"
|
|||||||
-- -- ,"When using both, not: comes last."
|
-- -- ,"When using both, not: comes last."
|
||||||
-- ]
|
-- ]
|
||||||
|
|
||||||
--
|
|
||||||
-- 2. A package-specific data structure 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)
|
|
||||||
--
|
|
||||||
|
|
||||||
-- | Command line options. Used in the @hledger@ package and above.
|
-- CliOpts
|
||||||
|
|
||||||
|
-- | Command line options, used in the @hledger@ package and above.
|
||||||
|
-- This is the \"opts\" used throughout hledger CLI code.
|
||||||
|
-- representing the options that arguments that were provided at
|
||||||
|
-- startup on the command-line.
|
||||||
data CliOpts = CliOpts {
|
data CliOpts = CliOpts {
|
||||||
rawopts_ :: RawOpts
|
rawopts_ :: RawOpts
|
||||||
,command_ :: String
|
,command_ :: String
|
||||||
@ -243,6 +231,9 @@ data CliOpts = CliOpts {
|
|||||||
,reportopts_ :: ReportOpts
|
,reportopts_ :: ReportOpts
|
||||||
} deriving (Show, Data, Typeable)
|
} deriving (Show, Data, Typeable)
|
||||||
|
|
||||||
|
instance Default CliOpts where def = defcliopts
|
||||||
|
|
||||||
|
defcliopts :: CliOpts
|
||||||
defcliopts = CliOpts
|
defcliopts = CliOpts
|
||||||
def
|
def
|
||||||
def
|
def
|
||||||
@ -254,14 +245,16 @@ defcliopts = CliOpts
|
|||||||
def
|
def
|
||||||
def
|
def
|
||||||
|
|
||||||
instance Default CliOpts where def = defcliopts
|
-- | Convert possibly encoded option values to regular unicode strings.
|
||||||
|
decodeRawOpts :: RawOpts -> RawOpts
|
||||||
|
decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))
|
||||||
|
|
||||||
-- | Parse raw option string values to the desired final data types.
|
-- | Parse raw option string values to the desired final data types.
|
||||||
-- Any relative smart dates will be converted to fixed dates based on
|
-- Any relative smart dates will be converted to fixed dates based on
|
||||||
-- today's date. Parsing failures will raise an error.
|
-- today's date. Parsing failures will raise an error.
|
||||||
rawOptsToCliOpts :: RawOpts -> IO CliOpts
|
rawOptsToCliOpts :: RawOpts -> IO CliOpts
|
||||||
rawOptsToCliOpts rawopts = do
|
rawOptsToCliOpts rawopts = do
|
||||||
d <- getCurrentDay
|
ropts <- rawOptsToReportOpts rawopts
|
||||||
return defcliopts {
|
return defcliopts {
|
||||||
rawopts_ = rawopts
|
rawopts_ = rawopts
|
||||||
,command_ = stringopt "command" rawopts
|
,command_ = stringopt "command" rawopts
|
||||||
@ -271,37 +264,8 @@ rawOptsToCliOpts rawopts = do
|
|||||||
,debug_ = intopt "debug" rawopts
|
,debug_ = intopt "debug" rawopts
|
||||||
,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
|
,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
|
||||||
,width_ = maybestringopt "width" rawopts -- register
|
,width_ = maybestringopt "width" rawopts -- register
|
||||||
,reportopts_ = defreportopts {
|
,reportopts_ = ropts
|
||||||
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
|
|
||||||
,date2_ = boolopt "date2" rawopts
|
|
||||||
,empty_ = boolopt "empty" rawopts
|
|
||||||
,no_elide_ = boolopt "no-elide" rawopts
|
|
||||||
,real_ = boolopt "real" rawopts
|
|
||||||
,balancetype_ = balancetypeopt rawopts -- balance
|
|
||||||
,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
|
|
||||||
,average_ = boolopt "average" rawopts -- register
|
|
||||||
,related_ = boolopt "related" rawopts -- register
|
|
||||||
,query_ = unwords $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
|
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
-- | Convert possibly encoded option values to regular unicode strings.
|
|
||||||
decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))
|
|
||||||
|
|
||||||
-- | Do final validation of processed opts, raising an error if there is trouble.
|
-- | Do final validation of processed opts, raising an error if there is trouble.
|
||||||
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
|
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
|
||||||
@ -314,159 +278,22 @@ checkCliOpts opts@CliOpts{reportopts_=ropts} = do
|
|||||||
Right _ -> return ()
|
Right _ -> return ()
|
||||||
return opts
|
return opts
|
||||||
|
|
||||||
--
|
-- not used:
|
||||||
-- utils
|
-- -- | Parse hledger CLI options from the command line using the given
|
||||||
--
|
-- -- cmdargs mode, and either return them or, if a help flag is present,
|
||||||
|
-- -- print the mode help and exit the program.
|
||||||
|
-- getCliOpts :: Mode RawOpts -> IO CliOpts
|
||||||
|
-- getCliOpts mode = do
|
||||||
|
-- args <- getArgs
|
||||||
|
-- let rawopts = decodeRawOpts $ processValue mode args
|
||||||
|
-- opts <- rawOptsToCliOpts rawopts >>= checkCliOpts
|
||||||
|
-- debugArgs args opts
|
||||||
|
-- -- if any (`elem` args) ["--help","-h","-?"]
|
||||||
|
-- when ("help" `inRawOpts` rawopts_ opts) $
|
||||||
|
-- putStr (showModeHelp mode) >> exitSuccess
|
||||||
|
-- return opts
|
||||||
|
|
||||||
-- | Get the unique suffixes (without hledger-) of hledger-* executables
|
-- CliOpts accessors
|
||||||
-- found in the current user's PATH, or the empty list if there is any
|
|
||||||
-- problem.
|
|
||||||
getHledgerAddonCommands :: IO [String]
|
|
||||||
getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerExesInPath
|
|
||||||
|
|
||||||
-- | Get the unique names of hledger-*{,.hs} executables found in the current
|
|
||||||
-- user's PATH, or the empty list if there is any problem.
|
|
||||||
getHledgerExesInPath :: IO [String]
|
|
||||||
getHledgerExesInPath = do
|
|
||||||
pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
|
|
||||||
pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
|
|
||||||
let hledgernamed = nubBy (\a b -> striphs a == striphs b) $ sort $ filter isHledgerExeName pathfiles
|
|
||||||
where striphs = regexReplace "\\.l?hs$" ""
|
|
||||||
-- hledgerexes <- filterM isExecutable hledgernamed
|
|
||||||
return hledgernamed
|
|
||||||
|
|
||||||
-- isExecutable f = getPermissions f >>= (return . executable)
|
|
||||||
|
|
||||||
isHledgerExeName = isRight . parsewith hledgerexenamep
|
|
||||||
where
|
|
||||||
hledgerexenamep = do
|
|
||||||
string progname
|
|
||||||
char '-'
|
|
||||||
many1 (noneOf ".")
|
|
||||||
optional (string ".hs" <|> string ".lhs")
|
|
||||||
eof
|
|
||||||
|
|
||||||
getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")
|
|
||||||
|
|
||||||
getDirectoryContentsSafe d =
|
|
||||||
(filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return [])
|
|
||||||
|
|
||||||
-- | Raise an error, showing the specified message plus a hint about --help.
|
|
||||||
optserror = error' . (++ " (run with --help for usage)")
|
|
||||||
|
|
||||||
setopt name val = (++ [(name,singleQuoteIfNeeded val)])
|
|
||||||
|
|
||||||
setboolopt name = (++ [(name,"")])
|
|
||||||
|
|
||||||
-- | Is the named option present ?
|
|
||||||
inRawOpts :: String -> RawOpts -> Bool
|
|
||||||
inRawOpts name = isJust . lookup name
|
|
||||||
|
|
||||||
boolopt = inRawOpts
|
|
||||||
|
|
||||||
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
|
|
||||||
|
|
||||||
stringopt name = fromMaybe "" . maybestringopt name
|
|
||||||
|
|
||||||
listofstringopt name rawopts = [v | (k,v) <- rawopts, k==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 DisplayExp
|
|
||||||
maybedisplayopt d rawopts =
|
|
||||||
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
|
|
||||||
where
|
|
||||||
fixbracketeddatestr "" = ""
|
|
||||||
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
balancetypeopt :: RawOpts -> BalanceType
|
|
||||||
balancetypeopt rawopts
|
|
||||||
| length [o | o <- ["cumulative","historical"], isset o] > 1
|
|
||||||
= optserror "please specify at most one of --cumulative and --historical"
|
|
||||||
| isset "cumulative" = CumulativeBalance
|
|
||||||
| isset "historical" = HistoricalBalance
|
|
||||||
| otherwise = PeriodBalance
|
|
||||||
where
|
|
||||||
isset = flip boolopt rawopts
|
|
||||||
|
|
||||||
-- | Parse the format option if provided, possibly returning an error,
|
|
||||||
-- otherwise get the default value.
|
|
||||||
formatFromOpts :: ReportOpts -> Either String [OutputFormat]
|
|
||||||
formatFromOpts = maybe (Right defaultBalanceFormat) parseStringFormat . format_
|
|
||||||
|
|
||||||
-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"
|
|
||||||
defaultBalanceFormat :: [OutputFormat]
|
|
||||||
defaultBalanceFormat = [
|
|
||||||
FormatField False (Just 20) Nothing TotalField
|
|
||||||
, FormatLiteral " "
|
|
||||||
, FormatField True (Just 2) Nothing DepthSpacerField
|
|
||||||
, FormatField True Nothing Nothing AccountField
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | Output width configuration (for register).
|
|
||||||
data OutputWidth =
|
|
||||||
TotalWidth Width -- ^ specify the overall width
|
|
||||||
| FieldWidths [Width] -- ^ specify each field's width
|
|
||||||
deriving Show
|
|
||||||
|
|
||||||
-- | A width value.
|
|
||||||
data Width =
|
|
||||||
Width Int -- ^ set width to exactly this number of characters
|
|
||||||
| Auto -- ^ set width automatically from available space
|
|
||||||
deriving Show
|
|
||||||
|
|
||||||
-- | Default width of hledger console output.
|
|
||||||
defaultWidth = 80
|
|
||||||
|
|
||||||
-- | Width of hledger console output when the -w flag is used with no value.
|
|
||||||
defaultWidthWithFlag = 120
|
|
||||||
|
|
||||||
-- | Parse the width option if provided, possibly returning an error,
|
|
||||||
-- otherwise get the default value.
|
|
||||||
widthFromOpts :: CliOpts -> Either String OutputWidth
|
|
||||||
widthFromOpts CliOpts{width_=Nothing} = Right $ TotalWidth $ Width defaultWidth
|
|
||||||
widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthWithFlag
|
|
||||||
widthFromOpts CliOpts{width_=Just s} = parseWidth s
|
|
||||||
|
|
||||||
parseWidth :: String -> Either String OutputWidth
|
|
||||||
parseWidth s = case (runParser outputwidthp () "(unknown)") s of
|
|
||||||
Left e -> Left $ show e
|
|
||||||
Right x -> Right x
|
|
||||||
|
|
||||||
outputwidthp :: GenParser Char st OutputWidth
|
|
||||||
outputwidthp =
|
|
||||||
try (do w <- widthp
|
|
||||||
ws <- many1 (char ',' >> widthp)
|
|
||||||
return $ FieldWidths $ w:ws)
|
|
||||||
<|> TotalWidth `fmap` widthp
|
|
||||||
|
|
||||||
widthp :: GenParser Char st Width
|
|
||||||
widthp = (string "auto" >> return Auto)
|
|
||||||
<|> (Width . read) `fmap` many1 digit
|
|
||||||
|
|
||||||
-- | Get the account name aliases from options, if any.
|
-- | Get the account name aliases from options, if any.
|
||||||
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
|
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
|
||||||
@ -495,41 +322,119 @@ rulesFilePathFromOpts opts = do
|
|||||||
d <- getCurrentDirectory
|
d <- getCurrentDirectory
|
||||||
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
|
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
|
||||||
|
|
||||||
-- | Get a mode's help message as a nicely wrapped string.
|
-- for balance, currently:
|
||||||
showModeHelp :: Mode a -> String
|
|
||||||
showModeHelp =
|
-- | Parse the format option if provided, possibly returning an error,
|
||||||
(showText defaultWrap :: [Text] -> String) .
|
-- otherwise get the default value.
|
||||||
(helpText [] HelpFormatDefault :: Mode a -> [Text])
|
formatFromOpts :: ReportOpts -> Either String [OutputFormat]
|
||||||
|
formatFromOpts = maybe (Right defaultBalanceFormat) parseStringFormat . format_
|
||||||
|
|
||||||
|
-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"
|
||||||
|
defaultBalanceFormat :: [OutputFormat]
|
||||||
|
defaultBalanceFormat = [
|
||||||
|
FormatField False (Just 20) Nothing TotalField
|
||||||
|
, FormatLiteral " "
|
||||||
|
, FormatField True (Just 2) Nothing DepthSpacerField
|
||||||
|
, FormatField True Nothing Nothing AccountField
|
||||||
|
]
|
||||||
|
|
||||||
|
-- for register:
|
||||||
|
|
||||||
|
-- | Output width configuration (for register).
|
||||||
|
data OutputWidth =
|
||||||
|
TotalWidth Width -- ^ specify the overall width
|
||||||
|
| FieldWidths [Width] -- ^ specify each field's width
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
-- | A width value.
|
||||||
|
data Width =
|
||||||
|
Width Int -- ^ set width to exactly this number of characters
|
||||||
|
| Auto -- ^ set width automatically from available space
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
-- | Default width of hledger console output.
|
||||||
|
defaultWidth :: Int
|
||||||
|
defaultWidth = 80
|
||||||
|
|
||||||
|
-- | Width of hledger console output when the -w flag is used with no value.
|
||||||
|
defaultWidthWithFlag :: Int
|
||||||
|
defaultWidthWithFlag = 120
|
||||||
|
|
||||||
|
-- | Parse the width option if provided, possibly returning an error,
|
||||||
|
-- otherwise get the default value.
|
||||||
|
widthFromOpts :: CliOpts -> Either String OutputWidth
|
||||||
|
widthFromOpts CliOpts{width_=Nothing} = Right $ TotalWidth $ Width defaultWidth
|
||||||
|
widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthWithFlag
|
||||||
|
widthFromOpts CliOpts{width_=Just s} = parseWidth s
|
||||||
|
|
||||||
|
parseWidth :: String -> Either String OutputWidth
|
||||||
|
parseWidth s = case (runParser outputwidthp () "(unknown)") s of
|
||||||
|
Left e -> Left $ show e
|
||||||
|
Right x -> Right x
|
||||||
|
|
||||||
|
outputwidthp :: GenParser Char st OutputWidth
|
||||||
|
outputwidthp =
|
||||||
|
try (do w <- widthp
|
||||||
|
ws <- many1 (char ',' >> widthp)
|
||||||
|
return $ FieldWidths $ w:ws)
|
||||||
|
<|> TotalWidth `fmap` widthp
|
||||||
|
|
||||||
|
widthp :: GenParser Char st Width
|
||||||
|
widthp = (string "auto" >> return Auto)
|
||||||
|
<|> (Width . read) `fmap` many1 digit
|
||||||
|
|
||||||
|
-- Other utils
|
||||||
|
|
||||||
|
-- | Get the unique suffixes (without hledger-) of hledger-* executables
|
||||||
|
-- found in the current user's PATH, or the empty list if there is any
|
||||||
|
-- problem.
|
||||||
|
getHledgerAddonCommands :: IO [String]
|
||||||
|
getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerExesInPath
|
||||||
|
|
||||||
|
-- | Get the unique names of hledger-*{,.hs} executables found in the current
|
||||||
|
-- user's PATH, or the empty list if there is any problem.
|
||||||
|
getHledgerExesInPath :: IO [String]
|
||||||
|
getHledgerExesInPath = do
|
||||||
|
pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
|
||||||
|
pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
|
||||||
|
let hledgernamed = nubBy (\a b -> striphs a == striphs b) $ sort $ filter isHledgerExeName pathfiles
|
||||||
|
-- hledgerexes <- filterM isExecutable hledgernamed
|
||||||
|
return hledgernamed
|
||||||
|
|
||||||
|
-- isExecutable f = getPermissions f >>= (return . executable)
|
||||||
|
|
||||||
|
isHledgerExeName :: String -> Bool
|
||||||
|
isHledgerExeName = isRight . parsewith hledgerexenamep
|
||||||
|
where
|
||||||
|
hledgerexenamep = do
|
||||||
|
string progname
|
||||||
|
char '-'
|
||||||
|
many1 (noneOf ".")
|
||||||
|
optional (string ".hs" <|> string ".lhs")
|
||||||
|
eof
|
||||||
|
|
||||||
|
getEnvSafe :: String -> IO String
|
||||||
|
getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")
|
||||||
|
|
||||||
|
getDirectoryContentsSafe :: FilePath -> IO [String]
|
||||||
|
getDirectoryContentsSafe d =
|
||||||
|
(filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return [])
|
||||||
|
|
||||||
-- not used:
|
-- not used:
|
||||||
|
-- -- | Print debug info about arguments and options if --debug is present.
|
||||||
|
-- debugArgs :: [String] -> CliOpts -> IO ()
|
||||||
|
-- debugArgs args opts =
|
||||||
|
-- when ("--debug" `elem` args) $ do
|
||||||
|
-- progname <- getProgName
|
||||||
|
-- putStrLn $ "running: " ++ progname
|
||||||
|
-- putStrLn $ "raw args: " ++ show args
|
||||||
|
-- putStrLn $ "processed opts:\n" ++ show opts
|
||||||
|
-- d <- getCurrentDay
|
||||||
|
-- putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)
|
||||||
|
|
||||||
-- | Print debug info about arguments and options if --debug is present.
|
-- tests
|
||||||
debugArgs :: [String] -> CliOpts -> IO ()
|
|
||||||
debugArgs args opts =
|
|
||||||
when ("--debug" `elem` args) $ do
|
|
||||||
progname <- getProgName
|
|
||||||
putStrLn $ "running: " ++ progname
|
|
||||||
putStrLn $ "raw args: " ++ show args
|
|
||||||
putStrLn $ "processed opts:\n" ++ show opts
|
|
||||||
d <- getCurrentDay
|
|
||||||
putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)
|
|
||||||
|
|
||||||
-- not used:
|
|
||||||
|
|
||||||
-- | Parse hledger CLI options from the command line using the given
|
|
||||||
-- cmdargs mode, and either return them or, if a help flag is present,
|
|
||||||
-- print the mode help and exit the program.
|
|
||||||
getCliOpts :: Mode RawOpts -> IO CliOpts
|
|
||||||
getCliOpts mode = do
|
|
||||||
args <- getArgs
|
|
||||||
let rawopts = decodeRawOpts $ processValue mode args
|
|
||||||
opts <- rawOptsToCliOpts rawopts >>= checkCliOpts
|
|
||||||
debugArgs args opts
|
|
||||||
-- if any (`elem` args) ["--help","-h","-?"]
|
|
||||||
when ("help" `inRawOpts` rawopts_ opts) $
|
|
||||||
putStr (showModeHelp mode) >> exitSuccess
|
|
||||||
return opts
|
|
||||||
|
|
||||||
|
tests_Hledger_Cli_Options :: Test
|
||||||
tests_Hledger_Cli_Options = TestList
|
tests_Hledger_Cli_Options = TestList
|
||||||
[
|
[
|
||||||
]
|
]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user