generic-deriving 1.13 → 1.13.1

raw patch · 4 files changed

+235/−175 lines, 4 filesdep ~template-haskelldep ~th-abstractionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell, th-abstraction

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• generic-deriving.cabal +4/−3
• src/Generics/Deriving/Instances.hs +61/−5
• tests/ExampleSpec.hs +167/−167

@@ -1,3 +1,6 @@+# 1.13.1 [2019.11.26]+* Backport the `Generic(1)` instances for `Kleisli` introduced in `base-4.14`.+ # 1.13 [2019.08.27] * Make `GSemigroup` a superclass of `GMonoid`. Similarly, make   `GSemigroup'` a superclass of `GMonoid'`.

@@ -1,5 +1,5 @@ name:                   generic-deriving-version:                1.13+version:                1.13.1 synopsis:               Generic programming library for generalised deriving. description: @@ -36,6 +36,7 @@                       , GHC == 8.4.4                       , GHC == 8.6.5                       , GHC == 8.8.1+                      , GHC == 8.10.1 extra-source-files:     CHANGELOG.md                       , README.md @@ -82,7 +83,7 @@    build-depends:        containers       >= 0.1   && < 0.7                       , ghc-prim                     < 1-                      , template-haskell >= 2.4   && < 2.16+                      , template-haskell >= 2.4   && < 2.17                       , th-abstraction   >= 0.3   && < 0.4    default-language:     Haskell2010@@ -98,7 +99,7 @@   build-depends:        base             >= 4.3  && < 5                       , generic-deriving                       , hspec            >= 2    && < 3-                      , template-haskell >= 2.4  && < 2.16+                      , template-haskell >= 2.4  && < 2.17   build-tool-depends:   hspec-discover:hspec-discover   hs-source-dirs:       tests   default-language:     Haskell2010

