diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +Version 1.3.1 +--------------- +* Added missing markdown-unlit dependency +* Strictified one argument of Rank2.<$> and Rank2.<*> + Version 1.3 --------------- * Added `newtype Flip` to exports - PR by Jeremy List diff --git a/rank2classes.cabal b/rank2classes.cabal --- a/rank2classes.cabal +++ b/rank2classes.cabal @@ -1,5 +1,5 @@ name: rank2classes -version: 1.3 +version: 1.3.1 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,7 +15,7 @@ copyright: (c) 2017 Mario Blažević category: Control, Data, Generics build-type: Simple --- extra-source-files: +-- extra-source-files: cabal-version: >=1.10 extra-source-files: README.md, CHANGELOG.md, test/README.lhs source-repository head @@ -48,6 +48,7 @@ main-is: Doctest.hs ghc-options: -threaded -pgmL markdown-unlit build-depends: base, rank2classes, doctest >= 0.8 + build-tool-depends: markdown-unlit:markdown-unlit >= 0.5 && < 0.6 test-suite TH if !flag(use-template-haskell) @@ -59,3 +60,4 @@ ghc-options: -threaded -pgmL markdown-unlit build-depends: base, rank2classes, distributive < 0.7, tasty < 2, tasty-hunit < 1 + build-tool-depends: markdown-unlit:markdown-unlit >= 0.5 && < 0.6 diff --git a/src/Rank2.hs b/src/Rank2.hs --- a/src/Rank2.hs +++ b/src/Rank2.hs @@ -208,7 +208,7 @@ f <$> Identity g = Identity (f <$> g) instance (Functor g, Functor h) => Functor (Product g h) where - f <$> ~(Pair a b) = Pair (f <$> a) (f <$> b) + f <$> Pair a b = Pair (f <$> a) (f <$> b) instance (Functor g, Functor h) => Functor (Sum g h) where f <$> InL g = InL (f <$> g) @@ -227,7 +227,7 @@ foldMap f (Identity g) = foldMap f g instance (Foldable g, Foldable h) => Foldable (Product g h) where - foldMap f ~(Pair g h) = foldMap f g `mappend` foldMap f h + foldMap f (Pair g h) = foldMap f g `mappend` foldMap f h instance (Foldable g, Foldable h) => Foldable (Sum g h) where foldMap f (InL g) = foldMap f g @@ -246,7 +246,7 @@ traverse f (Identity g) = Identity Rank1.<$> traverse f g instance (Traversable g, Traversable h) => Traversable (Product g h) where - traverse f ~(Pair g h) = Rank1.liftA2 Pair (traverse f g) (traverse f h) + traverse f (Pair g h) = Rank1.liftA2 Pair (traverse f g) (traverse f h) instance (Traversable g, Traversable h) => Traversable (Sum g h) where traverse f (InL g) = InL Rank1.<$> traverse f g @@ -269,8 +269,9 @@ liftA2 f (Identity g) (Identity h) = Identity (liftA2 f g h) instance (Apply g, Apply h) => Apply (Product g h) where - ~(Pair gf hf) <*> ~(Pair gx hx) = Pair (gf <*> gx) (hf <*> hx) - liftA2 f ~(Pair g1 h1) ~(Pair g2 h2) = Pair (liftA2 f g1 g2) (liftA2 f h1 h2) + Pair gf hf <*> ~(Pair gx hx) = Pair (gf <*> gx) (hf <*> hx) + liftA2 f (Pair g1 h1) ~(Pair g2 h2) = Pair (liftA2 f g1 g2) (liftA2 f h1 h2) + liftA3 f (Pair g1 h1) ~(Pair g2 h2) ~(Pair g3 h3) = Pair (liftA3 f g1 g2 g3) (liftA3 f h1 h2 h3) instance Applicative Empty where pure = const Empty diff --git a/src/Rank2/TH.hs b/src/Rank2/TH.hs --- a/src/Rank2/TH.hs +++ b/src/Rank2/TH.hs @@ -171,7 +171,7 @@ ((,) fieldName <$>) <$> genFmapField (varE f) fieldType (appE (varE fieldName) (varE x)) id constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields - (,) constraints <$> clause [varP f, varP x] body [] + (,) constraints <$> clause [varP f, bangP (varP x)] body [] genFmapClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) = do Just (Deriving tyConName _tyVar) <- getQ putQ (Deriving tyConName tyVar) @@ -214,7 +214,7 @@ newNamedField (fieldName, _, fieldType) = fieldExp fieldName (genLiftA2Field unsafely (varE f) fieldType (getFieldOf x) (getFieldOf y) id) where getFieldOf = appE (varE fieldName) . varE - clause [varP f, varP x, varP y] body [] + clause [varP f, bangP (varP x), varP y] body [] genLiftA2Field :: Bool -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp genLiftA2Field unsafely fun fieldType field1Access field2Access wrap = do @@ -253,7 +253,7 @@ newNamedField (fieldName, _, fieldType) = fieldExp fieldName (genLiftA3Field unsafely (varE f) fieldType (getFieldOf x) (getFieldOf y) (getFieldOf z) id) where getFieldOf = appE (varE fieldName) . varE - clause [varP f, varP x, varP y, varP z] body [] + clause [varP f, bangP (varP x), varP y, varP z] body [] genLiftA3Field :: Bool -> Q Exp -> Type -> Q Exp -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp genLiftA3Field unsafely fun fieldType field1Access field2Access field3Access wrap = do @@ -294,7 +294,7 @@ ((,) fieldName <$>) <$> genApField unsafely fieldType (getFieldOf x) (getFieldOf y) id where getFieldOf = appE (varE fieldName) . varE constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields - (,) constraints <$> clause [varP x, varP y] body [] + (,) constraints <$> clause [varP x, bangP (varP y)] body [] genApClause unsafely (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) = do Just (Deriving tyConName _tyVar) <- getQ putQ (Deriving tyConName tyVar) @@ -370,7 +370,7 @@ newField :: VarBangType -> Q ([Type], Exp) newField (fieldName, _, fieldType) = genFoldMapField f fieldType (appE (varE fieldName) (varE x)) id constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields - (,) constraints <$> clause [varP f, varP x] (normalB body) [] + (,) constraints <$> clause [varP f, bangP (varP x)] (normalB body) [] genFoldMapClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) = do Just (Deriving tyConName _tyVar) <- getQ putQ (Deriving tyConName tyVar) @@ -419,7 +419,7 @@ newField :: VarBangType -> Q ([Type], Exp) newField (fieldName, _, fieldType) = genTraverseField (varE f) fieldType (appE (varE fieldName) (varE x)) id constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields - (,) constraints <$> clause [varP f, varP x] body [] + (,) constraints <$> clause [varP f, bangP (varP x)] body [] genTraverseClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) = do Just (Deriving tyConName _tyVar) <- getQ putQ (Deriving tyConName tyVar)