[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Add lifted instances for Data.Tree (949f55e)

[git at git.haskell.org]

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/949f55ecdde35ee6aef1aa4069876f39823cac06

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

commit 949f55ecdde35ee6aef1aa4069876f39823cac06
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Dec 14 20:52:08 2016 -0500

    Add lifted instances for Data.Tree
    
    Add `Eq1`, `Show1`, `Eq1`, and `Ord1` instances for `Data.Tree`.


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

949f55ecdde35ee6aef1aa4069876f39823cac06
 Data/Tree.hs | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/Data/Tree.hs b/Data/Tree.hs
index d6d2726..89dd42b 100644
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -65,6 +65,11 @@ import GHC.Generics (Generic)
 import Data.Coerce
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
+import Data.Semigroup (Semigroup (..))
+#endif
+
 -- | Multi-way trees, also known as /rose trees/.
 data Tree a = Node {
         rootLabel :: a,         -- ^ label value
@@ -83,6 +88,39 @@ data Tree a = Node {
 #endif
 type Forest a = [Tree a]
 
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Tree where
+  liftEq eq = leq
+    where
+      leq (Node a fr) (Node a' fr') = eq a a' && liftEq leq fr fr'
+
+instance Ord1 Tree where
+  liftCompare cmp = lcomp
+    where
+      lcomp (Node a fr) (Node a' fr') = cmp a a' <> liftCompare lcomp fr fr'
+
+instance Show1 Tree where
+  liftShowsPrec shw shwl _p (Node a fr) =
+        showString "Node {rootLabel = " . shw 0 a . showString ", " .
+          showString "subForest = " . liftShowList shw shwl fr .
+          showString "}"
+
+instance Read1 Tree where
+  liftReadsPrec rd rdl _p = readParen False $
+    \s -> do
+      ("Node", s1) <- lex s
+      ("{", s2) <- lex s1
+      ("rootLabel", s3) <- lex s2
+      ("=", s4) <- lex s3
+      (a, s5) <- rd 0 s4
+      (",", s6) <- lex s5
+      ("subForest", s7) <- lex s6
+      ("=", s8) <- lex s7
+      (fr, s9) <- liftReadList rd rdl s8
+      ("}", s10) <- lex s9
+      pure (Node a fr, s10)
+#endif
+
 INSTANCE_TYPEABLE1(Tree)
 
 instance Functor Tree where