product-profunctors 0.6 → 0.6.1

raw patch · 4 files changed

+64/−26 lines, 4 filesdep ~profunctorsdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: profunctors, template-haskell

API changes (from Hackage documentation)

Files

• Data/Profunctor/Product.hs +1/−0
• Data/Profunctor/Product/Default.hs +39/−0
• Data/Profunctor/Product/TH.hs +21/−23
• product-profunctors.cabal +3/−3

@@ -61,6 +61,7 @@   empty :: p () ()   (***!) :: p a b -> p a' b' -> p (a, a') (b, b') +-- This appears to be just 'Data.Functor.Contravariant.Divisible' class Contravariant f => ProductContravariant f where   point :: f ()   (***<) :: f a -> f b -> f (a, b)

@@ -102,6 +102,18 @@           Default p a3 b3, Default p a4 b4, Default p a5 b5,           Default p a6 b6, Default p a7 b7, Default p a8 b8,           Default p a9 b9, Default p a10 b10, Default p a11 b11,+          Default p a12 b12, Default p a13 b13)+         => Default p (a1, a2, a3, a4, a5, a6, a7, a8,+                       a9, a10, a11, a12, a13)+                      (b1, b2, b3, b4, b5, b6, b7, b8,+                      b9, b10, b11, b12, b13) where+  def = p13 (def, def, def, def, def, def, def, def, def, def,+             def, def, def)++instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2,+          Default p a3 b3, Default p a4 b4, Default p a5 b5,+          Default p a6 b6, Default p a7 b7, Default p a8 b8,+          Default p a9 b9, Default p a10 b10, Default p a11 b11,           Default p a12 b12, Default p a13 b13, Default p a14 b14)          => Default p (a1, a2, a3, a4, a5, a6, a7, a8,                        a9, a10, a11, a12, a13, a14)@@ -134,3 +146,30 @@                       b9, b10, b11, b12, b13, b14, b15, b16) where   def = p16 (def, def, def, def, def, def, def, def, def, def,              def, def, def, def, def, def)++instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2,+          Default p a3 b3, Default p a4 b4, Default p a5 b5,+          Default p a6 b6, Default p a7 b7, Default p a8 b8,+          Default p a9 b9, Default p a10 b10, Default p a11 b11,+          Default p a12 b12, Default p a13 b13, Default p a14 b14,+          Default p a15 b15, Default p a16 b16, Default p a17 b17)+         => Default p (a1, a2, a3, a4, a5, a6, a7, a8,+                       a9, a10, a11, a12, a13, a14, a15, a16, a17)+                      (b1, b2, b3, b4, b5, b6, b7, b8,+                      b9, b10, b11, b12, b13, b14, b15, b16, b17) where+  def = p17 (def, def, def, def, def, def, def, def, def, def,+             def, def, def, def, def, def, def)++instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2,+          Default p a3 b3, Default p a4 b4, Default p a5 b5,+          Default p a6 b6, Default p a7 b7, Default p a8 b8,+          Default p a9 b9, Default p a10 b10, Default p a11 b11,+          Default p a12 b12, Default p a13 b13, Default p a14 b14,+          Default p a15 b15, Default p a16 b16, Default p a17 b17,+          Default p a18 b18)+         => Default p (a1, a2, a3, a4, a5, a6, a7, a8,+                       a9, a10, a11, a12, a13, a14, a15, a16, a17, a18)+                      (b1, b2, b3, b4, b5, b6, b7, b8,+                      b9, b10, b11, b12, b13, b14, b15, b16, b17, b18) where+  def = p18 (def, def, def, def, def, def, def, def, def, def,+             def, def, def, def, def, def, def, def)

