{-# LANGUAGE ScopedTypeVariables #-}

-- | This module implements a VersionDag, a graph which is used for
-- displaying versions within the Workbench.
--
-- The main differences between this and normal 'SimpleGraph.SimpleGraph''s
-- are that
--   (1) the parents of a node are fixed when it is created, as are
--       all arc labels and arc type labels.
--   (2) it is possible to selectively "hide" nodes from being displayed.
--       We intelligently display the structure between these nodes.
--   (3) it is not permitted to delete a node with children.  (Though it
--       may be hidden.)
module Graphs.VersionDag(
   VersionDag,

   newVersionDag,
   addVersion,
   addVersions,
   deleteVersion,
   setNodeInfo,
   changeIsHidden,
   toDisplayedGraph,
   toInputGraph,
   getInputGraphBack,
   nodeKeyExists,
   lookupNodeKey,
   getNodeInfos,
   ) where

import Data.Maybe

import qualified Data.Map as Map

import Util.Sources
import Util.Broadcaster

import Graphs.Graph
import Graphs.PureGraph
import Graphs.FindCommonParents
import Graphs.PureGraphPrune
import Graphs.PureGraphToGraph
import Graphs.PureGraphMakeConsistent

-- --------------------------------------------------------------------------
-- Data types
-- --------------------------------------------------------------------------

data VersionDag nodeKey nodeInfo arcInfo = VersionDag {
   VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster :: SimpleBroadcaster (
      VersionDagState nodeKey nodeInfo arcInfo),
   VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> nodeKey
toNodeKey :: nodeInfo -> nodeKey,
   VersionDag nodeKey nodeInfo arcInfo
-> nodeInfo -> [(arcInfo, nodeKey)]
toParents :: nodeInfo -> [(arcInfo,nodeKey)]
   }

data VersionDagState nodeKey nodeInfo arcInfo = VersionDagState {
   VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
inPureGraph :: PureGraph nodeKey arcInfo,
   VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict :: Map.Map nodeKey nodeInfo,
   VersionDagState nodeKey nodeInfo arcInfo -> nodeInfo -> Bool
isHidden :: nodeInfo -> Bool
   }

-- --------------------------------------------------------------------------
-- Create
-- --------------------------------------------------------------------------

newVersionDag :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => (nodeInfo -> Bool)
   -> (nodeInfo -> nodeKey)
   -> (nodeInfo -> [(arcInfo,nodeKey)])
   -> IO (VersionDag nodeKey nodeInfo arcInfo)
newVersionDag :: (nodeInfo -> Bool)
-> (nodeInfo -> nodeKey)
-> (nodeInfo -> [(arcInfo, nodeKey)])
-> IO (VersionDag nodeKey nodeInfo arcInfo)
newVersionDag nodeInfo -> Bool
isHidden0 nodeInfo -> nodeKey
toNodeKey0 nodeInfo -> [(arcInfo, nodeKey)]
toParents0 =
   do
      let
         state :: VersionDagState nodeKey nodeInfo arcInfo
state = VersionDagState :: forall nodeKey nodeInfo arcInfo.
PureGraph nodeKey arcInfo
-> Map nodeKey nodeInfo
-> (nodeInfo -> Bool)
-> VersionDagState nodeKey nodeInfo arcInfo
VersionDagState {
            inPureGraph :: PureGraph nodeKey arcInfo
inPureGraph = PureGraph nodeKey arcInfo
forall nodeInfo arcInfo. Ord nodeInfo => PureGraph nodeInfo arcInfo
emptyPureGraph,
            nodeInfoDict :: Map nodeKey nodeInfo
nodeInfoDict = Map nodeKey nodeInfo
forall k a. Map k a
Map.empty,
            isHidden :: nodeInfo -> Bool
isHidden = nodeInfo -> Bool
isHidden0
            }

      SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster <- VersionDagState nodeKey nodeInfo arcInfo
-> IO
     (SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo))
forall x. x -> IO (SimpleBroadcaster x)
newSimpleBroadcaster VersionDagState nodeKey nodeInfo arcInfo
forall arcInfo. VersionDagState nodeKey nodeInfo arcInfo
state

      VersionDag nodeKey nodeInfo arcInfo
