{-# LANGUAGE UndecidableInstances, TypeFamilies #-}
module Data.Reify (
        MuRef(..),
        module Data.Reify.Graph,
        reifyGraph
        ) where

import Control.Concurrent.MVar
import Control.Monad
import Data.Unique
import System.Mem.StableName
import Data.IntMap as M

import Control.Applicative
import Data.Reify.Graph

-- | 'MuRef' is a class that provided a way to reference into a specific type,
-- and a way to map over the deferenced internals.

class MuRef a where
  type DeRef a :: * -> *

  mapDeRef :: (Applicative m) 
           => (a -> m u) 
           -> a 
           -> m (DeRef a u)


-- | 'reifyGraph' takes a data structure that admits 'MuRef', and returns a 'Graph' that contains
-- the dereferenced nodes, with their children as 'Unique' rather than recursive values.

reifyGraph :: (MuRef s) => s -> IO (Graph (DeRef s))
reifyGraph m = do rt1 <- newMVar M.empty
                  rt2 <- newMVar []
                  root <- findNodes rt1 rt2 m
                  pairs <- readMVar rt2
                  return (Graph pairs root)


findNodes :: (MuRef s) 
          => MVar (IntMap [(StableName s,Unique)])   -- Dynamic of StableNames
          -> MVar [(Unique,DeRef s Unique)] 
          -> s 
          -> IO Unique
findNodes rt1 rt2 j | j `seq` True = do
        st <- makeStableName j
        tab <- takeMVar rt1
        case mylookup st tab of
          Just var -> do putMVar rt1 tab
                         return $ var
          Nothing -> 
                    do var <- newUnique
                       putMVar rt1 $ M.insertWith (++) (hashStableName st) [(st,var)] tab
                       res <- mapDeRef (findNodes rt1 rt2) j
                       tab' <- takeMVar rt2
                       putMVar rt2 $ (var,res) : tab'
                       return var
   where
        mylookup h tab =
           case M.lookup (hashStableName h) tab of
             Just tab2 -> Prelude.lookup h tab2
             Nothing ->  Nothing