generics-sop 0.2.0.0 → 0.2.1.0

raw patch · 10 files changed

+120/−20 lines, 10 filesdep ~ghc-primdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-prim, template-haskell

API changes (from Hackage documentation)

Files

• generics-sop.cabal +4/−4
• src/Generics/SOP.hs +9/−1
• src/Generics/SOP/Classes.hs +1/−1
• src/Generics/SOP/Constraint.hs +6/−3
• src/Generics/SOP/GGP.hs +14/−8
• src/Generics/SOP/Instances.hs +5/−0
• src/Generics/SOP/NP.hs +37/−1
• src/Generics/SOP/NS.hs +11/−2
• src/Generics/SOP/TH.hs +30/−0
• src/Generics/SOP/Universe.hs +3/−0

@@ -1,5 +1,5 @@ name:                generics-sop-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Generic Programming using True Sums of Products description:   A library to support the definition of generic functions.@@ -36,7 +36,7 @@ category:            Generics build-type:          Simple cabal-version:       >=1.10-tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2+tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1  source-repository head   type:                git@@ -58,8 +58,8 @@                        Generics.SOP.Universe                        Generics.SOP.Sing   build-depends:       base                 >= 4.6  && < 5,-                       template-haskell     >= 2.8  && < 2.11,-                       ghc-prim             >= 0.3  && < 0.5+                       template-haskell     >= 2.8  && < 2.12,+                       ghc-prim             >= 0.3  && < 0.6   if impl (ghc < 7.8)     build-depends:     tagged               >= 0.7  && < 0.9 

@@ -239,8 +239,14 @@     -- * Combinators     -- ** Constructing products   , HPure(..)+    -- ** Destructing products+  , hd+  , tl+  , Projection+  , projections+  , shiftProjection     -- ** Application-  , (-.->)(..)+  , type (-.->)(..)   , fn   , fn_2   , fn_3@@ -264,6 +270,7 @@   , Injection   , injections   , shift+  , shiftInjection   , apInjs_NP   , apInjs_POP     -- ** Dealing with @'All' c@@@ -297,6 +304,7 @@     -- ** Singletons   , SList(..)   , SListI(..)+  , SListI2   , Sing   , SingI(..)     -- *** Shape of type-level lists

