Fix most/all warnings

Data/Graph/Inductive/Graph.hs

@@ -156,9 +156,10 @@ class Graph gr where
   matchAny  :: gr a b -> GDecomp gr a b
   matchAny g = case labNodes g of
                  []      -> error "Match Exception, Empty Graph"
-                 (v,_):_ -> (c,g')
-                   where
-                     (Just c,g') = match v g
+                 (v,_):_ ->
+                   case match v g of
+                     (Just c,g') -> (c,g')
+                     _ -> error "Match Exception, cannot extract node"
 
   -- | The number of 'Node's in a 'Graph'.
   noNodes   :: gr a b -> Int

Data/Graph/Inductive/Internal/RootPath.hs

@@ -29,7 +29,7 @@ findP v (LP (p@((w,_):_)):ps) | v==w      = p
                               | otherwise = findP v ps
 
 getPath :: Node -> RTree -> Path
-getPath v = reverse . first (\(w:_)->w==v)
+getPath v = reverse . first ((==v) . head)
 
 getLPath :: Node -> LRTree a -> LPath a
 getLPath v = LP . reverse . findP v

Data/Graph/Inductive/Monad.hs

@@ -56,8 +56,10 @@ class (Monad m) => GraphM m gr where
   matchAnyM g = do vs <- labNodesM g
                    case vs of
                      []      -> error "Match Exception, Empty Graph"
-                     (v,_):_ -> do ~(Just c,g') <- matchM v g
-                                   return (c,g')
+                     (v,_):_ -> do r <- matchM v g
+                                   case r of
+                                     (Just c,g') -> return (c,g')
+                                     _ -> error "Match Exception, cannot extract node"
 
   noNodesM   :: m (gr a b) -> m Int
   noNodesM = labNodesM >>. length

Data/Graph/Inductive/NodeMap.hs

@@ -114,8 +114,8 @@ insMapNode_ m a g =
 
 insMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a, b) -> g a b -> g a b
 insMapEdge m e g =
-    let (Just e') = mkEdge m e
-    in insEdge e' g
+  case mkEdge m e of Just e' -> insEdge e' g
+                     Nothing -> error "insMapEdge: invalid edge"
 
 delMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b
 delMapNode m a g =
@@ -124,8 +124,8 @@ delMapNode m a g =
 
 delMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a) -> g a b -> g a b
 delMapEdge m (n1, n2) g =
-    let Just (n1', n2', _) = mkEdge m (n1, n2, ())
-    in delEdge (n1', n2') g
+    case mkEdge m (n1, n2, ()) of Just (n1', n2', _) -> delEdge (n1', n2') g
+                                  Nothing -> error "delMapEdge: invalid edge"
 
 insMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a])
 insMapNodes m as g =
@@ -139,8 +139,8 @@ insMapNodes_ m as g =
 
 insMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a, b)] -> g a b -> g a b
 insMapEdges m es g =
-    let Just es' = mkEdges m es
-    in insEdges es' g
+    case mkEdges m es of Just es' -> insEdges es' g
+                         Nothing -> error "insMapEdges: invalid edge"
 
 delMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b
 delMapNodes m as g =
@@ -149,15 +149,18 @@ delMapNodes m as g =
 
 delMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a)] -> g a b -> g a b
 delMapEdges m ns g =
-    let Just ns' =  mkEdges m $ P.map (\(a, b) -> (a, b, ())) ns
-        ns'' = P.map (\(a, b, _) -> (a, b)) ns'
-    in delEdges ns'' g
+    case mkEdges m $ P.map (\(a, b) -> (a, b, ())) ns of
+      Nothing -> error "delMapEdges: invalid edges"
+      Just ns' ->
+        let ns'' = P.map (\(a, b, _) -> (a, b)) ns'
+        in delEdges ns'' g
 
 mkMapGraph :: (Ord a, DynGraph g) => [a] -> [(a, a, b)] -> (g a b, NodeMap a)
 mkMapGraph ns es =
     let (ns', m') = mkNodes new ns
