hledger/Options.hs

89 lines
3.1 KiB
Haskell

module Options
where
import System.Console.GetOpt
import System.Directory
import System.Environment (getEnv)
import Data.Maybe (fromMaybe)
import Utils
import Types
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 args are 0 or more account patterns optionally followed
-- by -- and 0 or more description patterns
parsePatternArgs :: [String] -> FilterPatterns
parsePatternArgs args = argpats as ds'
where (as, ds) = break (=="--") args
ds' = dropWhile (=="--") ds
argpats :: [String] -> [String] -> FilterPatterns
argpats as ds = (regexify as, regexify ds)
where
regexify :: [String] -> Maybe Regex
regexify [] = Nothing
regexify ss = Just $ mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")"