rename Flag to Opt, cleanup
This commit is contained in:
parent
f924669b4f
commit
b00dc34b4f
34
Options.hs
34
Options.hs
@ -1,5 +1,5 @@
|
|||||||
module Options (
|
module Options (
|
||||||
Flag(..),
|
Opt(..),
|
||||||
usage,
|
usage,
|
||||||
parseArguments,
|
parseArguments,
|
||||||
ledgerFilePathFromOpts,
|
ledgerFilePathFromOpts,
|
||||||
@ -29,9 +29,19 @@ defaultcmd = "register"
|
|||||||
defaultfile = "~/.ledger"
|
defaultfile = "~/.ledger"
|
||||||
fileenvvar = "LEDGER"
|
fileenvvar = "LEDGER"
|
||||||
|
|
||||||
usage = usageInfo usagehdr options
|
-- | Command-line options we accept.
|
||||||
|
options :: [OptDescr Opt]
|
||||||
|
options = [
|
||||||
|
Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input",
|
||||||
|
Option ['b'] ["begin"] (ReqArg Begin "yyyy/mm/dd") "report on entries from this date (inclusive)",
|
||||||
|
Option ['e'] ["end"] (ReqArg End "yyyy/mm/dd") "report on entries to this date (exclusive)",
|
||||||
|
Option ['s'] ["showsubs"] (NoArg ShowSubs) "balance report: show subaccounts",
|
||||||
|
Option ['h'] ["help","usage"] (NoArg Help) "show this help"
|
||||||
|
--Option ['V'] ["version"] (NoArg Version) "show version"
|
||||||
|
]
|
||||||
|
|
||||||
data Flag =
|
-- | An option value from a command-line flag.
|
||||||
|
data Opt =
|
||||||
File String |
|
File String |
|
||||||
Begin String |
|
Begin String |
|
||||||
End String |
|
End String |
|
||||||
@ -40,19 +50,11 @@ data Flag =
|
|||||||
Version
|
Version
|
||||||
deriving (Show,Eq)
|
deriving (Show,Eq)
|
||||||
|
|
||||||
options :: [OptDescr Flag]
|
usage = usageInfo usagehdr options
|
||||||
options = [
|
|
||||||
Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input",
|
|
||||||
Option ['b'] [] (ReqArg Begin "BEGINDATE") "begin reports from this date (inclusive)",
|
|
||||||
Option ['e'] [] (ReqArg End "ENDDATE") "end reports on this date (exclusive)",
|
|
||||||
Option ['s'] ["showsubs"] (NoArg ShowSubs) "balance report: show subaccounts",
|
|
||||||
Option ['h'] ["help"] (NoArg Help) "show this help"
|
|
||||||
--Option ['V'] ["version"] (NoArg Version) "show version"
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | Parse the command-line arguments into ledger options, ledger command
|
-- | Parse the command-line arguments into ledger options, ledger command
|
||||||
-- name, and ledger command arguments
|
-- name, and ledger command arguments
|
||||||
parseArguments :: IO ([Flag], String, [String])
|
parseArguments :: IO ([Opt], String, [String])
|
||||||
parseArguments = do
|
parseArguments = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
case (getOpt RequireOrder options args) of
|
case (getOpt RequireOrder options args) of
|
||||||
@ -61,7 +63,7 @@ parseArguments = do
|
|||||||
(_,_,errs) -> ioError (userError (concat errs ++ usage))
|
(_,_,errs) -> ioError (userError (concat errs ++ usage))
|
||||||
|
|
||||||
-- | Get the ledger file path from options, an environment variable, or a default
|
-- | Get the ledger file path from options, an environment variable, or a default
|
||||||
ledgerFilePathFromOpts :: [Flag] -> IO String
|
ledgerFilePathFromOpts :: [Opt] -> IO String
|
||||||
ledgerFilePathFromOpts opts = do
|
ledgerFilePathFromOpts opts = do
|
||||||
envordefault <- getEnv fileenvvar `catch` \_ -> return defaultfile
|
envordefault <- getEnv fileenvvar `catch` \_ -> return defaultfile
|
||||||
paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts)
|
paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts)
|
||||||
@ -82,7 +84,7 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
|
|||||||
tildeExpand xs = return xs
|
tildeExpand xs = return xs
|
||||||
|
|
||||||
-- | get the value of the begin date option, or a default
|
-- | get the value of the begin date option, or a default
|
||||||
beginDateFromOpts :: [Flag] -> String
|
beginDateFromOpts :: [Opt] -> String
|
||||||
beginDateFromOpts opts =
|
beginDateFromOpts opts =
|
||||||
case beginopts of
|
case beginopts of
|
||||||
(x:_) -> last beginopts
|
(x:_) -> last beginopts
|
||||||
@ -94,7 +96,7 @@ beginDateFromOpts opts =
|
|||||||
defaultdate = ""
|
defaultdate = ""
|
||||||
|
|
||||||
-- | get the value of the end date option, or a default
|
-- | get the value of the end date option, or a default
|
||||||
endDateFromOpts :: [Flag] -> String
|
endDateFromOpts :: [Opt] -> String
|
||||||
endDateFromOpts opts =
|
endDateFromOpts opts =
|
||||||
case endopts of
|
case endopts of
|
||||||
(x:_) -> last endopts
|
(x:_) -> last endopts
|
||||||
|
|||||||
@ -54,7 +54,7 @@ main = do
|
|||||||
| cmd `isPrefixOf` "balance" = balance opts args
|
| cmd `isPrefixOf` "balance" = balance opts args
|
||||||
| otherwise = putStr usage
|
| otherwise = putStr usage
|
||||||
|
|
||||||
type Command = [Flag] -> [String] -> IO ()
|
type Command = [Opt] -> [String] -> IO ()
|
||||||
|
|
||||||
selftest :: Command
|
selftest :: Command
|
||||||
selftest _ _ = do
|
selftest _ _ = do
|
||||||
@ -83,7 +83,7 @@ balance opts args = parseLedgerAndDo opts args printbalance
|
|||||||
|
|
||||||
-- | parse the user's specified ledger file and do some action with it
|
-- | parse the user's specified ledger file and do some action with it
|
||||||
-- (or report a parse error). This function makes the whole thing go.
|
-- (or report a parse error). This function makes the whole thing go.
|
||||||
parseLedgerAndDo :: [Flag] -> [String] -> (Ledger -> IO ()) -> IO ()
|
parseLedgerAndDo :: [Opt] -> [String] -> (Ledger -> IO ()) -> IO ()
|
||||||
parseLedgerAndDo opts args cmd = do
|
parseLedgerAndDo opts args cmd = do
|
||||||
parsed <- ledgerFilePathFromOpts opts >>= parseLedgerFile
|
parsed <- ledgerFilePathFromOpts opts >>= parseLedgerFile
|
||||||
case parsed of Left err -> parseError err
|
case parsed of Left err -> parseError err
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user