hledger/Options.hs

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