#!/usr/bin/env runhaskell
{-# LANGUAGE NamedFieldPuns
  #-}

import Text.PrettyPrint.HughesPJClass
import Text.Regex
import Data.List
import Data.Function
import Control.Monad
import System

import HSH



-- import Graphics.Gnuplot.Simple
-- import Graphics.Gnuplot.Advanced
-- import Graphics.Gnuplot.Frame
-- import Graphics.Gnuplot.Frame.OptionSet

-- import qualified Graphics.Gnuplot.Terminal.X11
-- import Graphics.Gnuplot.Plot.TwoDimensional



import qualified Graphics.Gnuplot.Simple as Simple

import qualified Graphics.Gnuplot.Advanced as Plot
import qualified Graphics.Gnuplot.Terminal.X11 as X11

import qualified Graphics.Gnuplot.Frame as Frame
import qualified Graphics.Gnuplot.Frame.Option as Opt
import qualified Graphics.Gnuplot.Frame.OptionSet as Opts

import qualified Graphics.Gnuplot.Plot.ThreeDimensional as Plot3D

import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D
import Graphics.Gnuplot.Plot.TwoDimensional (linearScale, )

import Data.Array (listArray, )
import Data.Monoid (mappend, )


--import qualified Graphics.Gnuplot.Private.LineSpecification as LineSpec
import qualified Graphics.Gnuplot.LineSpecification as LineSpec

simple2d :: Plot2D.T
simple2d =
   Plot2D.function (linearScale 100 (-10,10::Double)) sin

circle2d :: Plot2D.T
circle2d =
   fmap
      (Graph2D.typ Graph2D.points)
      (Plot2D.parameterFunction
         (linearScale 24 (-pi,pi::Double))
         (\t -> (cos t, sin t)))

overlay2d :: Frame.T Graph2D.T
overlay2d =
   Frame.cons (Opts.size 1 0.4 $ Opts.remove Opt.key $ Opts.deflt) $
   Plot2D.function (linearScale 100 (-pi,pi::Double)) cos
   `mappend`
   circle2d

-- mypath :: Graph2D.T 
mypath :: Plot2D.T
mypath = 
   fmap (Graph2D.lineSpec $ 
	  LineSpec.title "blaht" $ 
	  LineSpec.lineWidth 3.0 $ 
	  LineSpec.pointSize 3.0 $ 
	  LineSpec.deflt) $ 
   fmap (Graph2D.typ Graph2D.linesPoints) $
   Plot2D.path [(0,0), (1,1), (3,2)]

spec :: LineSpec.T
spec = LineSpec.title "blah" LineSpec.deflt

myoverlay :: Frame.T Graph2D.T
myoverlay =
  --Graph2D.lineSpec (LineSpec.title "blah" LineSpec.deflt) $ 
   Frame.cons (Opts.deflt) $
   mypath --(Graph2D.lineSpec spec mypath)
   `mappend`
   circle2d




--x11 = terminal Terminal.X11.cons
--x11 = terminal cons
--x11 = terminal Graphics.Gnuplot.Terminal.X11.cons
--x11 = terminal X11.cons

--------------------------------------------------------------------------------
-- Let's take a particular interpretation of Enum for pairs:
instance (Enum t1, Enum t2) => Enum (t1,t2) where 
  succ (a,b) = (succ a, succ b)
  pred (a,b) = (pred a, pred b)
  toEnum n = (toEnum n, toEnum n)
  fromEnum (a,b) = case (fromEnum a, fromEnum b) of
                     (x,y) | x == y -> x
		     (x,y) -> error$ "fromEnum of pair: nonmatching numbers: " ++ show x ++" and "++ show y


-- Removes single blanks and separates lines into groups based on double blanks.
sepDoubleBlanks :: [String] -> [[String]]
sepDoubleBlanks ls = loop [] ls 
 where 
  loop acc []        = [reverse acc]
  loop acc ("":"":t) = reverse acc : loop [] (stripLeadingBlanks t)
  loop acc ("":t)    = loop acc t
  loop acc (h :t)    = loop (h:acc) t 
  stripLeadingBlanks []     = [] 
  stripLeadingBlanks ("":t) = stripLeadingBlanks t
  stripLeadingBlanks ls     = ls


remComments :: String -> [String] -> [String]
remComments commentchars ls = filter (pred . stripLeadingWhitespace) ls
 where 
  pred str = not (take (length commentchars) str == commentchars) 
  stripLeadingWhitespace []      = [] 
  stripLeadingWhitespace (' ':t) = stripLeadingWhitespace t
  stripLeadingWhitespace ls      = ls

--------------------------------------------------------------------------------

-- Here's the schema for the data from my timing tests:
data Entry = Entry { 
  name     :: String,
  variant  :: String,
  sched    :: Int, 
  threads  :: Int, 
  hashhack :: Bool, 
  tmin     :: Double,
  tmed     :: Double,
  tmax     :: Double
}
  deriving Show

instance Pretty Entry where
  --pPrint x = pPrint$ show x
  pPrint Entry { name, variant, sched, threads, tmin, tmed, tmax } = 
       pPrint ("ENTRY", name, variant, sched, threads, tmin, tmed, tmax)


parse [a,b,c,d,e,f,g,h] =
  Entry { name     = a, 
	  variant  = b,
	  sched    = read c,
	  threads  = read d,
	  hashhack = not (e == "0"),
	  tmin     = read f,
	  tmed     = read g,
	  tmax     = read h
	} 
parse other = error$ "Cannot parse, wrong number of fields, "++ show (length other) ++" expected 8: "++ show other

groupSort fn = 
   (groupBy ((==) `on` fn)) . 
   (sortBy (compare `on` fn))

-- Add three more levels of list nesting to organize the data:
organize_data :: [Entry] -> [[[[Entry]]]]
organize_data = 
	 (map (map (groupSort sched)))  . 
  	      (map (groupSort variant)) .
                   (groupSort name)


newtype Mystr = Mystr String

instance Show Mystr where
  show (Mystr s) = s


-- mypath :: Graph2D.T 
--Plot2D.T
--plot_benchmark :: [[[Entry]]] -> IO ()
--plot_benchmark :: [[[Entry]]] -> Plot2D.T
plot_benchmark [io, pure] = 
    --Plot.plot (X11.title "foobar" X11.cons) $
    Plot.plot X11.cons $
    Frame.cons (Opts.title ("Benchmark: " ++ benchname ++ " normalized to time " ++ show basetime) $ Opts.deflt) plots
 where 
  benchname = name $ head $ head io 
  plots = foldl1 mappend (map persched io ++ map persched pure)
  basetime = foldl1 min $ map tmed $
	     filter ((== 0) . threads) $
	     (concat io ++ concat pure)
  persched :: [Entry] -> Plot2D.T
  persched dat = 
    let 
	schd = sched$   head dat
	var  = variant$ head dat
        mins = map tmin dat
        meds = map tmed dat
        maxs = map tmax dat
	--zip4 = map$ \ a b c d -> (a,b,c,d)
	zip4 s1 s2 s3 s4 = map (\ ((a,b), (c,d)) -> (a,b,c,d))
	                   (zip (zip s1 s2) (zip s3 s4))
        pairs = zip4 (map (fromIntegral . threads) dat) 
		     (map (basetime / ) meds)
		     (map (basetime / ) mins)
		     (map (basetime / ) maxs)
	quads = map (\ (a,b,c,d) -> Mystr (show a ++" "++ show b ++" "++ show d ++" "++ show c))
		pairs 
    in 
      fmap (Graph2D.lineSpec $ 
	    LineSpec.title (var ++"/"++ show schd) $ 
	    LineSpec.lineWidth 3.0 $ 
	    LineSpec.pointSize 3.0 $ 
	    LineSpec.deflt) $ 
      fmap (Graph2D.typ Graph2D.linesPoints) $
      --Plot2D.path pairs
      --Plot2D.path (map ( \ (a,b,c,d) -> (a,b)) pairs)
      --fmap (Graph2D.typ Graph2D.errorBars) $
      Plot2D.list quads


-- Ok, yuck, giving up on the Cabal gnuplot package and generating the gnuplot output myself.
plot_benchmark2 root [io, pure] = action (io ++ pure)
 where 
  benchname = name $ head $ head io 
  -- What was the best single-threaded execution time across variants/schedulers:
  basetime = foldl1 min $ map tmed $
	     filter ((== 0) . threads) $
	     (concat io ++ concat pure)
  (filebase,_) = break (== '.') $ basename benchname 

  scrub '_' = ' '
  scrub x = x
  -- scrub [] = []
  -- scrub ('_':t) = "\\_"++ scrub t
  -- scrub (h:t)   = h : scrub t

  action lines = 
   do 
      let scriptfile = root ++ filebase ++ ".gp"
      putStrLn$ "Dumping gnuplot script to: "++ scriptfile
      runIO$ echo "set terminal postscript enhanced color\n"         -|- appendTo scriptfile
      runIO$ echo ("set output \""++filebase++".eps\"\n")            -|- appendTo scriptfile
      runIO$ echo ("set title \"Benchmark: "++ map scrub filebase ++
		   ", speedup relative to serial time " ++ show basetime ++" seconds\"\n") -|- appendTo scriptfile
      runIO$ echo ("set xlabel \"Number of Threads\"\n")             -|- appendTo scriptfile
      runIO$ echo ("set ylabel \"Parallel Speedup\"\n")              -|- appendTo scriptfile
      runIO$ echo ("plot \\\n")                                      -|- appendTo scriptfile
      -- In this loop lets do the errorbars:
      forM_ (zip [1..] lines) $ \(i,points) -> do 
          let datfile = root ++ filebase ++ show i ++".dat"
	  runIO$ echo ("   \""++ basename datfile ++"\" using 1:2:3:4 with errorbars title \"\", \\\n") -|- appendTo scriptfile

      -- Now a second loop for the lines themselves and to dump the actual data:
      forM_ (zip [1..] lines) $ \(i,points) -> do 
          let datfile = root ++ filebase ++ show i ++".dat"          
	  let schd = sched$   head points
	  let var  = variant$ head points
	  let nickname = var ++"/"++ show schd
	  runIO$ echo ("# Data for variant "++ nickname ++"\n") -|- appendTo datfile
          forM_ points $ \x -> do 
	      runIO$ echo (show (fromIntegral (threads x)) ++" "++
			   show (basetime / tmed x)        ++" "++
                           show (basetime / tmax x)        ++" "++ 
			   show (basetime / tmin x)        ++" \n") -|- appendTo datfile

	  let comma = if i == length lines then "" else ",\\"
	  runIO$ echo ("   \""++ basename datfile ++
		       "\" using 1:2 with lines linewidth 4.0 lt "++ show i ++" title \""++nickname++"\" "++comma++"\n")
		   -|- appendTo scriptfile

      putStrLn$ "Finally, running gnuplot..."
      -- runIO$ "(cd "++root++"; gnuplot "++basename scriptfile++")"
      -- runIO$ "(cd "++root++"; ps2pdf "++ filebase ++".eps )"


plot_benchmark2 root _ = putStrLn "plot_benchmark2: Unexpected input"		       

isMatch rg str = case matchRegex rg str of { Nothing -> False; _ -> True }

main = do 
 dat <- run$ catFrom ["results.dat"] -|- remComments "#" 

 let parsed = map (parse . splitRegex (mkRegex "[ \t]+")) 
	          (filter (not . isMatch (mkRegex "ERR")) $
		   filter (not . null) dat)
 let organized = organize_data$ filter ((`elem` ["io","pure"]) . variant) parsed


 -- let chunked = sepDoubleBlanks dat		 
 -- let chopped = map (parse . splitRegex (mkRegex "[ \t]+"))
 -- 	           (chunked !! 0)
 -- let bysched = groupBy ((==) `on` sched) $
 -- 	       sortBy (compare `on` sched) 
 -- 		      chopped
 -- putStrLn$ show (pPrint (map length chopped))
 -- putStrLn$ show (pPrint (map parse chopped))

 putStrLn$ renderStyle (style { lineLength=150 }) (pPrint organized)

 --Plot.plot X11.cons myoverlay
 --Simple.plotList [Simple.LineStyle 0 [Simple.LineTitle "foobar"]] [0,5..100]

 let root = "./graph_temp/"
 -- For hygiene, completely anhilate output directory:
 system$ "rm -rf "  ++root
 system$ "mkdir -p "++root
 forM_ organized    $ \ perbenchmark -> do 
  plot_benchmark2 root perbenchmark
  forM_ perbenchmark $ \ pervariant -> 
   forM_ pervariant   $ \ persched -> 
     do let mins = map tmin persched
	let pairs = (zip (map (fromIntegral . threads) persched) mins)
	putStrLn$ show pairs
	--plot Graphics.Gnuplot.Terminal.X11.cons (path pairs)
	--System.exitWith ExitSuccess
	--plot x11 (path pairs)
	
        return ()

 --forM_ organized    $ \ perbenchmark -> 


 --plotLists [x11] [dat, [50..25]]
 --plotLists [x11] [dat, [100,95..0]]

 --plotDots [x11, Size$ Scale 3.0] dat
 --plotDots [x11, LineStyle 0 [PointSize 5.0]] dat
 putStrLn$ "Plotted list"