catコマンドを実装してみました

catコマンドです。ファイルの内容を表示するときなどに使用します。System.Console.GetOptを使ってコマンドラインオプションの解析を行っています。あ、でもまとも実装しているのは-nだけですが…
ファイル: cat.hs

import System
import System.Exit
import System.Console.GetOpt
import Control.Monad
import Data.List

data Flag = Help | Version | Number deriving (Show, Eq)

options :: [OptDescr Flag]
options = 
    [ Option ['h'] ["help"]    (NoArg Help)    
                 "display this help and exit.",
      Option [] ["version"] (NoArg Version)
                 "output version information and exit.", 
      Option ['n'] ["number"]  (NoArg Number)
                 "number all output lines."
    ]

getOption :: [Flag] -> Flag -> Maybe Flag
getOption flags flag = find (\f -> f == flag) flags

usageMassage :: String
usageMassage = usageInfo "usage: cat [OPTION...] files..." options

usage :: IO ()
usage = do putStrLn usageMassage
           exitWith ExitSuccess

version = do putStrLn "cat - 0.1a"
             exitWith ExitSuccess

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

main :: IO ()
main = do (flags, files) <- parseOptions =<< getArgs
          when (getOption flags Help    /= Nothing) $ usage
          when (getOption flags Version /= Nothing) $ version
          if null files
              then catFromStdin flags
              else catFromFiles flags files

catFromStdin :: [Flag] -> IO ()
catFromStdin flags = cat flags =<< getContents

catFromFiles :: [Flag] -> [String] -> IO ()
catFromFiles flags = mapM_ (\file -> cat flags =<< readFile file)

cat :: [Flag] -> String -> IO ()
cat flags = let filter = if (getOption flags Number /= Nothing)
                             then numberingFilter
                             else nullFilter
            in putStr . filter

nullFilter :: String -> String
nullFilter s = s

numberingFilter :: String -> String
numberingFilter = unlines . map format . zip [1..] . lines
                  where
                    format :: (Int, String) -> String
                    format (n, line) = rjust 6 (show n) ++ "  " ++ line
                         
                    rjust :: Int -> String -> String
                    rjust width s = replicate (width - length s) ' ' ++ s

以下、実行例です。

$ ./cat.exe -n Makefile
     1  TARGETS = cat
     2
     3  HC      = ghc
     4  HCFLAGS = -W -fno-warn-unused-matches
     5
     6  .SUFFIXES:
     7  .SUFFIXES: .hs
     8  .hs:
     9          $(HC) $(HCFLAGS) $< -o $@
    10
    11  all: $(TARGETS)
    12
    13  clean:
    14          rm -f $(TARGETS) *.o *.hi *.exe

参考: catn.hs http://madscientist.jp/~ikegami/diary/20050728.html#p01