-        Just es' = mkEdges m' es
-    in (mkGraph ns' es', m')
+    in case mkEdges m' es of
+         Just es' -> (mkGraph ns' es', m')
+         Nothing -> error "mkMapGraph: invalid edges"
 
 -- | Graph construction monad; handles passing both the 'NodeMap' and the
 -- 'Graph'.

Data/Graph/Inductive/Query/BCC.hs

@@ -43,10 +43,11 @@ findGraph v (g:gs) = case match v g of
 splitGraphs :: (DynGraph gr) => [gr a b] -> [Node] -> [gr a b]
 splitGraphs gs []     = gs
 splitGraphs [] _      = error "splitGraphs: empty graph list"
-splitGraphs gs (v:vs) = splitGraphs (gs''++gs''') vs
-                        where gs'' = embedContexts c gs'
-                              gs' = gComponents g'
-                              ((Just c,g'), gs''') = findGraph v gs
+splitGraphs gs (v:vs) = case findGraph v gs of
+                          ((Nothing, _), _) -> error "splitGraphs: invalid node"
+                          ((Just c,g'), gs''') -> splitGraphs (gs''++gs''') vs
+                            where gs'' = embedContexts c gs'
+                                  gs' = gComponents g'
 
 {-|
 Finds the bi-connected components of an undirected connected graph.

Data/Graph/Inductive/Query/BFS.hs

@@ -107,10 +107,12 @@ bft v = bf (queuePut [v] mkQueue)
 bf :: (Graph gr) => Queue Path -> gr a b -> RTree
 bf q g | queueEmpty q || isEmpty g = []
        | otherwise                 =
-       case match v g of
-         (Just c, g')  -> p:bf (queuePutList (map (:p) (suc' c)) q') g'
-         (Nothing, g') -> bf q' g'
-         where (p@(v:_),q') = queueGet q
+       case queueGet q of
+         ([], _) -> []
+         (p@(v:_),q') ->
+           case match v g of
+             (Just c, g')  -> p:bf (queuePutList (map (:p) (suc' c)) q') g'
+             (Nothing, g') -> bf q' g'
 
 esp :: (Graph gr) => Node -> Node -> gr a b -> Path
 esp s t = getPath t . bft s
@@ -128,11 +130,13 @@ lbft v g = case out g v of
 lbf :: (Graph gr) => Queue (LPath b) -> gr a b -> LRTree b
 lbf q g | queueEmpty q || isEmpty g = []
         | otherwise                 =
-       case match v g of
-         (Just c, g') ->
-             LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g'
-         (Nothing, g') -> lbf q' g'
-         where (LP (p@((v,_):_)),q') = queueGet q
+       case queueGet q of
+         (LP [], _) -> []
+         (LP (p@((v,_):_)),q') ->
+           case match v g of
+             (Just c, g') ->
+                 LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g'
+             (Nothing, g') -> lbf q' g'
 
 lesp :: (Graph gr) => Node -> Node -> gr a b -> LPath b
 lesp s t = getLPath t . lbft s

Data/Graph/Inductive/Query/Dominators.hs

@@ -51,25 +51,26 @@ type ToNode = Array Node' Node
 type FromNode = IntMap Node'
 
 idomWork :: (Graph gr) => gr a b -> Node -> (IDom, ToNode, FromNode)
-idomWork g root = let
-    nds = reachable root g
-    -- use depth first tree from root do build the first approximation
-    trees@(~[tree]) = dff [root] g
-    -- relabel the tree so that paths from the root have increasing nodes
-    (s, ntree) = numberTree 0 tree
-    -- the approximation iDom0 just maps each node to its parent
-    iD0 = array (1, s-1) (tail $ treeEdges (-1) ntree)
-    -- fromNode translates graph nodes to relabeled (internal) nodes
-    fromNode = I.unionWith const (I.fromList (zip (T.flatten tree) (T.flatten ntree))) (I.fromList (zip nds (repeat (-1))))
-    -- toNode translates internal nodes to graph nodes
-    toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree))
-    preds = array (1, s-1) [(i, filter (/= -1) (mapMaybe (`I.lookup` fromNode)
-                            (pre g (toNode ! i)))) | i <- [1..s-1]]
-    -- iteratively improve the approximation to find iDom.
-    iD = fixEq (refineIDom preds) iD0
-  in
-    if null trees then error "Dominators.idomWork: root not in graph"
-                  else (iD, toNode, fromNode)
+idomWork g root =
+  case dff [root] g of
+    [] -> error "Dominators.idomWork: root not in graph"
+    tree : _ ->
+      let
+        nds = reachable root g
+        -- use depth first tree from root do build the first approximation
+        -- relabel the tree so that paths from the root have increasing nodes
+        (s, ntree) = numberTree 0 tree
+        -- the approximation iDom0 just maps each node to its parent
+        iD0 = array (1, s-1) (tail $ treeEdges (-1) ntree)
+        -- fromNode translates graph nodes to relabeled (internal) nodes
+        fromNode = I.unionWith const (I.fromList (zip (T.flatten tree) (T.flatten ntree))) (I.fromList (zip nds (repeat (-1))))
+        -- toNode translates internal nodes to graph nodes
+        toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree))
+        preds = array (1, s-1) [(i, filter (/= -1) (mapMaybe (`I.lookup` fromNode)
+                                (pre g (toNode ! i)))) | i <- [1..s-1]]
+        -- iteratively improve the approximation to find iDom.
+        iD = fixEq (refineIDom preds) iD0
+      in (iD, toNode, fromNode)
 
 -- for each node in iDom, find the intersection of all its predecessor's
 -- dominating sets, and update iDom accordingly.

Data/Graph/Inductive/Query/Indep.hs

@@ -22,12 +22,14 @@ indep = fst . indepSize
 indepSize :: (DynGraph gr) => gr a b -> ([Node], Int)
 indepSize g
   | isEmpty g = ([], 0)
-  | l1 > l2   = il1
-  | otherwise = il2
+  | otherwise =
+      case match v g of
+        (Nothing,_) -> error "indepSize: unexpected invalid node"
+        (Just c,g') ->
+          let il1@(_,l1)  = indepSize g'
+              il2@(_,l2)  = ((v:) *** (+1)) $ indepSize (delNodes (neighbors' c) g')
+          in if l1 > l2 then il1 else il2
   where
     vs          = nodes g
     v           = snd . maximumBy (compare `on` fst)
                   . map ((,) =<< deg g) $ vs
-    (Just c,g') = match v g
-    il1@(_,l1)  = indepSize g'
-    il2@(_,l2)  = ((v:) *** (+1)) $ indepSize (delNodes (neighbors' c) g')

Data/Graph/Inductive/Query/MST.hs

@@ -20,10 +20,12 @@ newEdges (LP p) (_,_,_,s) = map (\(l,v)->H.unit l (LP ((v,l):p))) s
 prim :: (Graph gr,Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b
 prim h g | H.isEmpty h || isEmpty g = []
 prim h g =
-    case match v g of
-         (Just c,g')  -> p:prim (H.mergeAll (h':newEdges p c)) g'
-         (Nothing,g') -> prim h' g'
-    where (_,p@(LP ((v,_):_)),h') = H.splitMin h
+  case H.splitMin h of
+    (_,p@(LP ((v,_):_)),h') ->
+      case match v g of
+           (Just c,g')  -> p:prim (H.mergeAll (h':newEdges p c)) g'
+           (Nothing,g') -> prim h' g'
+    _ -> []
 
 msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b
 msTreeAt v = prim (H.unit 0 (LP [(v,0)]))

Data/Graph/Inductive/Query/MaxFlow.hs

@@ -64,10 +64,11 @@ augmentGraph g = emap (\i->(i,0,i)) (insEdges (getRevEdges (edges g)) g)
 --   residual capacity of that edge's label. Then return the updated
 --   list.
 updAdjList::(Num b) => Adj (b,b,b) -> Node -> b -> Bool -> Adj (b,b,b)
-updAdjList s v cf fwd = rs ++ ((x,y+cf',z-cf'),w) : rs'
+updAdjList s v cf fwd =
+  case break ((v==) . snd) s of
+    (rs, ((x,y,z),w):rs') -> rs ++ ((x,y+cf',z-cf'),w) : rs'
+    _ -> error "updAdjList: invalid node"
   where
-    (rs, ((x,y,z),w):rs') = break ((v==) . snd) s
-
     cf' = if fwd
              then cf
              else negate cf

Data/Graph/Inductive/Query/MaxFlow2.hs

@@ -77,7 +77,7 @@ exampleNetwork2=mkGraph [ (1,()), (2,()), (3,()), (4,()), (5,()), (6,()) ]
 -- Compute an augmenting path
 augPathFused :: Network -> Node -> Node -> Maybe DirPath
 augPathFused g s t = listToMaybe $ map reverse $
-    filter (\((u,_):_) -> u==t) tree
+    filter ((==t) . fst . head) tree
     where tree = bftForEK s g
 
 -- Breadth First Search wrapper function
@@ -87,8 +87,12 @@ bftForEK v = bfForEK (queuePut [(v,Forward)] mkQueue)
 -- Breadth First Search, tailored for Edmonds & Karp
 bfForEK :: Queue DirPath -> Network -> DirRTree
 bfForEK q g
-    | queueEmpty q || isEmpty g = []
-    | otherwise                 = case match v g of
+  | queueEmpty q || isEmpty g = []
+  | otherwise                 =
+     case queueGet q of
+      ([], _) -> []
+      (p@((v,_):_), q1) ->
+       case match v g of
         (Nothing, g')                     -> bfForEK q1 g'
         (Just (preAdj, _, _, sucAdj), g') -> p:bfForEK q2 g'
             where
@@ -100,7 +104,6 @@ bfForEK q g
                 -- Traverse edges forwards if flow less than capacity
                 suc2 = [ (sucNode,Forward):p
                     | ((c, f), sucNode) <- sucAdj, c>f]
-    where (p@((v,_):_), q1)=queueGet q
 
 -- Extract augmenting path from network; return path as a sequence of
 -- edges with direction of traversal, and new network with augmenting
@@ -110,13 +113,17 @@ extractPathFused :: Network -> DirPath
 extractPathFused g []  = ([], g)
 extractPathFused g [(_,_)] = ([], g)
 extractPathFused g ((u,_):rest@((v,Forward):_)) =
-    ((u, v, l, Forward):tailedges, newerg)
-        where (tailedges, newerg) = extractPathFused newg rest
-              Just (l, newg)    = extractEdge g u v (uncurry (>))
+  case extractEdge g u v (uncurry (>)) of
+    Just (l, newg) ->
+      let (tailedges, newerg) = extractPathFused newg rest
+      in ((u, v, l, Forward):tailedges, newerg)
+    Nothing -> error "extractPathFused Forward: invalid edge"
 extractPathFused g ((u,_):rest@((v,Backward):_)) =
-    ((v, u, l, Backward):tailedges, newerg)
-        where (tailedges, newerg) = extractPathFused newg rest
-              Just (l, newg)    = extractEdge g v u (\(_,f)->(f>0))
+  case extractEdge g v u (\(_,f)->(f>0)) of
+    Just (l, newg) ->
+      let (tailedges, newerg) = extractPathFused newg rest
+      in ((v, u, l, Backward):tailedges, newerg)
+    Nothing -> error "extractPathFused Backward: invalid edge"
 
 ekFusedStep :: EKStepFunc
 ekFusedStep g s t = case maybePath of
@@ -142,7 +149,7 @@ residualGraph g =
          [(v, u, f) | (u,v,(_,f)) <- labEdges g, f>0])
 
 augPath :: Network -> Node -> Node -> Maybe Path
-augPath g s t = listToMaybe $ map reverse $ filter (\(u:_) -> u==t) tree
+augPath g s t = listToMaybe $ map reverse $ filter ((==t) . head) tree
     where tree = bft s (residualGraph g)
 
 -- Extract augmenting path from network; return path as a sequence of
@@ -168,12 +175,12 @@ extractPath g (u:v:ws) =
 -- Return the label on the edge and the graph without the edge
 extractEdge :: Gr a b -> Node -> Node -> (b->Bool) -> Maybe (b, Gr a b)
 extractEdge g u v p =
-    case adj of
-        Just (el, _) -> Just (el, (p', node, l, rest) & newg)
-        Nothing      -> Nothing
-    where (Just (p', node, l, s), newg) = match u g
-          (adj, rest)=extractAdj s
-              (\(l', dest) -> dest==v && p l')
+    case match u g of
+      ((Just (p', node, l, s), newg)) ->
+        let (adj, rest)=extractAdj s (\(l', dest) -> dest==v && p l')
+        in do (el, _) <- adj
+              Just (el, (p', node, l, rest) & newg)
+      _ -> Nothing
 
 -- Extract an item from an adjacency list that satisfies a given
 -- predicate. Return the item and the rest of the adjacency list

Data/Graph/Inductive/Query/Monad.hs

@@ -218,14 +218,15 @@ dffM :: (GraphM m gr) => [Node] -> GT m (gr a b) [Tree Node]
 dffM vs = MGT (\mg->
           do g<-mg
              b<-isEmptyM mg
-             if b||null vs then return ([],g) else
-                let (v:vs') = vs in
-                do (mc,g1) <- matchM v mg
+             case (b, vs) of
+               (False, v:vs') -> do
+                   (mc,g1) <- matchM v mg
                    case mc of
                      Nothing -> apply (dffM vs') (return g1)
                      Just c  -> do (ts, g2) <- apply (dffM (suc' c)) (return g1)
                                    (ts',g3) <- apply (dffM vs') (return g2)
                                    return (Node (node' c) ts:ts',g3)
+               _ -> return ([],g)
           )
 
 graphDff :: (GraphM m gr) => [Node] -> m (gr a b) -> m [Tree Node]

Data/Graph/Inductive/Query/SP.hs

@@ -28,10 +28,12 @@ dijkstra :: (Graph gr, Real b)
     -> LRTree b
 dijkstra h g | H.isEmpty h || isEmpty g = []
 dijkstra h g =
-    case match v g of
-         (Just c,g')  -> p:dijkstra (H.mergeAll (h':expand d p c)) g'
-         (Nothing,g') -> dijkstra h' g'
-    where (_,p@(LP ((v,d):_)),h') = H.splitMin h
+  case H.splitMin h of
+    (_,p@(LP ((v,d):_)),h') ->
+      case match v g of
+           (Just c,g')  -> p:dijkstra (H.mergeAll (h':expand d p c)) g'
+           (Nothing,g') -> dijkstra h' g'
+    _ -> []
 
 -- | Tree of shortest paths from a certain node to the rest of the
 --   (reachable) nodes.

fgl-arbitrary/Data/Graph/Inductive/Arbitrary.hs

@@ -321,23 +321,24 @@ instance (ArbGraph ag, Arbitrary a, Arbitrary b) => Arbitrary (Connected ag a b)
 
 toConnGraph :: forall ag a b. (ArbGraph ag, Arbitrary a, Arbitrary b)
                => ag a b -> Gen (Connected ag a b)
-toConnGraph ag = do a <- arbitrary
-                    ces <- concat <$> mapM mkE ws
-                    return $ CG { connNode     = v
-                                , connArbGraph = fromBaseGraph
-                                                 . insEdges ces
-                                                 . insNode (v,a)
-                                                 $ g
-                                }
+toConnGraph ag = case newNodes 1 g of
+                   [] -> error "toConnGraph: cannot make node"
+                   v:_ -> do
+                     a <- arbitrary
+                     ces <- concat <$> mapM (mkE v) ws
+                     return $ CG { connNode     = v
+                                 , connArbGraph = fromBaseGraph
+                                                  . insEdges ces
+                                                  . insNode (v,a)
+                                                  $ g
+                                 }
   where
     g = toBaseGraph ag
 
-    [v] = newNodes 1 g
-
     ws = nodes g
 
-    mkE w = do b <- arbitrary
-               return (edgeF p [(v,w,b)])
+    mkE v w = do b <- arbitrary
+                 return (edgeF p [(v,w,b)])
 
     p :: GrProxy ag
     p = GrProxy