@@ -27,8 +27,12 @@ module Generics.Deriving.Instances ( -- Only instances from Generics.Deriving.Base -- and the Generic1 instances+#if !(MIN_VERSION_base(4,14,0))+    Rep0Kleisli+  , Rep1Kleisli+#endif #if !(MIN_VERSION_base(4,12,0))-    Rep0Down+  , Rep0Down   , Rep1Down #endif #if !(MIN_VERSION_base(4,9,0))@@ -153,9 +157,57 @@ # else import GHC.Exts (Down(..)) # endif+#endif++#if !(MIN_VERSION_base(4,14,0))+import Control.Arrow (Kleisli(..))+#endif++#if !(MIN_VERSION_base(4,14,0)) import Generics.Deriving.Base.Internal #endif +#if !(MIN_VERSION_base(4,14,0))+# if MIN_VERSION_base(4,6,0)+type Rep0Kleisli m a b = Rep  (Kleisli m a b)+type Rep1Kleisli m a   = Rep1 (Kleisli m a)+deriving instance Generic  (Kleisli m a b)+deriving instance Generic1 (Kleisli m a)+# else+type Rep0Kleisli m a b = D1 D1Kleisli (C1 C1_0Kleisli (S1 S1_0_0Kleisli (Rec0 (a -> m b))))+type Rep1Kleisli m a   = D1 D1Kleisli (C1 C1_0Kleisli (S1 S1_0_0Kleisli ((->) a :.: Rec1 m)))++instance Generic (Kleisli m a b) where+    type Rep (Kleisli m a b) = Rep0Kleisli m a b+    from x = M1 (case x of+        Kleisli g -> M1 (M1 (K1 g)))+    to (M1 x) = case x of+        M1 (M1 (K1 g)) -> Kleisli g++instance Generic1 (Kleisli m a) where+    type Rep1 (Kleisli m a) = Rep1Kleisli m a+    from1 x = M1 (case x of+        Kleisli g -> M1 (M1 (Comp1 (fmap Rec1 g))))+    to1 (M1 x) = case x of+        M1 (M1 g) -> Kleisli (fmap unRec1 (unComp1 g))++data D1Kleisli+data C1_0Kleisli+data S1_0_0Kleisli++instance Datatype D1Kleisli where+  datatypeName _ = "Kleisli"+  moduleName   _ = "Control.Arrow"++instance Constructor C1_0Kleisli where+  conName     _ = "Kleisli"+  conIsRecord _ = True++instance Selector S1_0_0Kleisli where+  selName _ = "runKleisli"+# endif+#endif+ #if !(MIN_VERSION_base(4,12,0)) # if MIN_VERSION_base(4,6,0) type Rep0Down a = Rep (Down a)@@ -168,13 +220,17 @@  instance Generic (Down a) where     type Rep (Down a) = Rep0Down a-    from (Down x) = M1 (M1 (M1 (K1 x)))-    to (M1 (M1 (M1 (K1 x)))) = Down x+    from x = M1 (case x of+        Down g -> M1 (M1 (K1 g)))+    to (M1 x) = case x of+        M1 (M1 (K1 g)) -> Down g  instance Generic1 Down where     type Rep1 Down = Rep1Down-    from1 (Down x) = M1 (M1 (M1 (Par1 x)))-    to1 (M1 (M1 (M1 x))) = Down (unPar1 x)+    from1 x = M1 (case x of+        Down g -> M1 (M1 (Par1 g)))+    to1 (M1 x) = case x of+        M1 (M1 g) -> Down (unPar1 g)  data D1Down data C1_0Down

@@ -32,147 +32,6 @@  import qualified Text.Read.Lex (Lexeme) -main :: IO ()-main = hspec spec--spec :: Spec-spec = parallel $ do-    describe "[] and Maybe tests" $ do-        it "gshow hList" $-            gshow hList `shouldBe`-                "[1,2,3,4,5,6,7,8,9,10]"--        it "gshow (children maybe2)" $-            gshow (children maybe2) `shouldBe`-                "[]"--        it "gshow (transform (const \"abc\") [])" $-            gshow (transform (const "abc") []) `shouldBe`-                "\"abc\""--        it "gshow (transform double hList)" $-            gshow (transform double hList) `shouldBe`-                "[1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10]"--        it "gshow (geq hList hList)" $-            gshow (geq hList hList) `shouldBe`-                "True"--        it "gshow (geq maybe1 maybe2)" $-            gshow (geq maybe1 maybe2) `shouldBe`-                "False"--        it "gshow (take 5 genum)" $-            gshow (take 5 (genum :: [Maybe Int])) `shouldBe`-                "[Nothing,Just 0,Just -1,Just 1,Just -2]"--        it "gshow (take 15 genum)" $-            gshow (take 15 (genum :: [[Int]])) `shouldBe`-                "[[],[0],[0,0],[-1],[0,0,0],[-1,0],[1],[0,-1],[-1,0,0],[1,0],[-2],[0,0,0,0],[-1,-1],[1,0,0],[-2,0]]"--        it "gshow (range ([0], [1]))" $-            gshow (range ([0], [1::Int])) `shouldBe`-                "[[0],[0,0],[-1],[0,0,0],[-1,0]]"--        it "gshow (inRange ([0], [3,5]) hList)" $-            gshow (inRange ([0], [3,5::Int]) hList) `shouldBe`-                "False"--    describe "Tests for Tree" $ do-        it "gshow tree" $-            gshow tree `shouldBe`-                "Branch 2 Empty (Branch 1 Empty Empty)"--        it "gshow (children tree)" $-            gshow (children tree) `shouldBe`-                "[Empty,Branch 1 Empty Empty]"--        it "gshow (descend (descend (\\_ -> Branch 0 Empty Empty)) tree)" $-            gshow (descend (descend (\_ -> Branch 0 Empty Empty)) tree) `shouldBe`-                "Branch 2 Empty (Branch 1 (Branch 0 Empty Empty) (Branch 0 Empty Empty))"--        it "gshow (context tree [Branch 1 Empty Empty,Empty])" $-            gshow (context tree [Branch 1 Empty Empty,Empty]) `shouldBe`-                "Branch 2 (Branch 1 Empty Empty) Empty"--        it "gshow (transform upgradeTree tree)" $-            gshow (transform upgradeTree tree) `shouldBe`-                "Branch 3 (Branch 0 Empty Empty) (Branch 2 (Branch 0 Empty Empty) (Branch 0 Empty Empty))"--        it "gshow (take 10 genum)" $ do-            gshow (take 10 (genum :: [Tree])) `shouldBe`-                "[Empty,Branch 0 Empty Empty,Branch 0 Empty (Branch 0 Empty Empty),Branch -1 Empty Empty,Branch 0 (Branch 0 Empty Empty) Empty,Branch -1 Empty (Branch 0 Empty Empty),Branch 1 Empty Empty,Branch 0 Empty (Branch 0 Empty (Branch 0 Empty Empty)),Branch -1 (Branch 0 Empty Empty) Empty,Branch 1 Empty (Branch 0 Empty Empty)]"--    describe "Tests for List" $ do-        it "gshow (gmap fromEnum list)" $-            gshow (gmap fromEnum list) `shouldBe`-                "Cons 112 (Cons 113 Nil)"--        it "gshow (gmap gshow listlist)" $-            gshow (gmap gshow listlist) `shouldBe`-                "Cons \"Cons 'p' (Cons 'q' Nil)\" (Cons \"Nil\" Nil)"--        it "gshow list" $-            gshow list `shouldBe`-                "Cons 'p' (Cons 'q' Nil)"--        it "gshow listlist" $-            gshow listlist `shouldBe`-                "Cons (Cons 'p' (Cons 'q' Nil)) (Cons Nil Nil)"--        it "gshow (children list)" $-            gshow (children list) `shouldBe`-                "[Cons 'q' Nil]"--        it "gshow (children listlist)" $-            gshow (children listlist) `shouldBe`-                "[Cons Nil Nil]"--    describe "Tests for Rose" $ do-        it "gshow rose1" $-            gshow rose1 `shouldBe`-                "Rose [1,2] [Rose [3,4] [],Rose [5] []]"--        it "gshow (gmap gshow rose1)" $-            gshow (gmap gshow rose1) `shouldBe`-                "Rose [\"1\",\"2\"] [Rose [\"3\",\"4\"] [],Rose [\"5\"] []]"--    describe "Tests for GRose" $ do-        it "gshow grose1" $-            gshow grose1 `shouldBe`-                "GRose [1,2] [GRose [3] [],GRose [] []]"--        it "gshow (gmap gshow grose1)" $-            gshow (gmap gshow grose1) `shouldBe`-                "GRose [\"1\",\"2\"] [GRose [\"3\"] [],GRose [] []]"--    describe "Tests for Either" $ do-        it "gshow either1" $-            gshow either1 `shouldBe`-                "Left Right 'p'"--        it "gshow (gmap gshow either1)" $-            gshow (gmap gshow either1) `shouldBe`-                "Left Right \"'p'\""--    describe "Tests for Nested" $ do-        it "gshow nested" $-            gshow nested `shouldBe`-                "Nested {value = 1, rec = Nested {value = [2], rec = Nested {value = [[3],[4,5],[]], rec = Leaf}}}"--        it "gshow (gmap gshow nested)" $-            gshow (gmap gshow nested) `shouldBe`-                "Nested {value = \"1\", rec = Nested {value = [\"2\"], rec = Nested {value = [[\"3\"],[\"4\",\"5\"],[]], rec = Leaf}}}"--    describe "Tests for Bush" $ do-        it "gshow bush1" $-            gshow bush1 `shouldBe`-                "BushCons 0 (BushCons (BushCons 1 BushNil) BushNil)"--        it "gshow (gmap gshow bush1)" $-            gshow (gmap gshow bush1) `shouldBe`-                "BushCons \"0\" (BushCons (BushCons \"1\" BushNil) BushNil)"- ------------------------------------------------------------------------------- -- Example: Haskell's lists and Maybe -------------------------------------------------------------------------------@@ -194,6 +53,8 @@  data Tree = Empty | Branch Int Tree Tree +$(deriveAll0 ''Tree)+ instance GShow Tree where     gshowsPrec = gshowsPrecdefault @@ -221,6 +82,8 @@  data List a = Nil | Cons a (List a) +$(deriveAll0And1 ''List)+ instance GFunctor List where   gmap = gmapdefault @@ -247,6 +110,8 @@  data Rose a = Rose [a] [Rose a] +$(deriveAll0And1 ''Rose)+ instance (GShow a) => GShow (Rose a) where   gshowsPrec = gshowsPrecdefault @@ -264,6 +129,14 @@ data GRose f a = GRose (f a) (f (GRose f a)) deriving instance Functor f => Functor (GRose f) +$(deriveMeta           ''GRose)+$(deriveRepresentable0 ''GRose)+$(deriveRep1           ''GRose)+instance Functor f => Generic1 (GRose f) where+  type Rep1 (GRose f) = $(makeRep1 ''GRose) f+  from1 = $(makeFrom1 ''GRose)+  to1   = $(makeTo1 ''GRose)+ instance (GShow (f a), GShow (f (GRose f a))) => GShow (GRose f a) where   gshowsPrec = gshowsPrecdefault @@ -279,6 +152,8 @@  data Either a b = Left (Either [a] b) | Right b +$(deriveAll0And1 ''Either)+ instance (GShow a, GShow b) => GShow (Either a b) where   gshowsPrec = gshowsPrecdefault @@ -298,6 +173,8 @@ data Nested a = Leaf | Nested { value :: a, rec :: Nested [a] }   deriving Functor +$(deriveAll0And1 ''Nested)+ instance (GShow a) => GShow (Nested a) where   gshowsPrec = gshowsPrecdefault @@ -313,6 +190,8 @@  data Bush a = BushNil | BushCons a (Bush (Bush a)) deriving Functor +$(deriveAll0And1 ''Bush)+ instance GFunctor Bush where   gmap = gmapdefault @@ -328,6 +207,8 @@  data Weird a = Weird [[[a]]] deriving Show +$(deriveAll0And1 ''Weird)+ instance GFunctor Weird where   gmap = gmapdefault @@ -365,32 +246,6 @@ data    instance MyType3 Int   ()    f p q = MyType3Hash q Addr# Char# Double# Float# Int# Word# #endif ----------------------------------------------------------------------------------- Template Haskell bits----------------------------------------------------------------------------------$(deriveAll0     ''Tree)--$(deriveAll0And1 ''List)--$(deriveAll0And1 ''Rose)--$(deriveMeta           ''GRose)-$(deriveRepresentable0 ''GRose)-$(deriveRep1           ''GRose)-instance Functor f => Generic1 (GRose f) where-  type Rep1 (GRose f) = $(makeRep1 ''GRose) f-  from1 = $(makeFrom1 ''GRose)-  to1   = $(makeTo1 ''GRose)--$(deriveAll0And1 ''Either)--$(deriveAll0And1 ''Nested)--$(deriveAll0And1 ''Bush)--$(deriveAll0And1 ''Weird)- $(deriveAll0And1 ''Empty) $(deriveAll0And1 ''(:/:)) $(deriveAll0And1 ''GADTSyntax)@@ -419,3 +274,148 @@ $(deriveAll0And1 'MyType3False) $(deriveAll0And1 'MyType3Hash) #endif++-------------------------------------------------------------------------------+-- Unit tests+-------------------------------------------------------------------------------++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+    describe "[] and Maybe tests" $ do+        it "gshow hList" $+            gshow hList `shouldBe`+                "[1,2,3,4,5,6,7,8,9,10]"++        it "gshow (children maybe2)" $+            gshow (children maybe2) `shouldBe`+                "[]"++        it "gshow (transform (const \"abc\") [])" $+            gshow (transform (const "abc") []) `shouldBe`+                "\"abc\""++        it "gshow (transform double hList)" $+            gshow (transform double hList) `shouldBe`+                "[1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10]"++        it "gshow (geq hList hList)" $+            gshow (geq hList hList) `shouldBe`+                "True"++        it "gshow (geq maybe1 maybe2)" $+            gshow (geq maybe1 maybe2) `shouldBe`+                "False"++        it "gshow (take 5 genum)" $+            gshow (take 5 (genum :: [Maybe Int])) `shouldBe`+                "[Nothing,Just 0,Just -1,Just 1,Just -2]"++        it "gshow (take 15 genum)" $+            gshow (take 15 (genum :: [[Int]])) `shouldBe`+                "[[],[0],[0,0],[-1],[0,0,0],[-1,0],[1],[0,-1],[-1,0,0],[1,0],[-2],[0,0,0,0],[-1,-1],[1,0,0],[-2,0]]"++        it "gshow (range ([0], [1]))" $+            gshow (range ([0], [1::Int])) `shouldBe`+                "[[0],[0,0],[-1],[0,0,0],[-1,0]]"++        it "gshow (inRange ([0], [3,5]) hList)" $+            gshow (inRange ([0], [3,5::Int]) hList) `shouldBe`+                "False"++    describe "Tests for Tree" $ do+        it "gshow tree" $+            gshow tree `shouldBe`+                "Branch 2 Empty (Branch 1 Empty Empty)"++        it "gshow (children tree)" $+            gshow (children tree) `shouldBe`+                "[Empty,Branch 1 Empty Empty]"++        it "gshow (descend (descend (\\_ -> Branch 0 Empty Empty)) tree)" $+            gshow (descend (descend (\_ -> Branch 0 Empty Empty)) tree) `shouldBe`+                "Branch 2 Empty (Branch 1 (Branch 0 Empty Empty) (Branch 0 Empty Empty))"++        it "gshow (context tree [Branch 1 Empty Empty,Empty])" $+            gshow (context tree [Branch 1 Empty Empty,Empty]) `shouldBe`+                "Branch 2 (Branch 1 Empty Empty) Empty"++        it "gshow (transform upgradeTree tree)" $+            gshow (transform upgradeTree tree) `shouldBe`+                "Branch 3 (Branch 0 Empty Empty) (Branch 2 (Branch 0 Empty Empty) (Branch 0 Empty Empty))"++        it "gshow (take 10 genum)" $ do+            gshow (take 10 (genum :: [Tree])) `shouldBe`+                "[Empty,Branch 0 Empty Empty,Branch 0 Empty (Branch 0 Empty Empty),Branch -1 Empty Empty,Branch 0 (Branch 0 Empty Empty) Empty,Branch -1 Empty (Branch 0 Empty Empty),Branch 1 Empty Empty,Branch 0 Empty (Branch 0 Empty (Branch 0 Empty Empty)),Branch -1 (Branch 0 Empty Empty) Empty,Branch 1 Empty (Branch 0 Empty Empty)]"++    describe "Tests for List" $ do+        it "gshow (gmap fromEnum list)" $+            gshow (gmap fromEnum list) `shouldBe`+                "Cons 112 (Cons 113 Nil)"++        it "gshow (gmap gshow listlist)" $+            gshow (gmap gshow listlist) `shouldBe`+                "Cons \"Cons 'p' (Cons 'q' Nil)\" (Cons \"Nil\" Nil)"++        it "gshow list" $+            gshow list `shouldBe`+                "Cons 'p' (Cons 'q' Nil)"++        it "gshow listlist" $+            gshow listlist `shouldBe`+                "Cons (Cons 'p' (Cons 'q' Nil)) (Cons Nil Nil)"++        it "gshow (children list)" $+            gshow (children list) `shouldBe`+                "[Cons 'q' Nil]"++        it "gshow (children listlist)" $+            gshow (children listlist) `shouldBe`+                "[Cons Nil Nil]"++    describe "Tests for Rose" $ do+        it "gshow rose1" $+            gshow rose1 `shouldBe`+                "Rose [1,2] [Rose [3,4] [],Rose [5] []]"++        it "gshow (gmap gshow rose1)" $+            gshow (gmap gshow rose1) `shouldBe`+                "Rose [\"1\",\"2\"] [Rose [\"3\",\"4\"] [],Rose [\"5\"] []]"++    describe "Tests for GRose" $ do+        it "gshow grose1" $+            gshow grose1 `shouldBe`+                "GRose [1,2] [GRose [3] [],GRose [] []]"++        it "gshow (gmap gshow grose1)" $+            gshow (gmap gshow grose1) `shouldBe`+                "GRose [\"1\",\"2\"] [GRose [\"3\"] [],GRose [] []]"++    describe "Tests for Either" $ do+        it "gshow either1" $+            gshow either1 `shouldBe`+                "Left Right 'p'"++        it "gshow (gmap gshow either1)" $+            gshow (gmap gshow either1) `shouldBe`+                "Left Right \"'p'\""++    describe "Tests for Nested" $ do+        it "gshow nested" $+            gshow nested `shouldBe`+                "Nested {value = 1, rec = Nested {value = [2], rec = Nested {value = [[3],[4,5],[]], rec = Leaf}}}"++        it "gshow (gmap gshow nested)" $+            gshow (gmap gshow nested) `shouldBe`+                "Nested {value = \"1\", rec = Nested {value = [\"2\"], rec = Nested {value = [[\"3\"],[\"4\",\"5\"],[]], rec = Leaf}}}"++    describe "Tests for Bush" $ do+        it "gshow bush1" $+            gshow bush1 `shouldBe`+                "BushCons 0 (BushCons (BushCons 1 BushNil) BushNil)"++        it "gshow (gmap gshow bush1)" $+            gshow (gmap gshow bush1) `shouldBe`+                "BushCons \"0\" (BushCons (BushCons \"1\" BushNil) BushNil)"