@@ -18,20 +18,12 @@ -- \"adaptor\" with the following import and splice: -- -- @--- import Data.Profunctor.Product (p\<n\>)--- -- $(makeAdaptorAndInstance \"pFoo\" ''Foo) -- @ ----- * \<n\> is the number of fields in your record, so for Foo \<n\> would be 3.--- -- * The adaptor for a type Foo is by convention called pFoo, but in -- practice you can call it anything. ----- Notice that currently the Template Haskell requires you import p<n>--- manually.  This is because it is badly written and this restriction--- will go away in a future release.--- -- The instance generated will be -- -- @@@ -58,22 +50,24 @@                             Con(RecC, NormalC),                             Strict(NotStrict), Clause(Clause),                             Type(VarT, ForallT, AppT, ArrowT, ConT),-                            Body(NormalB), Q, Pred(ClassP),+                            Body(NormalB), Q, classP,                             Exp(ConE, VarE, InfixE, AppE, TupE),                             Pat(TupP, VarP, ConP), Name,                             Info(TyConI), reify) import Control.Monad ((<=<))+import Control.Applicative ((<$>), (<*>))+import Control.Arrow (second)  makeAdaptorAndInstance :: String -> Name -> Q [Dec] makeAdaptorAndInstance adaptorNameS = returnOrFail <=< r makeAandIE <=< reify   where r = (return .)-        returnOrFail (Right decs) = return decs+        returnOrFail (Right decs) = decs         returnOrFail (Left errMsg) = fail errMsg         makeAandIE = makeAdaptorAndInstanceE adaptorNameS  type Error = String -makeAdaptorAndInstanceE :: String -> Info -> Either Error [Dec]+makeAdaptorAndInstanceE :: String -> Info -> Either Error (Q [Dec]) makeAdaptorAndInstanceE adaptorNameS info = do   (tyName, tyVars, conName, conTys) <- dataDecStuffOfInfo info   let numTyVars = length tyVars@@ -84,7 +78,7 @@       instanceDefinition' = instanceDefinition tyName numTyVars numConTys                                                adaptorNameN conName -  return [adaptorSig', adaptorDefinition', instanceDefinition']+  return ((\a b -> [a, adaptorDefinition', b]) <$> adaptorSig' <*> instanceDefinition')  -- TODO: support newtypes? dataDecStuffOfInfo :: Info -> Either Error (Name, [Name], Name, [Name])@@ -137,9 +131,11 @@   datatype' = datatype tyName' tyVars conName derivings  makeRecord :: MakeRecordT -> Q [Dec]-makeRecord r = return decs+makeRecord r = decs   where MakeRecordT tyName conName tyVars derivings _ = r-        decs = [datatype', adaptorSig', adaptorDefinition', instanceDefinition']+        decs = (\a i -> [datatype', a, adaptorDefinition', i])+               <$> adaptorSig'+               <*> instanceDefinition'         tyName' = mkName tyName         conName' = mkName conName @@ -164,18 +160,20 @@         toField s = (mkName s, NotStrict, VarT (mkName s))         derivings' = map mkName derivings -instanceDefinition :: Name -> Int -> Int -> Name -> Name -> Dec+instanceDefinition :: Name -> Int -> Int -> Name -> Name -> Q Dec instanceDefinition tyName' numTyVars numConVars adaptorName' conName=instanceDec-  where instanceDec = InstanceD instanceCxt instanceType [defDefinition]-        instanceCxt = map (uncurry ClassP) (pClass:defClasses)-        pClass = (''ProductProfunctor, [varTS "p"])+  where instanceDec = fmap (\i -> InstanceD i instanceType [defDefinition])+                      instanceCxt+        instanceCxt = mapM (uncurry classP) (pClass:defClasses)+        pClass = (''ProductProfunctor, [return (varTS "p")])          defaultPredOfVar :: String -> (Name, [Type])         defaultPredOfVar fn = (''Default, [varTS "p",                                            mkTySuffix "0" fn,                                            mkTySuffix "1" fn]) -        defClasses = map defaultPredOfVar (allTyVars numTyVars)+        defClasses = map (second (map return) . defaultPredOfVar)+                         (allTyVars numTyVars)          pArg :: String -> Type         pArg s = pArg' tyName' s numTyVars@@ -187,11 +185,11 @@         defBody = NormalB(VarE adaptorName' `AppE` appEAll (ConE conName) defsN)         defsN = replicate numConVars (VarE 'def) -adaptorSig :: Name -> Int -> Name -> Dec-adaptorSig tyName' numTyVars = flip SigD adaptorType-  where adaptorType = ForallT scope adaptorCxt adaptorAfterCxt+adaptorSig :: Name -> Int -> Name -> Q Dec+adaptorSig tyName' numTyVars n = fmap (SigD n) adaptorType+  where adaptorType = fmap (\a -> ForallT scope a adaptorAfterCxt) adaptorCxt         adaptorAfterCxt = before `appArrow` after-        adaptorCxt = [ClassP ''ProductProfunctor [VarT (mkName "p")]]+        adaptorCxt = fmap (:[]) (classP ''ProductProfunctor [return (VarT (mkName "p"))])         before = appTAll (ConT tyName') pArgs         pType = VarT (mkName "p")         pArgs = map pApp tyVars

@@ -1,5 +1,5 @@ name:          product-profunctors-version:       0.6+version:       0.6.1 synopsis:      product-profunctors description:   Product profunctors homepage:      https://github.com/tomjaguarpaw/product-profunctors@@ -17,8 +17,8 @@  library   build-depends:   base >= 4 && < 5-                 , profunctors >= 4.0 && < 4.3-                 , contravariant >= 0.4 && < 1.3+                 , profunctors >= 4.0 && < 4.5+                 , contravariant >= 0.4 && < 1.4                  , template-haskell   exposed-modules: Data.Profunctor.Product,                    Data.Profunctor.Product.Default,