rank2classes 1.3 → 1.3.1
raw patch · 4 files changed
+21/−13 lines, 4 files
Files
- CHANGELOG.md +5/−0
- rank2classes.cabal +4/−2
- src/Rank2.hs +6/−5
- src/Rank2/TH.hs +6/−6
CHANGELOG.md view
@@ -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
rank2classes.cabal view
@@ -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
src/Rank2.hs view
@@ -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
src/Rank2/TH.hs view
@@ -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)