option processing

This commit is contained in:
Simon Michael 2007-01-30 09:07:12 +00:00
parent d0cf8f8840
commit a316e901e7
2 changed files with 36 additions and 1 deletions

25
Options.hs Normal file
View File

@ -0,0 +1,25 @@
module Options where
import System.Console.GetOpt
import Data.Maybe ( fromMaybe )
data Flag = File String | Version deriving Show
options :: [OptDescr Flag]
options = [
Option ['f'] ["file"] (OptArg inp "FILE") "ledger file, or - to read stdin"
, Option ['v'] ["version"] (NoArg Version) "show version number"
]
inp :: Maybe String -> Flag
inp = File . fromMaybe "stdin"
getOptions :: [String] -> IO ([Flag], [String])
getOptions argv =
case getOpt Permute options argv of
(o,n,[] ) -> return (o,n)
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
where header = "Usage: hledger [OPTIONS]"
get_content :: Flag -> Maybe String
get_content (File s) = Just s

View File

@ -1,3 +1,4 @@
#!/usr/bin/runhaskell
-- hledger - ledger-compatible money management utilities -- hledger - ledger-compatible money management utilities
-- GPLv3, (c) Simon Michael & contributors, -- GPLv3, (c) Simon Michael & contributors,
-- ledger is at http://newartisans.com/ledger.html -- ledger is at http://newartisans.com/ledger.html
@ -104,6 +105,7 @@ import Test.QuickCheck
import Test.HUnit import Test.HUnit
--import TildeExpand -- confuses my ghc 6.7 --import TildeExpand -- confuses my ghc 6.7
import System (getArgs)
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.Environment (getEnv) import System.Environment (getEnv)
import Control.Exception (assert) import Control.Exception (assert)
@ -112,6 +114,8 @@ import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language import Text.ParserCombinators.Parsec.Language
import Text.Printf import Text.Printf
import Options
-- sample data -- sample data
sample_entry = "\ sample_entry = "\
@ -454,4 +458,10 @@ register = do
Left err -> do putStr "ledger parse error at "; print err Left err -> do putStr "ledger parse error at "; print err
Right l -> putStr $ showLedger l Right l -> putStr $ showLedger l
main = do register main = do
(opts, args) <- getArgs >>= getOptions
putStr "options: "; print opts
putStr "arguments: "; print args
if "reg" `elem` args
then register
else return ()