DouKaku? 7613 M.Suzuki: 少々無理矢理な感じです。。。Parsec...(起動オプションの解析)

Comment detail

少々無理矢理な感じです。。。Parsecが使えたらもっと楽なのでしょうね(^^;

data Args = Args {
    outputFlag :: Bool,
    quoteFlag :: Bool,
    debugLevel :: Int,
    names :: [String]
} deriving (Show)

newArgs =   Args {
        outputFlag = False,
        quoteFlag = False,
        debugLevel = 0,
        names = []
    }

parse [] result = result

parse (arg:args) result
    | arg == "-d"       = parse (tail args) result{ debugLevel = read $ head args }
    | opt == "-d"       = parse args result{ debugLevel = read num }
    | (head arg) == '-' = parse args $ parse' (tail arg) result
    | otherwise         = parse args result{ names = (names result) ++ [arg] }
    where
        (opt,num) = splitAt 2 arg
        parse' [] res = res
        parse' ('o':xs) res = parse' xs res{ outputFlag = True }
        parse' ('q':xs) res = parse' xs res{ quoteFlag = True }
        parse' _ _ =    error $ arg ++ " is unknown option."

optParse :: [String] -> Args
optParse args
    | (outputFlag result) == False  =   error "-o is need option."
    | (names result) == []  =   error "need file name."
    | otherwise     =   result
    where
        result = parse args newArgs

dump args = do
    putStrLn "[Option information]"
    putStrLn $ "o(output) : " ++ (onoff $ outputFlag args)
    putStrLn $ "q(quote) : " ++ (onoff $ quoteFlag args)
    putStrLn $ "d(debug) : " ++ (show $ debugLevel args)
    putStrLn ""
    putStrLn "[Paramater information]"
    putStrLn $ "count : " ++ (show $ length $ names args)
    mapM (\(no,name)->putStrLn $ (show no) ++ " : " ++ name) $ zip [1,2..] $ names args
    putStrLn ""
    where
        onoff True = "ON"
        onoff _ = "OFF"

main = do
    args <- getArgs
    dump $ optParse args
{--
    mapM_ test testData
    mapM_ dumps testData
    where
        dumps arg = dump $ optParse arg
        test arg = putStrLn $ show $ optParse arg
        testData = map words ["-o AAA",
                    "-o AAA BBB CCC",
                    "-oq AAA",
                    "-o -q AAA",
                    "-o -d1 AAA",
                    "-o -d 1 AAA",
                    "-q -d2 -o AAA"]
--}

System.Console.GetOpt を使う方法もあります。ロングオプションにも対応しています。

でもあんまりすっきりとはいかない感じです。:<

module Main where

import System.Console.GetOpt
import System.Environment

main :: IO ()
main = getArgs >>= compilerOpts >>= cmdopt

data Options = Options 
    { optOutput :: Bool
    , optQuote  :: Bool
    , optDebug  :: Int
    }

defaultOptions = Options
    { optOutput = False
    , optQuote  = False
    , optDebug  = 0
    }

options :: [OptDescr (Options -> Options)]
options =
 [ Option ['o'] ["output"]
   (NoArg (\ opts -> opts { optOutput = True }))
   "Output option"
 , Option ['q'] ["quote"]
   (NoArg (\ opts -> opts { optQuote  = True }))
   "Quote option"
 , Option ['d'] ["debug"]
   (ReqArg (\ d opts -> opts { optDebug = read d }) "LEVEL")
   "debug LEVEL"
 ]

compilerOpts :: [String] -> IO (Options, [String])
compilerOpts argv
 = case getOpt Permute options argv of
     (o,n,[])  -> return (foldl (flip id) defaultOptions o, n)
     (_,_,ers) -> ioError (userError (concat ers ++ usageInfo usageHeader options))

usageHeader = "Usage: cmdopt -o [-q] [-d {0|1|2}] STR [STR ...]"

cmdopt :: (Options,[String]) -> IO ()
cmdopt (o,xs@(_:_))
 | optOutput o = putStr $ unlines 
               $ ["[Option Info]"
                 ,"o(output): "++"ON"
                 ,"q(quote) : "++if optQuote o then "ON" else "OFF"
                 ,"d(debug) : "++show (optDebug o)
                 ,"[Parameter Info]"
                 ,show len ++ " parameter"++if len >1 then "s " else " " ++"specified"
                 ] 
               ++ map showParam (zip [1..] xs)
    where len = length xs
cmdopt _       = ioError (userError (usageInfo usageHeader options))

showParam :: (Int,String) -> String
showParam (n,s) = show n ++": "++s

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq