fix -f option
This commit is contained in:
parent
1322bcb4a0
commit
5475a3868c
41
Options.hs
41
Options.hs
@ -8,36 +8,35 @@ import Data.Maybe (fromMaybe)
|
|||||||
import Utils
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
data Flag = Version | File String | ShowSubs
|
usageHeader = "Usage: hledger [OPTIONS] register|balance [MATCHARGS]"
|
||||||
deriving (Show,Eq)
|
|
||||||
|
|
||||||
options :: [OptDescr Flag]
|
|
||||||
options = [
|
|
||||||
Option ['v'] ["version"] (NoArg Version) "show version number"
|
|
||||||
, Option ['f'] ["file"] (OptArg inp "FILE") "ledger file, or - to read stdin"
|
|
||||||
, Option ['s'] ["subtotal"] (NoArg ShowSubs) "balance: show sub-accounts" --; register: show subtotals"
|
|
||||||
]
|
|
||||||
|
|
||||||
inp :: Maybe String -> Flag
|
|
||||||
inp = File . fromMaybe "stdin"
|
|
||||||
|
|
||||||
getOptions :: [String] -> IO ([Flag], [String])
|
getOptions :: [String] -> IO ([Flag], [String])
|
||||||
getOptions argv =
|
getOptions argv =
|
||||||
case getOpt RequireOrder options argv of
|
case getOpt RequireOrder options argv of
|
||||||
(o,n,[] ) -> return (o,n)
|
(o,n,[] ) -> return (o,n)
|
||||||
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options))
|
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options))
|
||||||
|
|
||||||
usageHeader = "Usage: hledger [OPTIONS] register|balance [MATCHARGS]"
|
options :: [OptDescr Flag]
|
||||||
|
options = [
|
||||||
|
Option ['v'] ["version"] (NoArg Version) "show version number"
|
||||||
|
, Option ['f'] ["file"] (OptArg readFileOpt "FILE") "ledger file, or - to read stdin"
|
||||||
|
, Option ['s'] ["subtotal"] (NoArg ShowSubs) "balance: show sub-accounts" --; register: show subtotals"
|
||||||
|
]
|
||||||
|
|
||||||
get_content :: Flag -> Maybe String
|
data Flag = Version | File String | ShowSubs deriving (Show,Eq)
|
||||||
get_content (File s) = Just s
|
|
||||||
|
readFileOpt :: Maybe String -> Flag
|
||||||
|
readFileOpt = File . fromMaybe "stdin"
|
||||||
|
|
||||||
|
getFile :: Flag -> String
|
||||||
|
getFile (File s) = s
|
||||||
|
getFile _ = []
|
||||||
|
|
||||||
defaultLedgerFile = "~/ledger.dat"
|
getLedgerFilePath :: [Flag] -> IO String
|
||||||
|
getLedgerFilePath opts = do
|
||||||
getLedgerFilePath :: IO String
|
defaultpath <- tildeExpand "~/ledger.dat"
|
||||||
getLedgerFilePath = do
|
envordefault <- getEnv "LEDGER" `catch` \_ -> return defaultpath
|
||||||
defaultpath <- tildeExpand defaultLedgerFile
|
return $ last $ [envordefault] ++ (filter (/= "") (map getFile opts))
|
||||||
getEnv "LEDGER" `catch` \_ -> return defaultpath >>= return
|
|
||||||
|
|
||||||
-- ledger pattern args are a list of account patterns optionally followed
|
-- ledger pattern args are a list of account patterns optionally followed
|
||||||
-- by -- and a list of description patterns
|
-- by -- and a list of description patterns
|
||||||
|
|||||||
@ -42,11 +42,11 @@ test = do
|
|||||||
|
|
||||||
register :: [Flag] -> [String] -> IO ()
|
register :: [Flag] -> [String] -> IO ()
|
||||||
register opts args = do
|
register opts args = do
|
||||||
getLedgerFilePath >>= parseLedgerFile >>= doWithParsed (printRegister opts args)
|
getLedgerFilePath opts >>= parseLedgerFile >>= doWithParsed (printRegister opts args)
|
||||||
|
|
||||||
balance :: [Flag] -> [String] -> IO ()
|
balance :: [Flag] -> [String] -> IO ()
|
||||||
balance opts args = do
|
balance opts args = do
|
||||||
getLedgerFilePath >>= parseLedgerFile >>= doWithParsed (printBalance opts args)
|
getLedgerFilePath opts >>= parseLedgerFile >>= doWithParsed (printBalance opts args)
|
||||||
|
|
||||||
-- utils
|
-- utils
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user