139 lines
4.4 KiB
Haskell
139 lines
4.4 KiB
Haskell
module Options (
|
|
Flag(..),
|
|
usage,
|
|
parseArguments,
|
|
ledgerFilePathFromOpts,
|
|
beginDateFromOpts,
|
|
endDateFromOpts,
|
|
parsePatternArgs,
|
|
regexFor,
|
|
nullpats,
|
|
wildcard,
|
|
)
|
|
where
|
|
import System
|
|
import System.Console.GetOpt
|
|
import System.Directory
|
|
import System.Environment (getEnv)
|
|
import Data.Maybe (fromMaybe)
|
|
|
|
import Ledger.Utils
|
|
import Ledger.Types
|
|
import Ledger.Parse (parseLedgerFile, parseError)
|
|
import Ledger.Ledger (cacheLedger)
|
|
|
|
|
|
usagehdr = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:"
|
|
commands = "register|balance|print"
|
|
defaultcmd = "register"
|
|
defaultfile = "~/.ledger"
|
|
fileenvvar = "LEDGER"
|
|
|
|
usage = usageInfo usagehdr options
|
|
|
|
data Flag =
|
|
File String |
|
|
Begin String |
|
|
End String |
|
|
ShowSubs |
|
|
Help |
|
|
Version
|
|
deriving (Show,Eq)
|
|
|
|
options :: [OptDescr Flag]
|
|
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
|
|
-- name, and ledger command arguments
|
|
parseArguments :: IO ([Flag], String, [String])
|
|
parseArguments = do
|
|
args <- getArgs
|
|
case (getOpt RequireOrder options args) of
|
|
(opts,[],[]) -> return (opts, defaultcmd, [])
|
|
(opts,cmd:args,[]) -> return (opts, cmd, args)
|
|
(_,_,errs) -> ioError (userError (concat errs ++ usage))
|
|
|
|
-- | Get the ledger file path from options, an environment variable, or a default
|
|
ledgerFilePathFromOpts :: [Flag] -> IO String
|
|
ledgerFilePathFromOpts opts = do
|
|
envordefault <- getEnv fileenvvar `catch` \_ -> return defaultfile
|
|
paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts)
|
|
return $ last paths
|
|
where
|
|
getfile (File s) = [s]
|
|
getfile _ = []
|
|
|
|
-- | Expand ~ in a file path (does not handle ~name).
|
|
tildeExpand :: FilePath -> IO FilePath
|
|
tildeExpand ('~':[]) = getHomeDirectory
|
|
tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
|
|
--handle ~name, requires -fvia-C or ghc 6.8:
|
|
--import System.Posix.User
|
|
-- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs
|
|
-- pw <- getUserEntryForName user
|
|
-- return (homeDirectory pw ++ path)
|
|
tildeExpand xs = return xs
|
|
|
|
-- | get the value of the begin date option, or a default
|
|
beginDateFromOpts :: [Flag] -> String
|
|
beginDateFromOpts opts =
|
|
case beginopts of
|
|
(x:_) -> last beginopts
|
|
_ -> defaultdate
|
|
where
|
|
beginopts = concatMap getbegindate opts
|
|
getbegindate (Begin s) = [s]
|
|
getbegindate _ = []
|
|
defaultdate = ""
|
|
|
|
-- | get the value of the end date option, or a default
|
|
endDateFromOpts :: [Flag] -> String
|
|
endDateFromOpts opts =
|
|
case endopts of
|
|
(x:_) -> last endopts
|
|
_ -> defaultdate
|
|
where
|
|
endopts = concatMap getenddate opts
|
|
getenddate (End s) = [s]
|
|
getenddate _ = []
|
|
defaultdate = ""
|
|
|
|
-- | ledger pattern arguments are: 0 or more account patterns
|
|
-- optionally followed by -- and 0 or more description patterns.
|
|
-- No arguments implies match all. Here we gather these into two lists.
|
|
-- parsePatternArgs :: [String] -> (Regex,Regex)
|
|
parsePatternArgs :: [String] -> ([String],[String])
|
|
parsePatternArgs args = (as, ds')
|
|
where (as, ds) = break (=="--") args
|
|
ds' = dropWhile (=="--") ds
|
|
|
|
-- | convert a list of strings to a regular expression matching any of them,
|
|
-- or a wildcard if there are none.
|
|
regexFor :: [String] -> Regex
|
|
regexFor [] = wildcard
|
|
regexFor ss = mkRegex $ concat $ ["("] ++ (intersperse "|" ss) ++ [")"]
|
|
|
|
wildcard :: Regex
|
|
wildcard = mkRegex ".*"
|
|
|
|
nullpats = (wildcard,wildcard)
|
|
|
|
-- testoptions RequireOrder ["foo","-v"]
|
|
-- testoptions Permute ["foo","-v"]
|
|
-- testoptions (ReturnInOrder Arg) ["foo","-v"]
|
|
-- testoptions Permute ["foo","--","-v"]
|
|
-- testoptions Permute ["-?o","--name","bar","--na=baz"]
|
|
-- testoptions Permute ["--ver","foo"]
|
|
testoptions order cmdline = putStr $
|
|
case getOpt order options cmdline of
|
|
(o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n
|
|
(_,_,errs) -> concat errs ++ usage
|
|
|