1 module CommandLine (parse_cmds) where
    2 -- Copyright 1994 by Peter Thiemann
    3 
    4 import System--1.3
    5 import IO--1.3
    6 
    7 defaultArgs :: Args
    8 defaultArgs  =  MkArgs "Times-Roman" 10 "black" "Times-Roman" 10 "black" "black" "black" 500 500 30 100 200 "rgb.txt" False False True False False False
    9 
   10 usage :: IO ()
   11 usage  =  hPutStr stderr "Usage: prog [-ntFont String] [-ntScale Int] [-ntColor String] [-tFont String] [-tScale Int] [-tColor String] [-lineColor String] [-fatLineColor String] [-borderDistX Int] [-borderDistY Int] [-lineWidth Int] [-fatLineWidth Int] [-arrowSize Int] [-rgbFileName String] [-happy] [(+|-)simplify] [(+|-)ps] [(+|-)fig] [-help] [-verbose]"
   12 
   13 data Args  =  MkArgs String Int String String Int String String String Int Int Int Int Int String Bool Bool Bool Bool Bool Bool deriving ()
   14 type ProgType = String -> Int -> String -> String -> Int -> String -> String -> String -> Int -> Int -> Int -> Int -> Int -> String -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> [String] -> IO ()
   15 
   16 parse_args :: ProgType -> Args -> [String] -> IO ()
   17 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-ntFont":rest)
   18     =  readstring (\str -> parse_args prog (MkArgs str x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   19 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-ntScale":rest)
   20     =  readval reads (\val -> parse_args prog (MkArgs x1 val x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   21 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-ntColor":rest)
   22     =  readstring (\str -> parse_args prog (MkArgs x1 x2 str x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   23 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-tFont":rest)
   24     =  readstring (\str -> parse_args prog (MkArgs x1 x2 x3 str x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   25 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-tScale":rest)
   26     =  readval reads (\val -> parse_args prog (MkArgs x1 x2 x3 x4 val x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   27 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-tColor":rest)
   28     =  readstring (\str -> parse_args prog (MkArgs x1 x2 x3 x4 x5 str x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   29 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-lineColor":rest)
   30     =  readstring (\str -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 str x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   31 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-fatLineColor":rest)
   32     =  readstring (\str -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 str x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   33 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-borderDistX":rest)
   34     =  readval reads (\val -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 val x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   35 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-borderDistY":rest)
   36     =  readval reads (\val -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 val x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   37 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-lineWidth":rest)
   38     =  readval reads (\val -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 val x12 x13 x14 x15 x16 x17 x18 x19 x20)) rest
   39 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-fatLineWidth":rest)
   40     =  readval reads (\val -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 val x13 x14 x15 x16 x17 x18 x19 x20)) rest
   41 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-arrowSize":rest)
   42     =  readval reads (\val -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 val x14 x15 x16 x17 x18 x19 x20)) rest
   43 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-rgbFileName":rest)
   44     =  readstring (\str -> parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 str x15 x16 x17 x18 x19 x20)) rest
   45 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-happy":rest)
   46     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 True x16 x17 x18 x19 x20)) rest
   47 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-simplify":rest)
   48     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 False x17 x18 x19 x20)) rest
   49 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("+simplify":rest)
   50     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 True x17 x18 x19 x20)) rest
   51 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-ps":rest)
   52     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 False x18 x19 x20)) rest
   53 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("+ps":rest)
   54     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 True x18 x19 x20)) rest
   55 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-fig":rest)
   56     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 False x19 x20)) rest
   57 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("+fig":rest)
   58     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 True x19 x20)) rest
   59 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-help":rest)
   60     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 True x20)) rest
   61 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) ("-verbose":rest)
   62     =  readbool (parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 True)) rest
   63 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) (('-': _) :rest)
   64     =  usage
   65 parse_args prog (MkArgs x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20)  rest  =  prog x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 rest
   66 
   67 parse_cmds :: ProgType -> IO ()
   68 parse_cmds prog =  getArgs >>= parse_args prog defaultArgs
   69 
   70 readbool :: ([String] -> IO ()) -> [String] -> IO ()
   71 readbool f = f
   72 
   73 readstring :: (String -> [String] -> IO ()) -> [String] -> IO ()
   74 readstring f (str: rest) = f str rest
   75 readstring f []          = usage
   76 
   77 readval :: (Read a) => ReadS a -> (a -> [String] -> IO ()) -> [String] -> IO ()
   78 readval readsfn f (str: rest)
   79     =  case readsfn str of
   80            ((val, ""):_) -> f val rest
   81            _             -> usage