{-# LANGUAGE ScopedTypeVariables #-}
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 VersionDag nodeKey nodeInfo arcInfo = VersionDag {
stateBroadcaster :: SimpleBroadcaster (
VersionDagState nodeKey nodeInfo arcInfo),
toNodeKey :: nodeInfo -> nodeKey,
toParents :: nodeInfo -> [(arcInfo,nodeKey)]
}
data VersionDagState nodeKey nodeInfo arcInfo = VersionDagState {
inPureGraph :: PureGraph nodeKey arcInfo,
nodeInfoDict :: Map.Map nodeKey nodeInfo,
isHidden :: nodeInfo -> Bool
}
newVersionDag :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> (nodeInfo -> Bool)
-> (nodeInfo -> nodeKey)
-> (nodeInfo -> [(arcInfo,nodeKey)])
-> IO (VersionDag nodeKey nodeInfo arcInfo)
newVersionDag isHidden0 toNodeKey0 toParents0 =
do
let
state = VersionDagState {
inPureGraph = emptyPureGraph,
nodeInfoDict = Map.empty,
isHidden = isHidden0
}
stateBroadcaster <- newSimpleBroadcaster state
return (VersionDag {
stateBroadcaster = stateBroadcaster,
toNodeKey = toNodeKey0,
toParents = toParents0
})
addVersion :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
addVersion versionDag nodeInfo = addVersions versionDag [nodeInfo]
addVersions :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo -> [nodeInfo] -> IO ()
addVersions versionDag nodeInfos =
applySimpleUpdate (stateBroadcaster versionDag)
(\ state0 ->
let
inPureGraph0 = inPureGraph state0
inPureGraph1 = foldl
(\ pg0 nodeInfo ->
addNode pg0 (toNodeKey versionDag nodeInfo)
(toParents versionDag nodeInfo)
)
inPureGraph0
nodeInfos
nodeInfoDict0 = nodeInfoDict state0
nodeInfoDict1 =
foldr (uncurry Map.insert)
nodeInfoDict0
(map
(\ nodeInfo -> (toNodeKey versionDag nodeInfo,nodeInfo))
nodeInfos
)
state1 = state0 {
inPureGraph = inPureGraph1,
nodeInfoDict = nodeInfoDict1
}
in
state1
)
deleteVersion :: Ord nodeKey
=> VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO ()
deleteVersion versionDag nodeKey =
applySimpleUpdate (stateBroadcaster versionDag)
(\ state0 ->
let
inPureGraph0 = inPureGraph state0
inPureGraph1 = deleteNode inPureGraph0 nodeKey
nodeInfoDict0 = nodeInfoDict state0
nodeInfoDict1 = Map.delete nodeKey nodeInfoDict0
state1 = state0 {
inPureGraph = inPureGraph1,
nodeInfoDict = nodeInfoDict1
}
in
state1
)
setNodeInfo :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo -> nodeInfo -> IO ()
setNodeInfo = addVersion
changeIsHidden :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo
-> (nodeInfo -> Bool) -> IO ()
changeIsHidden versionDag isHidden1 =
applySimpleUpdate (stateBroadcaster versionDag)
(\ state0 -> state0 {isHidden = isHidden1})
nodeKeyExists :: Ord nodeKey
=> VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO Bool
nodeKeyExists versionDag nodeKey =
do
nodeInfoOpt <- lookupNodeKey versionDag nodeKey
return (isJust nodeInfoOpt)
lookupNodeKey :: Ord nodeKey
=> VersionDag nodeKey nodeInfo arcInfo -> nodeKey -> IO (Maybe nodeInfo)
lookupNodeKey versionDag nodeKey =
do
state <- readContents (stateBroadcaster versionDag)
return (Map.lookup nodeKey (nodeInfoDict state))
getNodeInfos :: Ord nodeKey
=> VersionDag nodeKey nodeInfo arcInfo -> IO [nodeInfo]
getNodeInfos versionDag =
do
state <- readContents (stateBroadcaster versionDag)
return (Map.elems (nodeInfoDict state))
toDisplayedGraph :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo
-> GraphConnection (nodeInfo,Bool) () (Maybe arcInfo) ()
toDisplayedGraph (versionDag :: VersionDag nodeKey nodeInfo arcInfo) =
let
transform :: VersionDagState nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey (Maybe arcInfo),nodeKey -> (nodeInfo,Bool))
transform state =
let
toNodeInfo :: nodeKey -> nodeInfo
toNodeInfo nodeKey =
Map.findWithDefault
(error "VersionDag: nodeKey encountered with no nodeInfo")
nodeKey
(nodeInfoDict state)
isHidden0 :: nodeInfo -> Bool
isHidden0 = isHidden state
isHidden1 :: nodeKey -> Bool
isHidden1 = isHidden0 . toNodeInfo
toNodeInfo1 :: nodeKey -> (nodeInfo,Bool)
toNodeInfo1 nodeKey =
let
nodeInfo = toNodeInfo nodeKey
in
(nodeInfo,isHidden0 nodeInfo)
inPureGraph0 = inPureGraph state
inPureGraph1 = pureGraphMakeConsistent inPureGraph0
outPureGraph :: PureGraph nodeKey (Maybe arcInfo)
outPureGraph = pureGraphPrune isHidden1 inPureGraph1
in
(outPureGraph,toNodeInfo1)
in
pureGraphToGraph
(fmap transform (toSimpleSource (stateBroadcaster versionDag)))
getInputGraphBack :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo
-> (nodeKey -> nodeInfo -> graphBackNodeKey)
-> IO (GraphBack nodeKey graphBackNodeKey)
getInputGraphBack
(versionDag :: VersionDag nodeKey nodeInfo arcInfo)
(toGraphBackNodeKey :: nodeKey -> nodeInfo -> graphBackNodeKey) =
do
state <- readContents (stateBroadcaster versionDag)
let
inPureGraph0 :: PureGraph nodeKey arcInfo
inPureGraph0 = inPureGraph state
nodeInfoDict0 :: Map.Map nodeKey nodeInfo
nodeInfoDict0 = nodeInfoDict state
getAllNodes :: [nodeKey]
getAllNodes = toAllNodes inPureGraph0
getKey :: nodeKey -> Maybe graphBackNodeKey
getKey nodeKey =
do
nodeInfo <- Map.lookup nodeKey nodeInfoDict0
return (toGraphBackNodeKey nodeKey nodeInfo)
getParents :: nodeKey -> Maybe [nodeKey]
getParents = toNodeParents inPureGraph0
return (GraphBack {
getAllNodes = getAllNodes,
getKey = getKey,
getParents = getParents
})
toInputGraph :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
=> VersionDag nodeKey nodeInfo arcInfo
-> GraphConnection nodeInfo () arcInfo ()
toInputGraph (versionDag :: VersionDag nodeKey nodeInfo arcInfo) =
let
transform :: VersionDagState nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
transform state =
let
toNodeInfo :: nodeKey -> nodeInfo
toNodeInfo nodeKey =
Map.findWithDefault
(error "VersionDag: nodeKey encountered with no nodeInfo")
nodeKey
(nodeInfoDict state)
in
(inPureGraph state,toNodeInfo)
in
pureGraphToGraph (fmap transform (
toSimpleSource (stateBroadcaster versionDag)))