-> IO (VersionDag nodeKey nodeInfo arcInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (VersionDag :: forall nodeKey nodeInfo arcInfo.
SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> (nodeInfo -> nodeKey)
-> (nodeInfo -> [(arcInfo, nodeKey)])
-> VersionDag nodeKey nodeInfo arcInfo
VersionDag {
         stateBroadcaster :: SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster = SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster,
         toNodeKey :: nodeInfo -> nodeKey
toNodeKey = nodeInfo -> nodeKey
toNodeKey0,
         toParents :: nodeInfo -> [(arcInfo, nodeKey)]
toParents = nodeInfo -> [(arcInfo, nodeKey)]
toParents0
         })

-- --------------------------------------------------------------------------
-- Modifications
-- --------------------------------------------------------------------------

addVersion :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
addVersion :: VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
addVersion VersionDag nodeKey nodeInfo arcInfo
versionDag nodeInfo
nodeInfo = VersionDag nodeKey nodeInfo arcInfo -> [nodeInfo] -> IO ()
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
VersionDag nodeKey nodeInfo arcInfo -> [nodeInfo] -> IO ()
addVersions VersionDag nodeKey nodeInfo arcInfo
versionDag [nodeInfo
nodeInfo]

addVersions :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo -> [nodeInfo] -> IO ()
addVersions :: VersionDag nodeKey nodeInfo arcInfo -> [nodeInfo] -> IO ()
addVersions VersionDag nodeKey nodeInfo arcInfo
versionDag [nodeInfo]
nodeInfos =
   SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> (VersionDagState nodeKey nodeInfo arcInfo
    -> VersionDagState nodeKey nodeInfo arcInfo)
-> IO ()
forall x. SimpleBroadcaster x -> (x -> x) -> IO ()
applySimpleUpdate (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)
      (\ VersionDagState nodeKey nodeInfo arcInfo
state0 ->
         let
            inPureGraph0 :: PureGraph nodeKey arcInfo
inPureGraph0 = VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
inPureGraph VersionDagState nodeKey nodeInfo arcInfo
state0
            inPureGraph1 :: PureGraph nodeKey arcInfo
inPureGraph1 = (PureGraph nodeKey arcInfo
 -> nodeInfo -> PureGraph nodeKey arcInfo)
-> PureGraph nodeKey arcInfo
-> [nodeInfo]
-> PureGraph nodeKey arcInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
               (\ PureGraph nodeKey arcInfo
pg0 nodeInfo
nodeInfo ->
                  PureGraph nodeKey arcInfo
-> nodeKey -> [(arcInfo, nodeKey)] -> PureGraph nodeKey arcInfo
forall nodeInfo arcInfo.
Ord nodeInfo =>
PureGraph nodeInfo arcInfo
-> nodeInfo -> [(arcInfo, nodeInfo)] -> PureGraph nodeInfo arcInfo
addNode PureGraph nodeKey arcInfo
pg0 (VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> nodeKey
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> nodeKey
toNodeKey VersionDag nodeKey nodeInfo arcInfo
versionDag nodeInfo
nodeInfo)
                     (VersionDag nodeKey nodeInfo arcInfo
-> nodeInfo -> [(arcInfo, nodeKey)]
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> nodeInfo -> [(arcInfo, nodeKey)]
toParents VersionDag nodeKey nodeInfo arcInfo
versionDag nodeInfo
nodeInfo)
                  )
               PureGraph nodeKey arcInfo
inPureGraph0
               [nodeInfo]
nodeInfos

            nodeInfoDict0 :: Map nodeKey nodeInfo
nodeInfoDict0 = VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state0

            nodeInfoDict1 :: Map nodeKey nodeInfo
nodeInfoDict1 =
               ((nodeKey, nodeInfo)
 -> Map nodeKey nodeInfo -> Map nodeKey nodeInfo)
-> Map nodeKey nodeInfo
-> [(nodeKey, nodeInfo)]
-> Map nodeKey nodeInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((nodeKey
 -> nodeInfo -> Map nodeKey nodeInfo -> Map nodeKey nodeInfo)
-> (nodeKey, nodeInfo)
-> Map nodeKey nodeInfo
-> Map nodeKey nodeInfo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry nodeKey -> nodeInfo -> Map nodeKey nodeInfo -> Map nodeKey nodeInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert)
                  Map nodeKey nodeInfo
nodeInfoDict0
                  ((nodeInfo -> (nodeKey, nodeInfo))
-> [nodeInfo] -> [(nodeKey, nodeInfo)]
forall a b. (a -> b) -> [a] -> [b]
map
                     (\ nodeInfo
nodeInfo -> (VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> nodeKey
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> nodeKey
toNodeKey VersionDag nodeKey nodeInfo arcInfo
versionDag nodeInfo
nodeInfo,nodeInfo
nodeInfo))
                     [nodeInfo]
nodeInfos
                     )
            state1 :: VersionDagState nodeKey nodeInfo arcInfo
state1 = VersionDagState nodeKey nodeInfo arcInfo
state0 {
               inPureGraph :: PureGraph nodeKey arcInfo
inPureGraph = PureGraph nodeKey arcInfo
inPureGraph1,
               nodeInfoDict :: Map nodeKey nodeInfo
nodeInfoDict = Map nodeKey nodeInfo
nodeInfoDict1
               }
         in
            VersionDagState nodeKey nodeInfo arcInfo
state1
         )

deleteVersion :: Ord nodeKey
   => VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO ()
deleteVersion :: VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO ()
deleteVersion VersionDag nodeKey nodeInfo arcInfo
versionDag nodeKey
nodeKey =
   SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> (VersionDagState nodeKey nodeInfo arcInfo
    -> VersionDagState nodeKey nodeInfo arcInfo)
-> IO ()
forall x. SimpleBroadcaster x -> (x -> x) -> IO ()
applySimpleUpdate (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)
      (\ VersionDagState nodeKey nodeInfo arcInfo
state0 ->
         let
            inPureGraph0 :: PureGraph nodeKey arcInfo
inPureGraph0 = VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
inPureGraph VersionDagState nodeKey nodeInfo arcInfo
state0
            inPureGraph1 :: PureGraph nodeKey arcInfo
inPureGraph1 = PureGraph nodeKey arcInfo -> nodeKey -> PureGraph nodeKey arcInfo
forall nodeInfo arcInfo.
Ord nodeInfo =>
PureGraph nodeInfo arcInfo
-> nodeInfo -> PureGraph nodeInfo arcInfo
deleteNode PureGraph nodeKey arcInfo
inPureGraph0 nodeKey
nodeKey

            nodeInfoDict0 :: Map nodeKey nodeInfo
nodeInfoDict0 = VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state0

            nodeInfoDict1 :: Map nodeKey nodeInfo
nodeInfoDict1 = nodeKey -> Map nodeKey nodeInfo -> Map nodeKey nodeInfo
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete nodeKey
nodeKey Map nodeKey nodeInfo
nodeInfoDict0
            state1 :: VersionDagState nodeKey nodeInfo arcInfo
state1 = VersionDagState nodeKey nodeInfo arcInfo
state0 {
               inPureGraph :: PureGraph nodeKey arcInfo
inPureGraph = PureGraph nodeKey arcInfo
inPureGraph1,
               nodeInfoDict :: Map nodeKey nodeInfo
nodeInfoDict = Map nodeKey nodeInfo
nodeInfoDict1
               }
         in
            VersionDagState nodeKey nodeInfo arcInfo
state1
         )


-- | Change the nodeInfo of something already added.
setNodeInfo :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
setNodeInfo :: VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
setNodeInfo = VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
addVersion


-- | Change the hidden function
changeIsHidden :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo
   -> (nodeInfo -> Bool) -> IO ()
changeIsHidden :: VersionDag nodeKey nodeInfo arcInfo -> (nodeInfo -> Bool) -> IO ()
changeIsHidden VersionDag nodeKey nodeInfo arcInfo
versionDag nodeInfo -> Bool
isHidden1 =
   SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> (VersionDagState nodeKey nodeInfo arcInfo
    -> VersionDagState nodeKey nodeInfo arcInfo)
-> IO ()
forall x. SimpleBroadcaster x -> (x -> x) -> IO ()
applySimpleUpdate (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)
      (\ VersionDagState nodeKey nodeInfo arcInfo
state0 -> VersionDagState nodeKey nodeInfo arcInfo
state0 {isHidden :: nodeInfo -> Bool
isHidden = nodeInfo -> Bool
isHidden1})

-- --------------------------------------------------------------------------
-- Queries
-- --------------------------------------------------------------------------

nodeKeyExists :: Ord nodeKey
   => VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO Bool
nodeKeyExists :: VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO Bool
nodeKeyExists VersionDag nodeKey nodeInfo arcInfo
versionDag nodeKey
nodeKey =
   do
      Maybe nodeInfo
nodeInfoOpt <- VersionDag nodeKey nodeInfo arcInfo
-> nodeKey -> IO (Maybe nodeInfo)
forall nodeKey nodeInfo arcInfo.
Ord nodeKey =>
VersionDag nodeKey nodeInfo arcInfo
-> nodeKey -> IO (Maybe nodeInfo)
lookupNodeKey VersionDag nodeKey nodeInfo arcInfo
versionDag nodeKey
nodeKey
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe nodeInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe nodeInfo
nodeInfoOpt)