@@ -117,7 +117,7 @@   -- | Corresponds to 'Control.Applicative.<*>'.   --   -- For products ('Generics.SOP.NP.NP') as well as products of products-  -- ('Generics.SOP.NP.POP), the correspondence is rather direct. We combine+  -- ('Generics.SOP.NP.POP'), the correspondence is rather direct. We combine   -- a structure containing (lifted) functions and a compatible structure   -- containing corresponding arguments into a compatible structure   -- containing results.

@@ -2,6 +2,9 @@ #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #endif+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE UndecidableSuperClasses #-}+#endif {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} -- | Constraints for indexed datatypes. --@@ -44,8 +47,8 @@ -- | Type family used to implement 'All'. -- type family AllF (c :: k -> Constraint) (xs :: [k]) :: Constraint-type instance AllF c '[]       = ()-type instance AllF c (x ': xs) = (c x, All c xs)+type instance AllF _c '[]       = ()+type instance AllF  c (x ': xs) = (c x, All c xs)  -- | Require a singleton for every inner list in a list of lists. type SListI2 = All SListI@@ -135,5 +138,5 @@ #if __GLASGOW_HASKELL__ >= 710   {-# OVERLAPPING #-} #endif-  All SListI xss => SingI (xss :: [[k]]) where+  (All SListI xss, SListI xss) => SingI (xss :: [[k]]) where   sing = sList

@@ -27,20 +27,24 @@ import Generics.SOP.Sing  type family ToSingleCode (a :: * -> *) :: *-type instance ToSingleCode (K1 i a) = a+type instance ToSingleCode (K1 _i a) = a  type family ToProductCode (a :: * -> *) (xs :: [*]) :: [*]-type instance ToProductCode (a :*: b)  xs = ToProductCode a (ToProductCode b xs)-type instance ToProductCode U1         xs = xs-type instance ToProductCode (M1 S c a) xs = ToSingleCode a ': xs+type instance ToProductCode (a :*: b)   xs = ToProductCode a (ToProductCode b xs)+type instance ToProductCode U1          xs = xs+type instance ToProductCode (M1 S _c a) xs = ToSingleCode a ': xs  type family ToSumCode (a :: * -> *) (xs :: [[*]]) :: [[*]]-type instance ToSumCode (a :+: b)  xs = ToSumCode a (ToSumCode b xs)-type instance ToSumCode V1         xs = xs-type instance ToSumCode (M1 D c a) xs = ToSumCode a xs-type instance ToSumCode (M1 C c a) xs = ToProductCode a '[] ': xs+type instance ToSumCode (a :+: b)   xs = ToSumCode a (ToSumCode b xs)+type instance ToSumCode V1          xs = xs+type instance ToSumCode (M1 D _c a) xs = ToSumCode a xs+type instance ToSumCode (M1 C _c a) xs = ToProductCode a '[] ': xs +#if MIN_VERSION_base(4,9,0)+data InfoProxy (c :: Meta) (f :: * -> *) (x :: *) = InfoProxy+#else data InfoProxy (c :: *) (f :: * -> *) (x :: *) = InfoProxy+#endif  class GDatatypeInfo' (a :: * -> *) where   gDatatypeInfo' :: proxy a -> DatatypeInfo (ToSumCode a '[])@@ -149,7 +153,9 @@  instance GSingleTo a => GProductTo (M1 S c a) where   gProductTo (SOP.I a :* xs) k = k (M1 (gSingleTo a)) xs+#if __GLASGOW_HASKELL__ < 800   gProductTo _               _ = error "inaccessible"+#endif  instance GProductTo U1 where   gProductTo xs k = k U1 xs

@@ -1,6 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -freduction-depth=100 #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}+#else {-# OPTIONS_GHC -fcontext-stack=50 #-}+#endif -- | Instances for 'Generic' and 'HasMetadata'. -- -- We define instances for datatypes from @generics-sop@ and

@@ -15,6 +15,12 @@     -- * Application   , ap_NP   , ap_POP+    -- * Destructing products+  , hd+  , tl+  , Projection+  , projections+  , shiftProjection     -- * Lifting / mapping   , liftA_NP   , liftA_POP@@ -219,7 +225,9 @@ ap_NP :: NP (f -.-> g) xs -> NP f xs -> NP g xs ap_NP Nil           Nil        = Nil ap_NP (Fn f :* fs)  (x :* xs)  = f x :* ap_NP fs xs+#if __GLASGOW_HASKELL__ < 800 ap_NP _ _ = error "inaccessible"+#endif  -- | Specialization of 'hap'. --@@ -232,7 +240,9 @@     go :: NP (NP (f -.-> g)) xss -> NP (NP f) xss -> NP (NP g) xss     go Nil         Nil         = Nil     go (fs :* fss) (xs :* xss) = ap_NP fs xs :* go fss xss+#if __GLASGOW_HASKELL__ < 800     go _           _           = error "inaccessible"+#endif  -- The definition of 'ap_POP' is a more direct variant of -- '_ap_POP_spec'. The direct definition has the advantage@@ -246,6 +256,32 @@ instance HAp NP  where hap = ap_NP instance HAp POP where hap = ap_POP +-- * Destructing products++-- | Obtain the head of an n-ary product.+hd :: NP f (x ': xs) -> f x+hd (x :* _xs) = x++-- | Obtain the tail of an n-ary product.+tl :: NP f (x ': xs) -> NP f xs+tl (_x :* xs) = xs++-- | The type of projections from an n-ary product.+--+type Projection (f :: k -> *) (xs :: [k]) = K (NP f xs) -.-> f++-- | Compute all projections from an n-ary product.+--+-- Each element of the resulting product contains one of the projections.+--+projections :: forall xs f . SListI xs => NP (Projection f xs) xs+projections = case sList :: SList xs of+  SNil  -> Nil+  SCons -> fn (hd . unK) :* liftA_NP shiftProjection projections++shiftProjection :: Projection f xs a -> Projection f (x ': xs) a+shiftProjection (Fn f) = Fn $ f . K . tl . unK+ -- * Lifting / mapping  -- | Specialization of 'hliftA'.@@ -364,7 +400,7 @@ -- 'hcliftA'' :: 'All2' c xss => proxy c -> (forall xs. 'All' c xs => f xs -> f' xs) -> 'Generics.SOP.NS.NS' f xss -> 'Generics.SOP.NS.NS' f' xss -- @ ---{-# DEPRECATED hcliftA' "Use 'hclift' or 'hcmap' instead." #-}+{-# DEPRECATED hcliftA' "Use 'hcliftA' or 'hcmap' instead." #-} hcliftA'  :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs)                                                       -> h f   xss -> h f'   xss  -- | Like 'hcliftA'', but for binary functions.

@@ -10,6 +10,7 @@   , Injection   , injections   , shift+  , shiftInjection   , apInjs_NP   , apInjs_POP     -- * Application@@ -143,14 +144,22 @@ injections :: forall xs f. SListI xs => NP (Injection f xs) xs injections = case sList :: SList xs of   SNil   -> Nil-  SCons  -> fn (K . Z) :* liftA_NP shift injections+  SCons  -> fn (K . Z) :* liftA_NP shiftInjection injections  -- | Shift an injection. -- -- Given an injection, return an injection into a sum that is one component larger. --+shiftInjection :: Injection f xs a -> Injection f (x ': xs) a+shiftInjection (Fn f) = Fn $ K . S . unK . f++{-# DEPRECATED shift "Use 'shiftInjection' instead." #-}+-- | Shift an injection.+--+-- Given an injection, return an injection into a sum that is one component larger.+-- shift :: Injection f xs a -> Injection f (x ': xs) a-shift (Fn f) = Fn $ K . S . unK . f+shift = shiftInjection  -- | Apply injections to a product. --

@@ -130,7 +130,11 @@              , funD datatypeInfoName' [clause [] (normalB $ metadata' isNewtype name cons) []] -- treeDatatypeInfo = ...              ] +#if MIN_VERSION_template_haskell(2,11,0)+deriveGenericForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> Cxt -> Q [Dec]+#else deriveGenericForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Q [Dec]+#endif deriveGenericForDataDec _isNewtype _cxt name bndrs cons _derivs = do   let typ = appTyVars name bndrs #if MIN_VERSION_template_haskell(2,9,0)@@ -144,7 +148,11 @@             [codeSyn, embedding 'from cons, projection 'to cons]   return [inst] +#if MIN_VERSION_template_haskell(2,11,0)+deriveMetadataForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> Cxt -> Q [Dec]+#else deriveMetadataForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Q [Dec]+#endif deriveMetadataForDataDec isNewtype _cxt name bndrs cons _derivs = do   let typ = appTyVars name bndrs   md   <- instanceD (cxt [])@@ -230,12 +238,24 @@                                            $(npE (map mdField ts))                              |]     mdCon (InfixC _ n _)  = do+#if MIN_VERSION_template_haskell(2,11,0)+      fixity <- reifyFixity n+      case fromMaybe defaultFixity fixity of+        Fixity f a ->+#else       i <- reify n       case i of         DataConI _ _ _ (Fixity f a) ->+#endif                             [| Infix       $(stringE (nameBase n)) $(mdAssociativity a) f |]+#if !MIN_VERSION_template_haskell(2,11,0)         _                -> fail "Strange infix operator"+#endif     mdCon (ForallC _ _ _) = fail "Existentials not supported"+#if MIN_VERSION_template_haskell(2,11,0)+    mdCon (GadtC _ _ _)    = fail "GADTs not supported"+    mdCon (RecGadtC _ _ _) = fail "GADTs not supported"+#endif      mdField :: VarStrictType -> Q Exp     mdField (n, _, _) = [| FieldInfo $(stringE (nameBase n)) |]@@ -277,6 +297,10 @@ conInfo (RecC    n ts) = return (n, map (return . (\(_, _, t) -> t)) ts) conInfo (InfixC (_, t) n (_, t')) = return (n, map return [t, t']) conInfo (ForallC _ _ _) = fail "Existentials not supported"+#if MIN_VERSION_template_haskell(2,11,0)+conInfo (GadtC _ _ _)    = fail "GADTs not supported"+conInfo (RecGadtC _ _ _) = fail "GADTs not supported"+#endif  promotedTypeList :: [Q Type] -> Q Type promotedTypeList []     = promotedNilT@@ -296,7 +320,13 @@      case info of TyConI dec -> return dec                   _          -> fail "Info must be type declaration type." +#if MIN_VERSION_template_haskell(2,11,0)+withDataDec :: Dec -> (Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> Cxt -> Q a) -> Q a+withDataDec (DataD    ctxt name bndrs _ cons derivs) f = f False ctxt name bndrs cons  derivs+withDataDec (NewtypeD ctxt name bndrs _ con  derivs) f = f True  ctxt name bndrs [con] derivs+#else withDataDec :: Dec -> (Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Q a) -> Q a withDataDec (DataD    ctxt name bndrs cons derivs) f = f False ctxt name bndrs cons  derivs withDataDec (NewtypeD ctxt name bndrs con  derivs) f = f True  ctxt name bndrs [con] derivs+#endif withDataDec _ _ = fail "Can only derive labels for datatypes and newtypes."

@@ -1,4 +1,7 @@ {-# LANGUAGE UndecidableInstances #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE UndecidableSuperClasses #-}+#endif -- | Codes and interpretations module Generics.SOP.Universe where