またHaskell

Haskellは楽しいのう。これまた「Haskellでネットワークプログラミング」のパクリなんだけど、まあ、ええ。GetOptの勉強のためにつくりました。runhugsで動きます。すんげー不細工だけど、何か。

#!/usr/bin/runhugs

module Main where

import Char (isSpace)
import Data.Maybe (fromMaybe, fromJust)
import List (elemIndex)
import System
import System.Console.GetOpt

data Flag = Usage | Version | Config String deriving (Show,Eq)

options :: [OptDescr Flag]
options =
    [ Option ['h'] ["usage"]   (NoArg Usage)          "show usage"
     ,Option ['v'] ["version"] (NoArg Version)        "show version number"
     ,Option ['c'] ["config"]  (OptArg conf "FILE")   "config FILE"
    ]

conf  = Config  . fromMaybe defaultConfig

defaultConfig  = "default.conf"

version = "0.0.1"

usage = usageInfo "Usage: runhugs Opts.hs [OPTION...] [files...]" options

compilerOpts :: [String] -> IO ([Flag],[String])
compilerOpts argv =
    case getOpt Permute options argv of
        (o,n,[])   -> return (o,n)
        (_,_,errs) -> ioError (userError (concat errs ++ usage))

dispatch :: ([Flag],[String]) -> IO (String)
dispatch (os,ns) =
    case os of
        Usage:_    -> return usage
        Version:_  -> return $ "Opts.hs ver." ++ version
        Config c:_ -> return $ if isSpaces ns then defaultConfig else config c
        []         -> return defaultConfig
    where
        isSpaces ns = and $ map isSpaces' ns
        isSpaces' s = and $ map isSpace s
        config c = ns !! (fromJust $ elemIndex (Config c) os)

main :: IO ()
main = do { str <- dispatch =<< compilerOpts =<< getArgs
            ;putStrLn str
          }