lookupNodeKey :: Ord nodeKey
   => VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO (Maybe nodeInfo)
lookupNodeKey :: VersionDag nodeKey nodeInfo arcInfo
-> nodeKey -> IO (Maybe nodeInfo)
lookupNodeKey VersionDag nodeKey nodeInfo arcInfo
versionDag nodeKey
nodeKey =
   do
      VersionDagState nodeKey nodeInfo arcInfo
state <- SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> IO (VersionDagState nodeKey nodeInfo arcInfo)
forall source x d. HasSource source x d => source -> IO x
readContents (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)
      Maybe nodeInfo -> IO (Maybe nodeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (nodeKey -> Map nodeKey nodeInfo -> Maybe nodeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup nodeKey
nodeKey (VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state))

getNodeInfos :: Ord nodeKey
   => VersionDag nodeKey nodeInfo arcInfo -> IO [nodeInfo]
getNodeInfos :: VersionDag nodeKey nodeInfo arcInfo -> IO [nodeInfo]
getNodeInfos VersionDag nodeKey nodeInfo arcInfo
versionDag =
   do
      VersionDagState nodeKey nodeInfo arcInfo
state <- SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> IO (VersionDagState nodeKey nodeInfo arcInfo)
forall source x d. HasSource source x d => source -> IO x
readContents (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)
      [nodeInfo] -> IO [nodeInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return (Map nodeKey nodeInfo -> [nodeInfo]
forall k a. Map k a -> [a]
Map.elems (VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state))


-- --------------------------------------------------------------------------
-- Getting the pruned graph out
-- --------------------------------------------------------------------------

toDisplayedGraph :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo
   -> GraphConnection (nodeInfo,Bool) () (Maybe arcInfo) ()
toDisplayedGraph :: VersionDag nodeKey nodeInfo arcInfo
-> GraphConnection (nodeInfo, Bool) () (Maybe arcInfo) ()
toDisplayedGraph (VersionDag nodeKey nodeInfo arcInfo
versionDag :: VersionDag nodeKey nodeInfo arcInfo) =
   let
      transform :: VersionDagState nodeKey nodeInfo arcInfo
         -> (PureGraph nodeKey (Maybe arcInfo),nodeKey -> (nodeInfo,Bool))
      transform :: VersionDagState nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey (Maybe arcInfo), nodeKey -> (nodeInfo, Bool))
transform VersionDagState nodeKey nodeInfo arcInfo
state =
         let
            toNodeInfo :: nodeKey -> nodeInfo
            toNodeInfo :: nodeKey -> nodeInfo
toNodeInfo nodeKey
nodeKey =
               nodeInfo -> nodeKey -> Map nodeKey nodeInfo -> nodeInfo
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
                  ([Char] -> nodeInfo
forall a. HasCallStack => [Char] -> a
error [Char]
"VersionDag: nodeKey encountered with no nodeInfo")
                  nodeKey
nodeKey
                  (VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state)

            isHidden0 :: nodeInfo -> Bool
            isHidden0 :: nodeInfo -> Bool
isHidden0 = VersionDagState nodeKey nodeInfo arcInfo -> nodeInfo -> Bool
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> nodeInfo -> Bool
isHidden VersionDagState nodeKey nodeInfo arcInfo
state

            isHidden1 :: nodeKey -> Bool
            isHidden1 :: nodeKey -> Bool
isHidden1 = nodeInfo -> Bool
isHidden0 (nodeInfo -> Bool) -> (nodeKey -> nodeInfo) -> nodeKey -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. nodeKey -> nodeInfo
toNodeInfo

            toNodeInfo1 :: nodeKey -> (nodeInfo,Bool)
            toNodeInfo1 :: nodeKey -> (nodeInfo, Bool)
toNodeInfo1 nodeKey
nodeKey =
               let
                  nodeInfo :: nodeInfo
nodeInfo = nodeKey -> nodeInfo
toNodeInfo nodeKey
nodeKey
               in
                  (nodeInfo
nodeInfo,nodeInfo -> Bool
isHidden0 nodeInfo
nodeInfo)

            inPureGraph0 :: PureGraph nodeKey arcInfo
inPureGraph0 = VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
inPureGraph VersionDagState nodeKey nodeInfo arcInfo
state
            inPureGraph1 :: PureGraph nodeKey arcInfo
inPureGraph1 = PureGraph nodeKey arcInfo -> PureGraph nodeKey arcInfo
forall nodeInfo arcInfo.
Ord nodeInfo =>
PureGraph nodeInfo arcInfo -> PureGraph nodeInfo arcInfo
pureGraphMakeConsistent PureGraph nodeKey arcInfo
inPureGraph0

            outPureGraph :: PureGraph nodeKey (Maybe arcInfo)
            outPureGraph :: PureGraph nodeKey (Maybe arcInfo)
outPureGraph = (nodeKey -> Bool)
-> PureGraph nodeKey arcInfo -> PureGraph nodeKey (Maybe arcInfo)
forall nodeInfo arcInfo.
(Ord nodeInfo, Ord arcInfo) =>
(nodeInfo -> Bool)
-> PureGraph nodeInfo arcInfo -> PureGraph nodeInfo (Maybe arcInfo)
pureGraphPrune nodeKey -> Bool
isHidden1 PureGraph nodeKey arcInfo
inPureGraph1
         in
            (PureGraph nodeKey (Maybe arcInfo)
outPureGraph,nodeKey -> (nodeInfo, Bool)
toNodeInfo1)
   in
      SimpleSource
  (PureGraph nodeKey (Maybe arcInfo), nodeKey -> (nodeInfo, Bool))
-> GraphConnection (nodeInfo, Bool) () (Maybe arcInfo) ()
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> GraphConnection nodeInfo () arcInfo ()
pureGraphToGraph
         ((VersionDagState nodeKey nodeInfo arcInfo
 -> (PureGraph nodeKey (Maybe arcInfo),
     nodeKey -> (nodeInfo, Bool)))
-> SimpleSource (VersionDagState nodeKey nodeInfo arcInfo)
-> SimpleSource
     (PureGraph nodeKey (Maybe arcInfo), nodeKey -> (nodeInfo, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionDagState nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey (Maybe arcInfo), nodeKey -> (nodeInfo, Bool))
transform (SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> SimpleSource (VersionDagState nodeKey nodeInfo arcInfo)
forall hasSource x.
HasSimpleSource hasSource x =>
hasSource -> SimpleSource x
toSimpleSource (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)))

-- --------------------------------------------------------------------------
-- Getting the input graph out
-- --------------------------------------------------------------------------


-- | Get the input graph in the form of FindCommonParents.GraphBack.
-- NB.
-- (1) the confusion in the type variable "nodeKey" as used in
--     FindCommonParents is not the same as our "nodeKey".
-- (2) we get a snapshot of the state of the input graph at a particular
--     time
getInputGraphBack :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo
   -> (nodeKey -> nodeInfo -> graphBackNodeKey)
   -> IO (GraphBack nodeKey graphBackNodeKey)
getInputGraphBack :: VersionDag nodeKey nodeInfo arcInfo
-> (nodeKey -> nodeInfo -> graphBackNodeKey)
-> IO (GraphBack nodeKey graphBackNodeKey)
getInputGraphBack
      (VersionDag nodeKey nodeInfo arcInfo
versionDag :: VersionDag nodeKey nodeInfo arcInfo)
      (nodeKey -> nodeInfo -> graphBackNodeKey
toGraphBackNodeKey :: nodeKey -> nodeInfo -> graphBackNodeKey) =
   do
      VersionDagState nodeKey nodeInfo arcInfo
state <- SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> IO (VersionDagState nodeKey nodeInfo arcInfo)
forall source x d. HasSource source x d => source -> IO x
readContents (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)
      let
         inPureGraph0 :: PureGraph nodeKey arcInfo
         inPureGraph0 :: PureGraph nodeKey arcInfo
inPureGraph0 = VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
inPureGraph VersionDagState nodeKey nodeInfo arcInfo
state

         nodeInfoDict0 :: Map.Map nodeKey nodeInfo
         nodeInfoDict0 :: Map nodeKey nodeInfo
nodeInfoDict0 = VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state

         getAllNodes :: [nodeKey]
         getAllNodes :: [nodeKey]
getAllNodes = PureGraph nodeKey arcInfo -> [nodeKey]
forall nodeInfo arcInfo.
Ord nodeInfo =>
PureGraph nodeInfo arcInfo -> [nodeInfo]
toAllNodes PureGraph nodeKey arcInfo
inPureGraph0

         getKey :: nodeKey -> Maybe graphBackNodeKey
         getKey :: nodeKey -> Maybe graphBackNodeKey
getKey nodeKey
nodeKey =
            do
               nodeInfo
nodeInfo <- nodeKey -> Map nodeKey nodeInfo -> Maybe nodeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup nodeKey
nodeKey Map nodeKey nodeInfo
nodeInfoDict0
               graphBackNodeKey -> Maybe graphBackNodeKey
forall (m :: * -> *) a. Monad m => a -> m a
return (nodeKey -> nodeInfo -> graphBackNodeKey
toGraphBackNodeKey nodeKey
nodeKey nodeInfo
nodeInfo)

         getParents :: nodeKey -> Maybe [nodeKey]
         getParents :: nodeKey -> Maybe [nodeKey]
getParents = PureGraph nodeKey arcInfo -> nodeKey -> Maybe [nodeKey]
forall nodeInfo arcInfo.
Ord nodeInfo =>
PureGraph nodeInfo arcInfo -> nodeInfo -> Maybe [nodeInfo]
toNodeParents PureGraph nodeKey arcInfo
inPureGraph0

      GraphBack nodeKey graphBackNodeKey
-> IO (GraphBack nodeKey graphBackNodeKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (GraphBack :: forall node nodeKey.
[node]
-> (node -> Maybe nodeKey)
-> (node -> Maybe [node])
-> GraphBack node nodeKey
GraphBack {
         getAllNodes :: [nodeKey]
getAllNodes = [nodeKey]
getAllNodes,
         getKey :: nodeKey -> Maybe graphBackNodeKey
getKey = nodeKey -> Maybe graphBackNodeKey
getKey,
         getParents :: nodeKey -> Maybe [nodeKey]
getParents = nodeKey -> Maybe [nodeKey]
getParents
         })


toInputGraph :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => VersionDag nodeKey nodeInfo arcInfo
   -> GraphConnection nodeInfo () arcInfo ()
toInputGraph :: VersionDag nodeKey nodeInfo arcInfo
-> GraphConnection nodeInfo () arcInfo ()
toInputGraph (VersionDag nodeKey nodeInfo arcInfo
versionDag :: VersionDag nodeKey nodeInfo arcInfo) =
   let
      transform :: VersionDagState nodeKey nodeInfo arcInfo
         -> (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
      transform :: VersionDagState nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
transform VersionDagState nodeKey nodeInfo arcInfo
state =
         let
            toNodeInfo :: nodeKey -> nodeInfo
            toNodeInfo :: nodeKey -> nodeInfo
toNodeInfo nodeKey
nodeKey =
               nodeInfo -> nodeKey -> Map nodeKey nodeInfo -> nodeInfo
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
                  ([Char] -> nodeInfo
forall a. HasCallStack => [Char] -> a
error [Char]
"VersionDag: nodeKey encountered with no nodeInfo")
                  nodeKey
nodeKey
                  (VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo -> Map nodeKey nodeInfo
nodeInfoDict VersionDagState nodeKey nodeInfo arcInfo
state)
         in
            (VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
forall nodeKey nodeInfo arcInfo.
VersionDagState nodeKey nodeInfo arcInfo
-> PureGraph nodeKey arcInfo
inPureGraph VersionDagState nodeKey nodeInfo arcInfo
state,nodeKey -> nodeInfo
toNodeInfo)
   in
      SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> GraphConnection nodeInfo () arcInfo ()
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> GraphConnection nodeInfo () arcInfo ()
pureGraphToGraph ((VersionDagState nodeKey nodeInfo arcInfo
 -> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo))
-> SimpleSource (VersionDagState nodeKey nodeInfo arcInfo)
-> SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionDagState nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
transform (
         SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
-> SimpleSource (VersionDagState nodeKey nodeInfo arcInfo)
forall hasSource x.
HasSimpleSource hasSource x =>
hasSource -> SimpleSource x
toSimpleSource (VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
forall nodeKey nodeInfo arcInfo.
VersionDag nodeKey nodeInfo arcInfo
-> SimpleBroadcaster (VersionDagState nodeKey nodeInfo arcInfo)
stateBroadcaster VersionDag nodeKey nodeInfo arcInfo
versionDag)))