{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}

module Graphviz (graphviz) where

import Types

import Data.Aeson
import Data.Char
import Data.Word
import Data.Either
import Data.Monoid
import Data.GraphViz
import Data.GraphViz.Attributes.Complete
import Data.GraphViz.Types.Generalised as G
import Data.GraphViz.Types.Monadic
import Control.Monad
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import Data.Text.Encoding.Error

graphviz :: FilePath -> IO ()
graphviz logfile = do
	parsed <- parseLog <$> L.readFile logfile
	case lefts parsed of
		[] -> do
			let g = genGraph (rights parsed)
			f <- createImage logfile Png g
			putStrLn ("Generated " ++ f)
		errs -> error $ unlines errs

parseLog :: L.ByteString -> [Either String ActivityLog]
parseLog = map eitherDecode' 
	. filter (not . L.null)
	. L.split nl


nl :: Word8
nl = fromIntegral (ord '\n')

createImage :: PrintDotRepr dg n => FilePath -> GraphvizOutput -> dg n -> IO FilePath
createImage f o g = Data.GraphViz.addExtension (runGraphvizCommand Dot g) o f

genGraph :: [ActivityLog] -> G.DotGraph T.Text
genGraph ls = digraph (Str "debug-me") $ do
	nodeAttrs [style filled]
	forM_ ls $ \l -> case l of
		ActivitySeen { activitySeen = (a, h) } -> do
			node (display h)
				[ textLabel $ display $ seenData $ activity a
				, shape Circle
				, xcolor Green
				]
			chain a h
		ActivityEntered { activityEntered = (a, h) } -> do
			node (display h)
				[ textLabel $ display $ enteredData $ activity a
				, shape Square
				, if activityEnteredAccepted l
					then xcolor Green
					else xcolor Red
				]
			chain a h
  where
	chain a h = case prevActivity a of
		Nothing -> return ()
		Just p -> display p --> display h

xcolor :: X11Color -> Attribute
xcolor c = Color [toWC $ X11Color c]

class Display t where
	display :: t -> T.Text

instance Display Val where
	display (Val b) = T.decodeUtf8With lenientDecode (L.fromStrict b)

instance Display Hash where
	display (Hash m h) = T.pack (show m) <> display h