module Options (parseOptions, parsePatternArgs, wildcard, Flag(..), usage, ledgerFilePath, parseLedgerAndDo) where 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" options :: [OptDescr Flag] options = [ Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input", Option ['s'] ["showsubs"] (NoArg ShowSubs) "balance report: show subaccounts", -- register: show subtotals Option ['h'] ["help"] (NoArg Help) "show this help" --Option ['V'] ["version"] (NoArg Version) "show version" ] data Flag = File String | ShowSubs | Help | Version deriving (Show,Eq) parseOptions :: [String] -> IO ([Flag], [String]) parseOptions argv = case getOpt RequireOrder options argv of (opts,[],[]) -> return (opts, [defaultcmd]) (opts,args,[]) -> return (opts, args) (_,_,errs) -> ioError (userError (concat errs ++ usage)) -- 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 usage = usageInfo usagehdr options ledgerFilePath :: [Flag] -> IO String ledgerFilePath = findFileFromOpts "~/ledger.dat" "LEDGER" -- | find a file path from options, an env var or a default value findFileFromOpts :: FilePath -> String -> [Flag] -> IO String findFileFromOpts defaultpath envvar opts = do envordefault <- getEnv envvar `catch` \_ -> return defaultpath paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts) return $ last paths where getfile (File s) = [s] getfile _ = [] tildeExpand :: FilePath -> IO FilePath tildeExpand ('~':[]) = getHomeDirectory tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs)) -- -- ~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 -- -- courtesy of allberry_b -- | ledger pattern arguments are: 0 or more account patterns -- optionally followed by -- and 0 or more description patterns. -- No arguments implies match all. We convert the arguments to -- a pair of regexps. parsePatternArgs :: [String] -> (Regex,Regex) parsePatternArgs args = (regexFor as, regexFor 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 $ "(" ++ (unwords $ intersperse "|" ss) ++ ")" wildcard :: Regex wildcard = mkRegex ".*" -- | parse the user's specified ledger file and do some action with it -- (or report a parse error) parseLedgerAndDo :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () parseLedgerAndDo opts pats cmd = do path <- ledgerFilePath opts parsed <- parseLedgerFile path case parsed of Left err -> parseError err Right l -> cmd $ cacheLedger l pats