1 module Main where
    2 
    3 import GRIP
    4 import PSlib
    5 import Graph
    6 import Parse
    7 import Pool
    8 import Activity
    9 import Spark
   10 --import Prog (prog)
   11 
   12 import System -- 1.3 (partain)
   13 
   14 main = do
   15     str <- getArgs
   16     control (map parseLine (condenseArgs str))
   17 
   18 control args = do
   19     stats <- if from=="stdin" then getContents else readFile from
   20     (if into=="stdout" then putStr else writeFile into) (form (graph stats))
   21   where
   22     form :: (String -> Postscript)
   23     form = if (sizeX==0) then (if (elem G args) then gspostscript else postscript)
   24             else ePostscript (sizeX,sizeY)
   25     graph :: String -> Postscript
   26     graph stats = if (elem P args) then poolGraph processors stats
   27             else if orderSp/=[] then sparkGraph orderSp processors stats 
   28                     else activityGraph orderAct processors stats
   29 
   30     (A orderAct) = lookUp (A defaultAct) args
   31     (S orderSp) = lookUp (S []) args
   32     (E sizeX sizeY) = lookUp (E 0 0) args
   33     (PS processors) = lookUp (PS []) args
   34     (IO (from,into)) = lookUp (IO ("stdin","stdout")) args
   35 
   36 condenseArgs :: [String] -> [String]
   37 condenseArgs [] = []
   38 condenseArgs (arg@('-':_):more) = arg:condenseArgs more
   39 condenseArgs [a,b] = [a++" "++b]
   40 condenseArgs a = a
   41 
   42         
   43 lookUp :: Args -> [Args] -> Args
   44 lookUp a [] = a
   45 lookUp a (b:bs) | a==b = b
   46                 | otherwise = lookUp a bs
   47 
   48 data Args = A [Activity]
   49           | S [Spark]
   50           | P
   51           | E Int Int
   52           | F
   53           | G
   54           | PS [PElement]
   55           | IO (String,String) 
   56 
   57 instance Eq Args where
   58         (==) (A _) (A _) = True
   59         (==) (S _) (S _) = True
   60         (==) P P = True
   61         (==) (E _ _) (E _ _) = True
   62         (==) F F = True
   63         (==) G G = True
   64         (==) (PS _) (PS _) = True
   65         (==) (IO _) (IO _) = True
   66         (==) _ _ = False
   67 
   68 defaultAct = [GC,REDN,IDLE,FLUSH]
   69 defaultSp = [RESUMED,USED,CREATED,LOST]
   70 defaultSize = (15::Int,10::Int) 
   71 defaultPS = [PE "14" 1]
   72 
   73 instance Parse Args where
   74         parseType ('-':'A':string) = (A order,more)
   75                 where
   76                 order = if (whiteSpace string)=="" then defaultAct
   77                                  else x
   78                 (x,more) = parse string
   79         parseType ('-':'S':string) = (S order,more)
   80                 where
   81                 order = if (whiteSpace string=="") then defaultSp
   82                                  else x
   83                 (x,more) = parse string
   84         parseType ('-':'P':string) = (P,string)
   85         parseType ('-':'E':string) = (E x y,"")
   86                 where
   87                 (x,y) = if (whiteSpace string) == "" then defaultSize
   88                                 else (p,q)
   89                 (p,'x':a) = parse string
   90                 (q,more) = parse a
   91         parseType ('-':'F':string) = (F,string)
   92         parseType ('-':'G':string) = (G,string)
   93         parseType ('-':'p':string) = (PS processors,more)
   94                 where
   95                 order = if (whiteSpace string=="") then defaultPS
   96                                  else processors
   97                 (processors,more) = parse string
   98         parseType ('-':string) = error("Illegal flag to GRIP-graph : -" ++ string ++ "\n")
   99         parseType string = (IO files,"")
  100                 where 
  101                 files = if string == "" then ("stdin","stdout") 
  102                                 else if (whiteSpace more) == "" then (file1,file1++".ps")
  103                                         else (file1,file2)
  104                 (file1,more) = span (\x->x/=' ') string
  105                 (file2,_) = span (\x->x/=' ') (whiteSpace (more++" "))