rank2classes 1.0.1 → 1.0.2
raw patch · 6 files changed
+39/−25 lines, 6 filesdep ~basedep ~template-haskell
Dependency ranges changed: base, template-haskell
Files
- CHANGELOG.md +6/−0
- README.md +2/−2
- rank2classes.cabal +3/−3
- src/Rank2.hs +14/−6
- src/Rank2/TH.hs +12/−12
- test/README.lhs +2/−2
CHANGELOG.md view
@@ -1,3 +1,9 @@+Version 1.0.2+---------------+* Fixed the bounds and Semigroup to compile with GHC 8.4.1+* Added the ~> type synonym+* Fixed deriveFunctor for record fields with concrete types - PR by Tom Smalley+ Version 1.0.1 --------------- * Fixed the doctests
README.md view
@@ -6,7 +6,7 @@ The rank2 package exports module `Rank2`, meant to be imported qualified like this: ~~~ {.haskell}-{-# LANGUAGE RankNTypes, TemplateHaskell #-}+{-# LANGUAGE RankNTypes, TemplateHaskell, TypeOperators #-} module MyModule where import qualified Rank2 import qualified Rank2.TH@@ -100,7 +100,7 @@ as a field-by-field person verifier: ~~~ {.haskell}-personChecker :: PersonDatabase -> Person (Rank2.Arrow (Const String) (Either String))+personChecker :: PersonDatabase -> Person (Const String Rank2.~> Either String) personChecker db = Person{name= Rank2.Arrow (Right . getConst), age= Rank2.Arrow $ \(Const age)->
rank2classes.cabal view
@@ -1,5 +1,5 @@ name: rank2classes-version: 1.0.1+version: 1.0.2 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@@ -28,8 +28,8 @@ default-language: Haskell2010 -- other-modules: ghc-options: -Wall- build-depends: base >=4.7 && <5,- template-haskell >= 2.11 && < 2.13,+ build-depends: base >=4.9 && <5,+ template-haskell >= 2.11 && < 2.14, transformers >= 0.5 && < 0.6 -- hs-source-dirs: default-language: Haskell2010
src/Rank2.hs view
@@ -5,13 +5,14 @@ -- This will bring into scope the standard classes 'Functor', 'Applicative', 'Foldable', and 'Traversable', but with a -- @Rank2.@ prefix and a twist that their methods operate on a heterogenous collection. The same property is shared by -- the two less standard classes 'Apply' and 'Distributive'.-{-# LANGUAGE InstanceSigs, KindSignatures, Rank2Types, ScopedTypeVariables, PolyKinds, DefaultSignatures #-}+{-# LANGUAGE DefaultSignatures, InstanceSigs, KindSignatures, PolyKinds, Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables, TypeOperators #-} module Rank2 ( -- * Rank 2 classes Functor(..), Apply(..), Applicative(..), Foldable(..), Traversable(..), Distributive(..), DistributiveTraversable(..), distributeJoin, -- * Rank 2 data types- Compose(..), Empty(..), Only(..), Identity(..), Product(..), Arrow(..),+ Compose(..), Empty(..), Only(..), Identity(..), Product(..), Arrow(..), type (~>), -- * Method synonyms and helper functions ap, fmap, liftA4, liftA5, fmapTraverse, liftA2Traverse1, liftA2Traverse2, liftA2TraverseBoth,@@ -22,7 +23,8 @@ import qualified Control.Monad as Rank1 import qualified Data.Foldable as Rank1 import qualified Data.Traversable as Rank1-import Data.Monoid (Monoid(..), (<>))+import Data.Semigroup (Semigroup(..))+import Data.Monoid (Monoid(..)) import Data.Functor.Compose (Compose(..)) import Prelude hiding (Foldable(..), Traversable(..), Functor(..), Applicative(..), (<$>), fst, snd)@@ -54,13 +56,16 @@ -- | Wrapper for functions that map the argument constructor type newtype Arrow p q a = Arrow{apply :: p a -> q a} +type (~>) = Arrow+infixr 0 ~>+ -- | Subclass of 'Functor' halfway to 'Applicative', satisfying -- -- > (.) <$> u <*> v <*> w == u <*> (v <*> w) class Functor g => Apply g where {-# MINIMAL liftA2 | (<*>) #-} -- | Equivalent of 'Rank1.<*>' for rank 2 data types- (<*>) :: g (Arrow p q) -> g p -> g q+ (<*>) :: g (p ~> q) -> g p -> g q -- | Equivalent of 'Rank1.liftA2' for rank 2 data types liftA2 :: (forall a. p a -> q a -> r a) -> g p -> g q -> g r -- | Equivalent of 'Rank1.liftA3' for rank 2 data types@@ -77,7 +82,7 @@ liftA5 f g1 g2 g3 g4 g5 = liftA4 (\p q r s-> Arrow (f p q r s)) g1 g2 g3 g4 <*> g5 -- | Alphabetical synonym for '<*>'-ap :: Apply g => g (Arrow p q) -> g p -> g q+ap :: Apply g => g (p ~> q) -> g p -> g q ap = (<*>) -- | Equivalent of 'Rank1.Applicative' for rank 2 data types@@ -159,6 +164,9 @@ newtype Flip g a f = Flip (g (f a)) deriving (Eq, Ord, Show) +instance Semigroup (g (f a)) => Semigroup (Flip g a f) where+ Flip x <> Flip y = Flip (x <> y)+ instance Monoid (g (f a)) => Monoid (Flip g a f) where mempty = Flip mempty Flip x `mappend` Flip y = Flip (x `mappend` y)@@ -200,7 +208,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 <> foldMap f h+ foldMap f ~(Pair g h) = foldMap f g `mappend` foldMap f h instance Traversable Empty where traverse _ _ = Rank1.pure Empty
src/Rank2/TH.hs view
@@ -21,7 +21,7 @@ import qualified Rank2 -data Deriving = Deriving { derivingConstructor :: Name, derivingVariable :: Name }+data Deriving = Deriving { _derivingConstructor :: Name, _derivingVariable :: Name } deriveAll :: Name -> Q [Dec] deriveAll ty = foldr f (pure []) [deriveFunctor, deriveApply, deriveApplicative,@@ -56,12 +56,12 @@ deriveDistributive :: Name -> Q [Dec] deriveDistributive ty = do (instanceType, cs) <- reifyConstructors ''Rank2.Distributive ty- sequence [instanceD (return []) instanceType [genDistributeWith cs]]+ sequence [instanceD (return []) instanceType [genCotraverse cs]] deriveDistributiveTraversable :: Name -> Q [Dec] deriveDistributiveTraversable ty = do (instanceType, cs) <- reifyConstructors ''Rank2.DistributiveTraversable ty- sequence [instanceD (return []) instanceType [genDistributeWithTraversable cs]]+ sequence [instanceD (return []) instanceType [genCotraverseTraversable cs]] reifyConstructors :: Name -> Name -> Q (TypeQ, [Con]) reifyConstructors cls ty = do@@ -100,11 +100,11 @@ genTraverse :: [Con] -> Q Dec genTraverse cs = funD 'Rank2.traverse (map genTraverseClause cs) -genDistributeWith :: [Con] -> Q Dec-genDistributeWith cs = funD 'Rank2.cotraverse (map genDistributeWithClause cs)+genCotraverse :: [Con] -> Q Dec+genCotraverse cs = funD 'Rank2.cotraverse (map genCotraverseClause cs) -genDistributeWithTraversable :: [Con] -> Q Dec-genDistributeWithTraversable cs = funD 'Rank2.cotraverse (map genDistributeWithTraversableClause cs)+genCotraverseTraversable :: [Con] -> Q Dec+genCotraverseTraversable cs = funD 'Rank2.cotraverse (map genCotraverseTraversableClause cs) genFmapClause :: Con -> Q Clause genFmapClause (NormalC name fieldTypes) = do@@ -132,7 +132,7 @@ | ty == VarT typeVar -> fieldExp fieldName [| $(varE f) ($(varE fieldName) $(varE x)) |] AppT _ ty | ty == VarT typeVar -> fieldExp fieldName [| Rank2.fmap $(varE f) ($(varE fieldName) $(varE x)) |]- _ -> fieldExp fieldName [| $(varE x) |]+ _ -> fieldExp fieldName [| $(varE fieldName) $(varE x) |] clause [varP f, varP x] body [] genLiftA2Clause :: Con -> Q Clause@@ -311,8 +311,8 @@ _ -> [| $(varE x) |] clause [varP f, varP x] body [] -genDistributeWithClause :: Con -> Q Clause-genDistributeWithClause (RecC name fields) = do+genCotraverseClause :: Con -> Q Clause+genCotraverseClause (RecC name fields) = do withName <- newName "w" argName <- newName "f" let body = normalB $ recConE name $ map newNamedField fields@@ -327,8 +327,8 @@ fieldExp fieldName [| Rank2.cotraverse $(varE withName) ($(varE fieldName) <$> $(varE argName)) |] clause [varP withName, varP argName] body [] -genDistributeWithTraversableClause :: Con -> Q Clause-genDistributeWithTraversableClause (RecC name fields) = do+genCotraverseTraversableClause :: Con -> Q Clause+genCotraverseTraversableClause (RecC name fields) = do withName <- newName "w" argName <- newName "f" let body = normalB $ recConE name $ map newNamedField fields
test/README.lhs view
@@ -6,7 +6,7 @@ The rank2 package exports module `Rank2`, meant to be imported qualified like this: ~~~ {.haskell}-{-# LANGUAGE RankNTypes, TemplateHaskell #-}+{-# LANGUAGE RankNTypes, TemplateHaskell, TypeOperators #-} module MyModule where import qualified Rank2 import qualified Rank2.TH@@ -100,7 +100,7 @@ as a field-by-field person verifier: ~~~ {.haskell}-personChecker :: PersonDatabase -> Person (Rank2.Arrow (Const String) (Either String))+personChecker :: PersonDatabase -> Person (Const String Rank2.~> Either String) personChecker db = Person{name= Rank2.Arrow (Right . getConst), age= Rank2.Arrow $ \(Const age)->