Kapitel 6: Programmiertechniken

hugs Cat
ghc -o mycat Cat.lhs

> import Char
> import IO
> import System

> main				:: IO ()
> main                          =  getArgs                      >>= \args ->
>                                  case args of
>                                  ('-' : opts) : args' ->
>                                       sequence_ [ copy opts f  | f <- args' ]
>                                  _ -> sequence_ [ copy ""   f  | f <- args  ]

> (#)				:: (a -> b) -> (b -> c) -> (a -> c)
> f # g                         =  g . f

> type Options                  =  [Char]

> copy                          :: Options -> FilePath -> IO ()
> copy opts f                   =  readFile f                   >>= \cnts ->
>                                  let str = process opts cnts  in
>                                  putStr str

> data Line                     =  Blank String
>                               |  Line  String

> classify                      :: String -> Line
> classify s | all isSpace s    =  Blank s
>            | otherwise        =  Line  s

> unclassify                    :: Line -> String
> unclassify (Blank s)          =  s
> unclassify (Line s)           =  s

> squeeze                       :: [Line] -> [Line]
> squeeze []                    =  []
> squeeze(Blank _:x@(Blank _:_))=  squeeze x
> squeeze (a:x)                 =  a:squeeze x

> number                        :: Int -> [String] -> [String]
> number n                      =  zip [ n .. ] # map lineno

> bnumber                       :: Int -> [Line] -> [Line]
> bnumber n []                  =  []
> bnumber n (Blank s : x)       =  Blank (indent s)      : bnumber n x
> bnumber n (Line s  : x)       =  Line  (lineno (n, s)) : bnumber (n + 1) x

> indent                        :: String -> String
> indent s                      =  replicate 8 ' ' ++ s

> lineno                        :: (Int, String) -> String
> lineno (n, s)                 =  rjustify 6 (show n) ++ "  " ++ s

> process                       :: Options -> String -> String
> process opts                  =           lines
>                               #           map classify
>                               #  when 's' squeeze
>                               #  when 'b' (bnumber 1)
>                               #           map unclassify
>                               #  when 'n' (number 1)
>                               #  when 'e' (map (++ "$"))
>                               #           unlines
>                               #  when 't' (concatMap showTab)
>                               #  when 'v' (concatMap showNonPrinting)
>     where when c f            =  if c `elem` opts then f else id

> showTab                       :: Char -> String
> showTab c | c == '\t'         =  "^I"
>           | otherwise         =  [c]

> showNonPrinting               :: Char -> String
> showNonPrinting c
>     | c == '\n'		=  [c]
>     | ord c == 127		=  "^?"
>     | ord c >= 128		=  "M-" ++ showNonPrinting (chr (ord c - 128))
>     | isPrint c		=  [c]
>     | otherwise		=  "^" ++ [chr (ord c + 64)]

> rjustify                      :: Int -> String -> String
> rjustify n s                  =  replicate (n - length s) ' ' ++ s