content: {-# LANGUAGE FlexibleInstances #-}
  -- This file is part of the Haskell debugger Hoed.
  --
  -- Copyright (c) Maarten Faddegon, 2016
  {-# LANGUAGE DeriveGeneric #-}
  
  module Debug.Hoed.Serialize
  ( storeJudgements
  , restoreJudgements
  , storeTree
  , restoreTree
  , storeTrace
  , restoreTrace
  ) where
  import Debug.Hoed.Observe
  import Prelude hiding (lookup,Right)
  import qualified Prelude as Prelude
  import Debug.Hoed.CompTree
  import Debug.Hoed.Render(CompStmt(..), StmtDetails(..))
  import Data.Hashable
  import Data.Serialize
  import Data.Serialize.Text
  import Data.Vector.Serialize
  
  import qualified Data.ByteString as BS
  import GHC.Exts (IsList(..))
  import GHC.Generics
  import Data.Graph.Libgraph(Judgement(..),AssistedMessage(..),mapGraph,Graph(..),Arc(..))
  
  --------------------------------------------------------------------------------
  -- Derive Serialize instances
  
  -- Orphan instances
  instance (Serialize a, Serialize b) => Serialize (Graph a b)
  instance (Serialize a, Serialize b) => Serialize (Arc a b)
  instance Serialize Vertex
  instance Serialize Judgement
  instance Serialize AssistedMessage
  instance Serialize CompStmt
  instance Serialize StmtDetails
  instance Serialize Parent
  instance Serialize Event
  instance Serialize Change
  instance (Hashable a, Serialize a) => Serialize (Hashed a) where
    get = hashed <$> get
    put = put . unhashed
  
  --------------------------------------------------------------------------------
  -- Tree
  
  storeTree :: FilePath -> CompTree -> IO ()
  storeTree fp = (BS.writeFile fp) . encode
  
  restoreTree :: FilePath -> IO (Maybe CompTree)
  restoreTree fp = do
          bs <- BS.readFile fp
          case decode bs of
            (Prelude.Left _)   -> return Nothing
            (Prelude.Right x) -> return (Just x)
  
  --------------------------------------------------------------------------------
  -- Trace
  
  storeTrace :: FilePath -> Trace -> IO ()
  storeTrace fp = (BS.writeFile fp) . encode
  
  restoreTrace :: FilePath -> IO (Maybe Trace)
  restoreTrace fp = do
          bs <- BS.readFile fp
          case decode bs of
            (Prelude.Left _)   -> return Nothing
            (Prelude.Right x) -> return (Just x)
  
  --------------------------------------------------------------------------------
  -- Judgements
  
  storeJudgements :: FilePath -> CompTree -> IO ()
  storeJudgements fp = (BS.writeFile fp) . encode . (foldl insert empty) . vertices
  
  restoreJudgements :: FilePath -> CompTree -> IO CompTree
  restoreJudgements fp ct = do
          bs <- BS.readFile fp
          case decode bs of
            (Prelude.Left _)   -> return ct
            (Prelude.Right db) -> return $ mapGraph (restore db) ct
  
  restore :: DB -> Vertex -> Vertex
  restore db v = case lookup db v of
    (Just Right) -> setJudgement v Right
    (Just Wrong) -> setJudgement v Wrong
    _            -> v
  
  data DB = DB [(String, Judgement)] deriving (Generic)
  instance Serialize DB
  
  empty :: DB
  empty = DB []
  
  lookup :: DB -> Vertex -> Maybe Judgement
  lookup (DB db) v = Prelude.lookup (key v) db
  
  insert :: DB -> Vertex -> DB
  insert (DB db) v = case judgement v of
    Nothing  -> DB db
    (Just j) -> DB ((key v, j) : db)
  
  key :: Vertex -> String
  key = vertexRes
  
  judgement :: Vertex -> Maybe Judgement
  judgement RootVertex = Nothing
  judgement v = case vertexJmt v of
    Right -> Just Right
    Wrong -> Just Wrong
    _     -> Nothing
  