[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Add instances for Data.Graph.SCC (61ee51e)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:46:48 UTC 2017


Repository : ssh://git@git.haskell.org/containers

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/61ee51e66f39fdeb7be8c487fbd77436c3c51c37

>---------------------------------------------------------------

commit 61ee51e66f39fdeb7be8c487fbd77436c3c51c37
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Dec 14 23:33:34 2016 -0500

    Add instances for Data.Graph.SCC
    
    Add `Generic`, `Generic2`, `Data`, `Eq`, `Show`, `Read`,
    `Foldable`, `Traversable`, `Eq1`, `Show1`, `Read1`, and
    `Typeable` instances for `Data.Graph.SCC`.
    
    Fixes #51


>---------------------------------------------------------------

61ee51e66f39fdeb7be8c487fbd77436c3c51c37
 Data/Graph.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)

diff --git a/Data/Graph.hs b/Data/Graph.hs
index 71d82c8..f3cfc4a 100644
--- a/Data/Graph.hs
+++ b/Data/Graph.hs
@@ -1,10 +1,16 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__
 {-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 703
 {-# LANGUAGE Trustworthy #-}
 #endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 #include "containers.h"
 
@@ -77,11 +83,29 @@ import Data.Tree (Tree(Node), Forest)
 -- std interfaces
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
+import qualified Data.Foldable as F
+import Data.Traversable
+#else
+import Data.Foldable as F
 #endif
 import Control.DeepSeq (NFData(rnf))
 import Data.Maybe
 import Data.Array
 import Data.List
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
+import Data.Semigroup (Semigroup (..))
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+import GHC.Generics (Generic, Generic1)
+#elif __GLASGOW_HASKELL__ >= 702
+import GHC.Generics (Generic)
+#endif
+#ifdef __GLASGOW_HASKELL__
+import Data.Data (Data)
+#endif
+import Data.Typeable
+
 
 -------------------------------------------------------------------------
 --                                                                      -
@@ -94,6 +118,47 @@ data SCC vertex = AcyclicSCC vertex     -- ^ A single vertex that is not
                                         -- in any cycle.
                 | CyclicSCC  [vertex]   -- ^ A maximal set of mutually
                                         -- reachable vertices.
+  deriving (Eq, Show, Read)
+
+INSTANCE_TYPEABLE1(SCC)
+
+#ifdef __GLASGOW_HASKELL__
+deriving instance Data vertex => Data (SCC vertex)
+#endif
+
+#if __GLASGOW_HASKELL__ >= 706
+deriving instance Generic1 SCC
+#endif
+
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (SCC vertex)
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 SCC where
+  liftEq eq (AcyclicSCC v1) (AcyclicSCC v2) = eq v1 v2
+  liftEq eq (CyclicSCC vs1) (CyclicSCC vs2) = liftEq eq vs1 vs2
+  liftEq _ _ _ = False
+instance Show1 SCC where
+  liftShowsPrec sp _sl d (AcyclicSCC v) = showsUnaryWith sp "AcyclicSCC" d v
+  liftShowsPrec _sp sl d (CyclicSCC vs) = showsUnaryWith (const sl) "CyclicSCC" d vs
+instance Read1 SCC where
+  liftReadsPrec rp rl = readsData $
+    readsUnaryWith rp "AcyclicSCC" AcyclicSCC <>
+    readsUnaryWith (const rl) "CyclicSCC" CyclicSCC
+#endif
+
+instance F.Foldable SCC where
+  foldr c n (AcyclicSCC v) = c v n
+  foldr c n (CyclicSCC vs) = foldr c n vs
+
+instance Traversable SCC where
+  -- We treat the non-empty cyclic case specially to cut one
+  -- fmap application.
+  traverse f (AcyclicSCC vertex) = AcyclicSCC <$> f vertex
+  traverse _f (CyclicSCC []) = pure (CyclicSCC [])
+  traverse f (CyclicSCC (x : xs)) =
+    (\x' xs' -> CyclicSCC (x' : xs')) <$> f x <*> traverse f xs
 
 instance NFData a => NFData (SCC a) where
     rnf (AcyclicSCC v) = rnf v



More information about the ghc-commits mailing list