rank2classes 1.4.2 → 1.4.3
raw patch · 6 files changed
+119/−62 lines, 6 filesdep ~transformers
Dependency ranges changed: transformers
Files
- CHANGELOG.md +6/−0
- rank2classes.cabal +5/−4
- src/Rank2.hs +3/−3
- src/Rank2/TH.hs +1/−1
- test/Issue23.hs +47/−0
- test/TH.hs +57/−54
CHANGELOG.md view
@@ -1,3 +1,9 @@+Version 1.4.3+---------------+* Fixed links to standard rank-1 classes in Haddock documentation+* Fixed issue #23 with the `traverse` template generated for sum types with a fieldless constructor+* Incremented upper dependency bounds+ Version 1.4.2 --------------- * Fixed compatibility with GHC 9 - PR by Felix Yan
rank2classes.cabal view
@@ -1,5 +1,5 @@ name: rank2classes-version: 1.4.2+version: 1.4.3 synopsis: standard type constructor class hierarchy, only with methods of rank 2 types description: A mirror image of the standard type constructor class hierarchy rooted in 'Functor', except with methods of rank 2@@ -15,8 +15,8 @@ copyright: (c) 2017 Mario Blažević category: Control, Data, Generics build-type: Custom--- extra-source-files: cabal-version: >=1.10+tested-with: GHC==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2 extra-source-files: README.md, CHANGELOG.md, test/MyModule.lhs source-repository head type: git@@ -38,8 +38,8 @@ default-language: Haskell2010 -- other-modules: ghc-options: -Wall- build-depends: base >=4.10 && <5,- transformers >= 0.5 && < 0.6,+ build-depends: base >=4.9 && <5,+ transformers >= 0.5 && < 0.7, distributive < 0.7 if flag(use-template-haskell)@@ -63,6 +63,7 @@ hs-source-dirs: test default-language: Haskell2010 main-is: TH.hs+ other-modules: Issue23 ghc-options: -threaded -pgmL markdown-unlit build-depends: base, rank2classes, distributive < 0.7, tasty < 2, tasty-hunit < 1
src/Rank2.hs view
@@ -45,7 +45,7 @@ snd :: Product g h p -> h p snd (Pair _ y) = y --- | Equivalent of 'Functor' for rank 2 data types, satisfying the usual functor laws+-- | Equivalent of 'Rank1.Functor' for rank 2 data types, satisfying the usual functor laws -- -- > id <$> g == g -- > (p . q) <$> g == p <$> (q <$> g)@@ -58,11 +58,11 @@ fmap f g = f <$> g {-# INLINE fmap #-} --- | Equivalent of 'Foldable' for rank 2 data types+-- | Equivalent of 'Rank1.Foldable' for rank 2 data types class Foldable g where foldMap :: Monoid m => (forall a. p a -> m) -> g p -> m --- | Equivalent of 'Traversable' for rank 2 data types+-- | Equivalent of 'Rank1.Traversable' for rank 2 data types class (Functor g, Foldable g) => Traversable g where {-# MINIMAL traverse | sequence #-} traverse :: Rank1.Applicative m => (forall a. p a -> m (q a)) -> g p -> m (g q)
src/Rank2/TH.hs view
@@ -421,7 +421,7 @@ genTraverseClause :: Con -> Q ([Type], Clause) genTraverseClause (NormalC name []) =- (,) [] <$> clause [wildP, wildP] (normalB [| pure $(conE name) |]) []+ (,) [] <$> clause [wildP, conP name []] (normalB [| pure $(conE name) |]) [] genTraverseClause (NormalC name fieldTypes) = do f <- newName "f" fieldNames <- replicateM (length fieldTypes) (newName "x")
+ test/Issue23.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE TemplateHaskell #-}++module Issue23 (test) where++import Data.Functor.Identity+import Data.Functor.Classes+import qualified Rank2+import qualified Rank2.TH++import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase, assertEqual)++data Stm r = Unit | ExpStmt (r Int) (Exp r)+data Exp r = Nil | Cons (r Bool) (Exp r) (Stm r)++instance Show1 r => Show (Stm r) where+ show Unit = "Unit"+ show (ExpStmt r e) = "(Stmt (" ++ showsPrec1 0 r (") " ++ show e ++ ")")+instance Show1 r => Show (Exp r) where+ show Nil = "Nil"+ show (Cons r e s) =+ "(Cons (" ++ showsPrec1 0 r (") " ++ show e ++ " " ++ show s ++ ")")++$(mconcat <$> traverse+ (\derive -> mconcat <$> traverse derive [''Stm, ''Exp])+ [ Rank2.TH.deriveFunctor+ , Rank2.TH.deriveFoldable+ , Rank2.TH.deriveTraversable+ ])++expToMaybe :: Exp Identity -> Exp Maybe+expToMaybe = Rank2.fmap (Just . runIdentity)++maybeToExp :: Exp Maybe -> Maybe (Exp Identity)+maybeToExp = Rank2.traverse (fmap Identity)++myExp :: Exp Identity+myExp = Cons+ (Identity True)+ (Cons (Identity False) Nil (ExpStmt (Identity 2) Nil))+ (ExpStmt (Identity 3) (Cons (Identity True) Nil Unit))++test :: TestTree+test = testCase "Issue #23" $ do+ print myExp+ let myExp' = expToMaybe myExp+ assertEqual "" (show $ Just myExp) (show $ maybeToExp myExp')
test/TH.hs view
@@ -8,6 +8,7 @@ import Data.Functor.Classes (Eq1, Show1, eq1, showsPrec1) import Data.Functor.Compose (Compose(Compose)) import Data.Functor.Identity (Identity(Identity, runIdentity))+import qualified Issue23 import qualified Rank2 import qualified Rank2.TH import Test.Tasty@@ -35,57 +36,59 @@ $(Rank2.TH.deriveAll ''Test0) $(Rank2.TH.deriveAll ''Test1) -main = defaultMain $ testCase "Template test" $- do let test = Test1{single= [3, 4, 5],- whole= Test0,- wrapSingle= pure (pure ["a", "b", "ab"]),- wrapWhole= pure (pure Test0)}- id Rank2.<$> test @?= test- Rank2.pure (Rank2.Arrow id) Rank2.<*> test @?= test- Rank2.liftA2 (++) test test @?= Test1{single= [3, 4, 5, 3, 4, 5],- whole= Test0,- wrapSingle= pure (pure ["a", "b", "ab", "a", "b", "ab"]),- wrapWhole= pure (pure Test0)}- Rank2.foldMap (Sum . length) test @?= Sum 6- Rank2.traverse (map Identity) test @?= [Test1{single= Identity 3,- whole= Test0,- wrapSingle= pure (pure $ Identity "a"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 3,- whole= Test0,- wrapSingle= pure (pure $ Identity "b"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 3,- whole= Test0,- wrapSingle= pure (pure $ Identity "ab"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 4,- whole= Test0,- wrapSingle= pure (pure $ Identity "a"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 4,- whole= Test0,- wrapSingle= pure (pure $ Identity "b"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 4,- whole= Test0,- wrapSingle= pure (pure $ Identity "ab"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 5,- whole= Test0,- wrapSingle= pure (pure $ Identity "a"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 5,- whole= Test0,- wrapSingle= pure (pure $ Identity "b"),- wrapWhole= pure (pure Test0)},- Test1{single= Identity 5,- whole= Test0,- wrapSingle= pure (pure $ Identity "ab"),- wrapWhole= pure (pure Test0)}- ]- Rank2.distribute (Identity test) @?= Test1{single= Compose (Identity [3, 4, 5]),- whole= Test0,- wrapSingle= pure (pure $ Compose $ Identity ["a", "b", "ab"]),- wrapWhole= pure (pure Test0)}- Rank2.cotraverse (take 1 . map runIdentity) (Rank2.traverse (map Identity) test) @?= take 1 Rank2.<$> test+main = defaultMain $ testGroup "Template tests"+ [ testCase "Simple template test" $+ do let test = Test1{single= [3, 4, 5],+ whole= Test0,+ wrapSingle= pure (pure ["a", "b", "ab"]),+ wrapWhole= pure (pure Test0)}+ id Rank2.<$> test @?= test+ Rank2.pure (Rank2.Arrow id) Rank2.<*> test @?= test+ Rank2.liftA2 (++) test test @?= Test1{single= [3, 4, 5, 3, 4, 5],+ whole= Test0,+ wrapSingle= pure (pure ["a", "b", "ab", "a", "b", "ab"]),+ wrapWhole= pure (pure Test0)}+ Rank2.foldMap (Sum . length) test @?= Sum 6+ Rank2.traverse (map Identity) test @?= [Test1{single= Identity 3,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "a"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 3,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "b"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 3,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "ab"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 4,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "a"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 4,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "b"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 4,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "ab"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 5,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "a"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 5,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "b"),+ wrapWhole= pure (pure Test0)},+ Test1{single= Identity 5,+ whole= Test0,+ wrapSingle= pure (pure $ Identity "ab"),+ wrapWhole= pure (pure Test0)}+ ]+ Rank2.distribute (Identity test) @?= Test1{single= Compose (Identity [3, 4, 5]),+ whole= Test0,+ wrapSingle= pure (pure $ Compose $ Identity ["a", "b", "ab"]),+ wrapWhole= pure (pure Test0)}+ Rank2.cotraverse (take 1 . map runIdentity) (Rank2.traverse (map Identity) test) @?= take 1 Rank2.<$> test,+ Issue23.test]