{-# OPTIONS_GHC -F -pgmF htfpp #-} module Test.NodeManager where import Data.Graph.NodeManager import Test.Framework import Control.Monad.State.Strict import qualified Data.IntMap.Strict as IM import qualified Data.List as L assertConsistent :: StateT (NodeManager Char) IO () assertConsistent = get >>= liftIO . assertEqual True . isConsistent prop_init :: NodeMap String -> Property prop_init m = uniqueValues m && all (>=0) (IM.keys m) ==> isConsistent new && m == getNodeMap new where new = initNodeManager m uniqueValues im = IM.size im == length (L.nub $ IM.elems im) test_getNewNodesSince :: IO () test_getNewNodesSince = flip evalStateT emptyNodeManager $ do _ <- getNodeHandle 'a' n2 <- getNodeHandle 'b' n3 <- getNodeHandle 'c' n4 <- getNodeHandle 'd' new <- gets (getNewNodesSince n2) liftIO $ assertEqual (IM.fromList [(n3, 'c'), (n4, 'd')]) new test_getNodeHandle :: IO () test_getNodeHandle = flip evalStateT emptyNodeManager $ do n1 <- getNodeHandle 'a' n2 <- getNodeHandle 'a' liftIO $ assertEqual n1 n2 n3 <- getNodeHandle 'b' n4 <- getNodeHandle 'b' liftIO $ assertEqual n3 n4 n5 <- getNodeHandle 'a' liftIO $ assertEqual n1 n5 liftIO $ assertNotEqual n1 n3 assertConsistent test_lookupNode :: IO () test_lookupNode = flip evalStateT emptyNodeManager $ do n1 <- getNodeHandle 'a' n2 <- getNodeHandle 'b' x1 <- gets $ lookupNode n1 x2 <- gets $ lookupNode n2 x3 <- gets $ lookupNode 123 liftIO $ assertEqual (Just 'a') x1 liftIO $ assertEqual (Just 'b') x2 liftIO $ assertEqual Nothing x3 assertConsistent