module Main () where

import System.IO
import System.Environment

data Config = Config
  {
    switch_b, switch_E, switch_n, switch_s, switch_T, switch_v :: Bool,
    msg_help, msg_version :: Bool
  }

default_config = Config
  {
    switch_b = False,
    switch_E = False,
    switch_n = False,
    switch_s = False,
    switch_T = False,
    switch_v = False,
    msg_help = False,
    msg_version = False
  }

main = do
  hSetBinaryMode stdin  True
  hSetBinaryMode stdout True

  args <- getArgs
  process_args args default_config

process_args []         config = run config []
process_args (arg:args) config =
  case arg of
    ('-':[]    ) -> run config ("-":args)
    ('-':'-':[]) -> run config (    args)
    ('-':'-':cs) -> process_args args (process_opt      cs config)
    ('-':cs    ) -> process_args args (process_switches cs config)
    _            -> run config (arg:args)

process_opt cs config =
  case cs of
    "show-all"         -> process_switches "vET" config
    "number-nonblank"  -> config {switch_b = True}
    "show-ends"        -> config {switch_E = True}
    "number"           -> config {switch_n = True}
    "squeeze-blank"    -> config {switch_s = True}
    "show-tabs"        -> config {switch_T = True}
    "show-nonprinting" -> config {switch_v = True}
    "help"             -> config {msg_help = True}
    "version"          -> config {msg_version = True}
    _                  -> error $ "unknown option: --" ++ cs

process_switches []     config = config
process_switches (c:cs) config =
  case c of
    'A' -> process_switches ("vET" ++ cs) $ config
    'b' -> process_switches (         cs) $ config {switch_b = True}
    'e' -> process_switches ("vE"  ++ cs) $ config
    'E' -> process_switches (         cs) $ config {switch_E = True}
    'n' -> process_switches (         cs) $ config {switch_n = True}
    's' -> process_switches (         cs) $ config {switch_s = True}
    't' -> process_switches ("vT"  ++ cs) config
    'T' -> process_switches (         cs) $ config {switch_T = True}
    'u' -> process_switches (         cs) $ config
    'v' -> process_switches (         cs) $ config {switch_v = True}
    _   -> error $ "unknown switch: -" ++ [c]

run config _ | msg_help    config = print_help
run config _ | msg_version config = print_version
run config [] = run config ["-"]
run config fs = do
  xs <- mapM process_file fs
  putStr $ process_out config $ concat $ xs

print_help = mapM_ putStrLn
  [
    "Usage:",
    "  cat [option] [file]..."
  ]

print_version = putStrLn "cat (Haskell 98) 1.1.1"

process_file "-" = getContents
process_file f   = do
  h <- openFile f ReadMode
  hSetBinaryMode h True
  txt <- hGetContents h
  return txt

process_out config =
  (if switch_v config then show_nonprint else id) .
  (if switch_E config then show_ends     else id) .
  (if switch_T config then show_tabs     else id) .
  (if switch_n config then number_all    else (if switch_b config then number_nonblank else id)) .
  (if switch_s config then squeeze       else id)

squeeze []                                       = []
squeeze ('\r':'\n' : '\r':'\n' : '\r':'\n' : cs) =     squeeze ('\r':'\n' : '\r':'\n' : cs)
squeeze (     '\n' :      '\n' :      '\n' : cs) =     squeeze (     '\n' :      '\n' : cs)
squeeze (                                c : cs) = c : squeeze (                        cs)

number_all =
  unlines .
  zipWith (\ n t -> show n ++ t) [1..] .
  lines

number_nonblank =
    unlines .
    number 1 .
    lines
  where
    number _ []        = []
    number n (""   : ts) = ""            : number (n  ) ts
    number n ("\r" : ts) = ""            : number (n  ) ts
    number n (t    : ts) = (show n ++ t) : number (n+1) ts

show_tabs []        = []
show_tabs ('\t':cs) = '^' : 'I' : show_tabs cs
show_tabs ( c  :cs) = c         : show_tabs cs

show_ends []             = []
show_ends ('\r':'\n':cs) = '$':'\r':'\n' : show_ends cs
show_ends (     '\n':cs) = '$':     '\n' : show_ends cs
show_ends (        c:cs) = c             : show_ends cs

show_nonprint []        = []
show_nonprint ('\n':cs) = '\n' : show_nonprint cs
show_nonprint ('\t':cs) = '\t' : show_nonprint cs
show_nonprint (   c:cs)
  | c < ' '   = '^' : toEnum (fromEnum c + 64) : show_nonprint cs
  | otherwise =                              c : show_nonprint cs