コマンドラインオプションの解析(ちょー簡易版getopts)

GHCに添付のDistribution.GetOptはそれはそれは便利なんですが、いちいち型を作らないといけないのでちょっとしたプログラムには面倒だなーと思いました。で、ちょー簡易版getoptsを作ってみました。オプションに引数をつける場合(-o hogeとか)には対応してません。--でオプションとそれ以外を分離するのには、それなりに対応しています。
ファイル: a.hs

import Control.Monad (when)
import Data.List (isPrefixOf)
import System.Environment (getArgs, getProgName)
import System.Exit (exitWith, ExitCode(ExitFailure))
import System.IO (stderr, hPutStrLn)

main = do
  (opts, rests) <- parseOpts . getOpts =<< getArgs
  putStrLn $ "opts:  " ++ show opts
  putStrLn $ "rests: " ++ show rests
  where
    parseOpts :: ([String], [String]) -> IO ([String], [String])
    parseOpts (os, rs) = do
      when ("h" `elem` os) $ usage
      when ("v" `elem` os) $ version
      return (os, rs)
    
    usage :: IO ()
    usage = do
      prog <- getProgName
      hPutStrLn stderr $ "usage: " ++ prog ++ " [opts] [files]"
      exitWith (ExitFailure 1)
    
    version :: IO ()
    version = do
      prog <- getProgName
      hPutStrLn stderr $ prog ++ " - 0.1a"
      exitWith (ExitFailure 1)
    
    getOpts :: [String] -> ([String], [String])
    getOpts args = 
      let (os1, rs1) = span (/= "--") args
          (os2, rs2) = span (isPrefixOf "-") os1
          os3        = map tail os2
          rs3        = if (null rs2 && (not $ null rs1) && (rs1 !! 0 == "--"))
                         then tail rs1
                         else rs2 ++ rs1
      in (os3, rs3)

-- Local Variables:
-- compile-command: "ghc -W -fno-warn-unused-matches --make -o a a"
-- End:

実行例:

$ ./a -h
usage: a.exe [opts] [files]
$ ./a -v
a.exe - 0.1a
$ ./a -a -b -c d e
opts:  ["a","b","c"]
rests: ["d","e"]
$ ./a -a -b -- -c d e
opts:  ["a","b"]
rests: ["-c","d","e"]

うーむ。やっぱりコマンドラインオプションの解析は泥臭いです。