generics-sop (empty) → 0.1.0.0

raw patch · 15 files changed

+2621/−0 lines, 15 filesdep +basedep +ghc-primdep +taggedsetup-changed

Dependencies added: base, ghc-prim, tagged, template-haskell

Files

• LICENSE +27/−0
• Setup.hs +2/−0
• generics-sop.cabal +87/−0
• src/Generics/SOP.hs +313/−0
• src/Generics/SOP/BasicFunctors.hs +106/−0
• src/Generics/SOP/Classes.hs +308/−0
• src/Generics/SOP/Constraint.hs +83/−0
• src/Generics/SOP/GGP.hs +232/−0
• src/Generics/SOP/Instances.hs +249/−0
• src/Generics/SOP/Metadata.hs +81/−0
• src/Generics/SOP/NP.hs +376/−0
• src/Generics/SOP/NS.hs +278/−0
• src/Generics/SOP/Sing.hs +104/−0
• src/Generics/SOP/TH.hs +238/−0
• src/Generics/SOP/Universe.hs +137/−0

@@ -0,0 +1,27 @@+Copyright (c) 2014, Well-Typed LLP, Edsko de Vries, Andres Löh+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,87 @@+name:                generics-sop+version:             0.1.0.0+synopsis:            Generic Programming using True Sums of Products+description:+  A library to support the definition of generic functions.+  Datatypes are viewed in a uniform, structured way: the choice+  way: the choice between constructors is represented using an n-ary+  sum, and the arguments of each constructor are represented using+  an n-ary product.+  .+  The module "Generics.SOP" is the main module of this library and contains+  more detailed documentation.+  .+  Examples of using this library are provided by the following+  packages:+  .+    * @<https://hackage.haskell.org/packages/basic-sop basic-sop>@ basic examples,+    * @<https://hackage.haskell.org/packages/pretty-sop pretty-sop>@ generic pretty printing,+    * @<https://hackage.haskell.org/packages/lens-sop lens-sop>@ generically computed lenses,+    * @<https://hackage.haskell.org/packages/json-sop json-sop>@ generic JSON conversions.+  .+  A detailed description of the ideas behind this library is provided by+  the paper:+  .+    * Edsko de Vries and Andres Löh.+      <http://www.andres-loeh.de/TrueSumsOfProducts True Sums of Products>.+      Workshop on Generic Programming (WGP) 2014.+  .+license:             BSD3+license-file:        LICENSE+author:              Edsko de Vries <edsko@well-typed.com>, Andres Löh <andres@well-typed.com>+maintainer:          edsko@well-typed.com+category:            Generics+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC == 7.6.3, GHC == 7.8.2++source-repository head+  type:                git+  location:            https://github.com/well-typed/generics-sop++library+  exposed-modules:     Generics.SOP+                       Generics.SOP.GGP+                       Generics.SOP.TH+                       -- exposed via Generics.SOP:+                       Generics.SOP.BasicFunctors+                       Generics.SOP.Classes+                       Generics.SOP.Constraint+                       Generics.SOP.Instances+                       Generics.SOP.Metadata+                       Generics.SOP.NP+                       Generics.SOP.NS+                       Generics.SOP.Universe+                       Generics.SOP.Sing+  build-depends:       base                 >= 4.6  && < 5,+                       template-haskell     >= 2.8  && < 2.10,+                       tagged               >= 0.7  && < 0.8,+                       ghc-prim             >= 0.3  && < 0.4+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall+  default-extensions:  CPP+                       ScopedTypeVariables+                       TypeFamilies+                       RankNTypes+                       TypeOperators+                       GADTs+                       ConstraintKinds+                       MultiParamTypeClasses+                       TypeSynonymInstances+                       FlexibleInstances+                       FlexibleContexts+                       DeriveFunctor+                       DeriveFoldable+                       DeriveTraversable+                       DefaultSignatures+                       KindSignatures+                       DataKinds+                       FunctionalDependencies+  if impl (ghc >= 7.8)+    default-extensions:  AutoDeriveTypeable+  other-extensions:    OverloadedStrings+                       OverlappingInstances+                       PolyKinds+                       UndecidableInstances+                       TemplateHaskell

@@ -0,0 +1,313 @@+{-# LANGUAGE PolyKinds, UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+-- | Main module of @generics-sop@+--+-- In most cases, you will probably want to import just this module,+-- and possibly "Generics.SOP.TH" if you want to use Template Haskell+-- to generate 'Generic' instances for you.+--+-- = Generic programming with sums of products+--+-- You need this library if you want to define your own generic functions+-- in the sum-of-products SOP style. Generic programming in the SOP style+-- follows the following idea:+--+--   1.  A large class of datatypes can be viewed in a uniform, structured+--       way: the choice between constructors is represented using an n-ary+--       sum (called 'NS'), and the arguments of each constructor are+--       represented using an n-ary product (called 'NP').+--+--   2.  The library captures the notion of a datatype being representable+--       in the following way. There is a class 'Generic', which for a given+--       datatype @A@, associates the isomorphic SOP representation with+--       the original type under the name @'Rep' A@. The class also provides+--       functions 'from' and 'to' that convert between @A@ and @'Rep' A@ and+--       witness the isomorphism.+--+--   3.  Since all 'Rep' types are sums of products, you can define+--       functions over them by performing induction on the structure, of+--       by using predefined combinators that the library provides. Such+--       functions then work for all 'Rep' types.+--+--   4.  By combining the conversion functions 'from' and 'to' with the+--       function that works on 'Rep' types, we obtain a function that works+--       on all types that are in the 'Generic' class.+--+--   5.  Most types can very easily be made an instance of 'Generic'. For+--       example, if the datatype can be represented using GHC's built-in+--       approach to generic programming and has an instance for the+--       'GHC.Generics.Generic' class from module "GHC.Generics", then an+--       instance of the SOP 'Generic' can automatically be derived. There+--       is also Template Haskell code in "Generics.SOP.TH" that allows to+--       auto-generate an instance of 'Generic' for most types.+--+-- = Example+--+-- == Instantiating a datatype for use with SOP generics+--+-- Let's assume we have the datatypes:+--+-- > data A   = C Bool | D A Int | E (B ())+-- > data B a = F | G a Char Bool+--+-- To create 'Generic' instances for @A@ and @B@ via "GHC.Generics", we say+--+-- > {-# LANGUAGE DeriveGenerics #-}+-- >+-- > import qualified GHC.Generics as GHC+-- > import Generics.SOP+-- >+-- > data A   = C Bool | D A Int | E (B ())+-- >   deriving (Show, GHC.Generic)+-- > data B a = F | G a Char Bool+-- >   deriving (Show, GHC.Generic)+-- >+-- > instance Generic A     -- empty+-- > instance Generic (B a) -- empty+--+-- Now we can convert between @A@ and @'Rep' A@ (and between @B@ and @'Rep' B@).+-- For example,+--+-- >>> from (D (C True) 3) :: Rep A+-- > SOP (S (Z (I (C True) :* I 3 :* Nil)))+-- >>> to it :: A+-- > D (C True) 3+--+-- Note that the transformation is shallow: In @D (C True) 3@, the+-- inner value @C True@ of type @A@ is not affected by the+-- transformation.+--+-- For more details about @'Rep' A@, have a look at the+-- "Generics.SOP.Universe" module.+--+-- == Defining a generic function+--+-- As an example of a generic function, let us define a generic+-- version of 'Control.DeepSeq.rnf' from the @deepseq@ package.+--+-- The type of 'Control.DeepSeq.rnf' is+--+-- @+-- NFData a => a -> ()+-- @+--+-- and the idea is that for a term @x@ of type @a@ in the+-- 'Control.DeepSeq.NFData' class, @rnf x@ forces complete evaluation+-- of @x@ (i.e., evaluation to /normal form/), and returns @()@.+--+-- We call the generic version of this function @grnf@. A direct+-- definition in SOP style, making use of structural recursion on the+-- sums and products, looks as follows:+--+-- @+-- grnf :: ('Generic' a, 'All2' NFData ('Code' a)) => a -> ()+-- grnf x = grnfS ('from' x)+--+-- grnfS :: ('All2' NFData xss) => 'SOP' 'I' xss -> ()+-- grnfS ('SOP' ('Z' xs))  = grnfP xs+-- grnfS ('SOP' ('S' xss)) = grnfS ('SOP' xss)+--+-- grnfP :: ('All' NFData xs) => 'NP' 'I' xs -> ()+-- grnfP 'Nil'         = ()+-- grnfP ('I' x ':*' xs) = x \`deepseq\` (grnfP xs)+-- @+--+-- The @grnf@ function performs the conversion between @a@ and @'Rep' a@+-- by applying 'from' and then applies @grnfS@. The type of @grnf@+-- indicates that @a@ must be in the 'Generic' class so that we can+-- apply 'from', and that all the components of @a@ (i.e., all the types+-- that occur as constructor arguments) must be in the 'NFData' class+-- ('All2').+--+-- The function @grnfS@ traverses the outer sum structure of the+-- sum of products (note that @'Rep' a = 'SOP' 'I' ('Code' a)@). It+-- encodes which constructor was used to construct the original+-- argument of type @a@. Once we've found the constructor in question+-- ('Z'), we traverse the arguments of that constructor using @grnfP@.+--+-- The function @grnfP@ traverses the product structure of the+-- constructor arguments. Each argument is evaluated using the+-- 'Control.DeepSeq.deepseq' function from the 'Control.DeepSeq.NFData'+-- class. This requires that all components of the product must be+-- in the 'NFData' class ('All') and triggers the corresponding+-- constraints on the other functions. Once the end of the product+-- is reached ('Nil'), we return @()@.+--+-- == Defining a generic function using combinators+--+-- In many cases, generic functions can be written in a much more+-- concise way by avoiding the explicit structural recursion and+-- resorting to the powerful combinators provided by this library+-- instead.+--+-- For example, the @grnf@ function can also be defined as a one-liner+-- as follows:+--+-- @+-- grnf :: ('Generic' a, 'All2' NFData ('Code' a)) => a -> ()+-- grnf = 'rnf' . 'hcollapse' . 'hcliftA' ('Proxy' :: 'Proxy' NFData) (\\ ('I' x) -> 'K' (rnf x)) . 'from'+-- @+--+-- The following interaction should provide an idea of the individual+-- transformation steps:+--+-- >>> let x = G 2.5 'A' False :: B Double+-- >>> from x+-- > SOP (S (Z (I 2.5 :* I 'A' :* I False :* Nil)))+-- >>> hcliftA (Proxy :: Proxy NFData) (\ (I x) -> K (rnf x)) it+-- > SOP (S (Z (K () :* K () :* K () :* Nil)))+-- >>> hcollapse it+-- > [(),(),()]+-- >>> rnf it+-- > ()+--+-- The 'from' call converts into the structural representation.+-- Via 'hcliftA', we apply 'rnf' to all the components. The result+-- is a sum of products of the same shape, but the components are+-- no longer heterogeneous ('I'), but homogeneous (@'K' ()@). A+-- homogeneous structure can be collapsed ('hcollapse') into a+-- normal Haskell list. Finally, 'rnf' actually forces evaluation+-- of this list (and thereby actually drives the evaluation of all+-- the previous steps) and produces the final result.+--+-- == Using a generic function+--+-- We can directly invoke 'grnf' on any type that is an instance of+-- class 'Generic'.+--+-- >>> grnf (G 2.5 'A' False)+-- > ()+-- >>> grnf (G 2.5 undefined False)+-- > *** Exception: Prelude.undefined+--+-- Note that the type of 'grnf' requires that all components of the+-- type are in the 'Control.DeepSeq.NFData' class. For a recursive+-- datatype such as @B@, this means that we have to make @A@+-- (and in this case, also @B@) an instance of 'Control.DeepSeq.NFData'+-- in order to be able to use the 'grnf' function. But we can use 'grnf'+-- to supply the instance definitions:+--+-- > instance NFData A where rnf = grnf+-- > instance NFData a => NFData (B a) where rnf = grnf+--+-- = More examples+--+-- The best way to learn about how to define generic functions in the SOP style+-- is to look at a few simple examples. Examples are provided by the following+-- packages:+--+--   * @<http://hackage.haskell.org/packages/basic-sop basic-sop>@ basic examples,+--   * @<http://hackage.haskell.org/packages/pretty-sop pretty-sop>@ generic pretty printing,+--   * @<http://hackage.haskell.org/packages/lens-sop lens-sop>@ generically computed lenses,+--   * @<http://hackage.haskell.org/packages/json-sop json-sop>@ generic JSON conversions.+--+-- The generic functions in these packages use a wide variety of the combinators+-- that are offered by the library.+--+-- = Paper+--+-- A detailed description of the ideas behind this library is provided by+-- the paper:+--+--   * Edsko de Vries and Andres Löh.+--     <http://www.andres-loeh.de/TrueSumsOfProducts True Sums of Products>.+--     Workshop on Generic Programming (WGP) 2014.+--+--+module Generics.SOP (+    -- * Codes and interpretations+    Generic(..)+  , Rep+    -- * n-ary datatypes+  , NP(..)+  , NS(..)+  , SOP(..)+  , unSOP+  , POP(..)+  , unPOP+    -- * Metadata+  , DatatypeInfo(..)+  , ConstructorInfo(..)+  , FieldInfo(..)+  , HasDatatypeInfo(..)+  , DatatypeName+  , ModuleName+  , ConstructorName+  , FieldName+  , Associativity(..)+  , Fixity+    -- * Combinators+    -- ** Constructing products+  , HPure(..)+    -- ** Application+  , (-.->)(..)+  , fn+  , fn_2+  , fn_3+  , fn_4+  , Prod+  , HAp(..)+    -- ** Lifting / mapping+  , hliftA+  , hliftA2+  , hliftA3+  , hcliftA+  , hcliftA2+  , hcliftA3+    -- ** Constructing sums+  , Injection+  , injections+  , shift+  , apInjs_NP+  , apInjs_POP+    -- ** Dealing with @'All' c@+  , AllDict(..)+  , allDict_NP+  , hcliftA'+  , hcliftA2'+  , hcliftA3'+    -- ** Collapsing+  , CollapseTo+  , HCollapse(..)+    -- ** Sequencing+  , HSequence(..)+  , hsequence+  , hsequenceK+    -- ** Partial operations+  , fromList+    -- * Utilities+    -- ** Basic functors+  , K(..)+  , unK+  , I(..)+  , unI+  , (:.:)(..)+  , unComp+    -- ** Mapping constraints+  , All+  , All2+  , Map+  , AllMap+    -- ** Singletons+  , Sing(..)+  , SingI(..)+    -- *** Shape of type-level lists+  , Shape(..)+  , shape+  , lengthSing+    -- ** Re-exports+  , Proxy(..)+  ) where++import Data.Proxy (Proxy(..))++import Generics.SOP.BasicFunctors+import Generics.SOP.Classes+import Generics.SOP.Constraint+import Generics.SOP.Instances ()+import Generics.SOP.Metadata+import Generics.SOP.NP+import Generics.SOP.NS+import Generics.SOP.Universe+import Generics.SOP.Sing+

@@ -0,0 +1,106 @@+{-# LANGUAGE PolyKinds, DeriveGeneric #-}+-- | Basic functors.+--+-- Definitions of the type-level equivalents of+-- 'const', 'id', and ('.'), and a definition of+-- the lifted function space.+--+-- These datatypes are generally useful, but in this+-- library, they're primarily used as parameters for+-- the 'NP', 'NS', 'POP', and 'SOP' types.+--+module Generics.SOP.BasicFunctors+  ( K(..)+  , unK+  , I(..)+  , unI+  , (:.:)(..)+  , unComp+  ) where++import Control.Applicative+import Data.Foldable (Foldable(..))+import Data.Monoid (Monoid, mempty, (<>))+import Data.Traversable (Traversable(..))+import qualified GHC.Generics as GHC++-- | The constant type functor.+--+-- Like 'Data.Functor.Constant.Constant', but kind-polymorphic+-- in its second argument and with a shorter name.+--+newtype K (a :: *) (b :: k) = K a+#if MIN_VERSION_base(4,7,0)+  deriving (Show, Functor, Foldable, Traversable, GHC.Generic)+#else+  deriving (Show, GHC.Generic)++instance Functor (K a) where+  fmap _ (K x) = K x++instance Foldable (K a) where+  foldr _ z (K _) = z+  foldMap _ (K _) = mempty++instance Traversable (K a) where+  traverse _ (K x) = pure (K x)+#endif++instance Monoid a => Applicative (K a) where+  pure _      = K mempty+  K x <*> K y = K (x <> y)++-- | Extract the contents of a 'K' value.+unK :: K a b -> a+unK (K x) = x++-- | The identity type functor.+--+-- Like 'Data.Functor.Identity.Identity', but with a shorter name.+--+newtype I (a :: *) = I a+#if MIN_VERSION_base(4,7,0)+  deriving (Show, Functor, Foldable, Traversable, GHC.Generic)+#else+  deriving (Show, GHC.Generic)++instance Functor I where+  fmap f (I x) = I (f x)++instance Foldable I where+  foldr f z (I x) = f x z+  foldMap f (I x) = f x++instance Traversable I where+  traverse f (I x) = fmap I (f x)+#endif++instance Applicative I where+  pure = I+  I f <*> I x = I (f x)++instance Monad I where+  return = I+  I x >>= f = f x++-- | Extract the contents of an 'I' value.+unI :: I a -> a+unI (I x) = x++-- | Composition of functors.+--+-- Like 'Data.Functor.Compose.Compose', but kind-polymorphic+-- and with a shorter name.+--+newtype (:.:) (f :: l -> *) (g :: k -> l) (p :: k) = Comp (f (g p))+  deriving (Show, GHC.Generic)++infixr 7 :.:++instance (Functor f, Functor g) => Functor (f :.: g) where+  fmap f (Comp x) = Comp (fmap (fmap f) x)++-- | Extract the contents of a 'Comp' value.+unComp :: (f :.: g) p -> f (g p)+unComp (Comp x) = x+

@@ -0,0 +1,308 @@+{-# LANGUAGE PolyKinds #-}+-- | Classes for generalized combinators on SOP types.+--+-- In the SOP approach to generic programming, we're predominantly+-- concerned with four structured datatypes:+--+-- @+--   'Generics.SOP.NP.NP'  :: (k -> *) -> ( [k]  -> *)   -- n-ary product+--   'Generics.SOP.NS.NS'  :: (k -> *) -> ( [k]  -> *)   -- n-ary sum+--   'Generics.SOP.NP.POP' :: (k -> *) -> ([[k]] -> *)   -- product of products+--   'Generics.SOP.NS.SOP' :: (k -> *) -> ([[k]] -> *)   -- sum of products+-- @+--+-- All of these have a kind that fits the following pattern:+--+-- @+--   (k -> *) -> (l -> *)+-- @+--+-- These four types support similar interfaces. In order to allow+-- reusing the same combinator names for all of these types, we define+-- various classes in this module that allow the necessary+-- generalization.+--+-- The classes typically lift concepts that exist for kinds @*@ or+-- @* -> *@ to datatypes of kind @(k -> *) -> (l -> *)@. This module+-- also derives a number of derived combinators.+--+-- The actual instances are defined in "Generics.SOP.NP" and+-- "Generics.SOP.NS".+--+module Generics.SOP.Classes where++import Control.Applicative (Applicative)+import Data.Proxy (Proxy)++import Generics.SOP.BasicFunctors+import Generics.SOP.Constraint+import Generics.SOP.Sing++-- | A generalization of 'Control.Applicative.pure' or+-- 'Control.Monad.return' to higher kinds.+class HPure (h :: (k -> *) -> (l -> *)) where+  -- | Corresponds to 'Control.Applicative.pure' directly.+  --+  -- /Instances:/+  --+  -- @+  -- 'hpure', 'Generics.SOP.NP.pure_NP'  :: 'SingI' xs  => (forall a. f a) -> 'Generics.SOP.NP.NP'  f xs+  -- 'hpure', 'Generics.SOP.NP.pure_POP' :: 'SingI' xss => (forall a. f a) -> 'Generics.SOP.NP.POP' f xss+  -- @+  --+  hpure  ::  SingI xs => (forall a. f a) -> h f xs++  -- | A variant of 'hpure' that allows passing in a constrained+  -- argument.+  --+  -- Calling @'hcpure' f s@ where @s :: h f xs@ causes @f@ to be+  -- applied at all the types that are contained in @xs@. Therefore,+  -- the constraint @c@ has to be satisfied for all elements of @xs@,+  -- which is what @'AllMap' h c xs@ states.+  --+  -- Morally, 'hpure' is a special case of 'hcpure' where the+  -- constraint is empty. However, it is in the nature of how 'AllMap'+  -- is defined as well as current GHC limitations that it is tricky+  -- to prove to GHC in general that @'AllMap' h c NoConstraint xs@ is+  -- always satisfied. Therefore, we typically define 'hpure'+  -- separately and directly, and make it a member of the class.+  --+  -- /Instances:/+  --+  -- @+  -- 'hcpure', 'Generics.SOP.NP.cpure_NP'  :: ('SingI' xs,  'All'  c xs ) => 'Proxy' c -> (forall a. c a => f a) -> 'Generics.SOP.NP.NP'  f xs+  -- 'hcpure', 'Generics.SOP.NP.cpure_POP' :: ('SingI' xss, 'All2' c xss) => 'Proxy' c -> (forall a. c a => f a) -> 'Generics.SOP.NP.POP' f xss+  -- @+  --+  hcpure :: (SingI xs, AllMap h c xs) => Proxy c -> (forall a. c a => f a) -> h f xs++{-------------------------------------------------------------------------------+  Application+-------------------------------------------------------------------------------}++-- | Lifted functions.+newtype (f -.-> g) a = Fn { apFn :: f a -> g a }++-- TODO: What is the right precedence?+infixr 1 -.->++-- | Construct a lifted function.+--+-- Same as 'Fn'. Only available for uniformity with the+-- higher-arity versions.+--+fn   :: (f a -> f' a) -> (f -.-> f') a++-- | Construct a binary lifted function.+fn_2 :: (f a -> f' a -> f'' a) -> (f -.-> f' -.-> f'') a++-- | Construct a ternary lifted function.+fn_3 :: (f a -> f' a -> f'' a -> f''' a) -> (f -.-> f' -.-> f'' -.-> f''') a++-- | Construct a quarternary lifted function.+fn_4 :: (f a -> f' a -> f'' a -> f''' a -> f'''' a) -> (f -.-> f' -.-> f'' -.-> f''' -.-> f'''') a++fn   f = Fn $ \x -> f x+fn_2 f = Fn $ \x -> Fn $ \x' -> f x x'+fn_3 f = Fn $ \x -> Fn $ \x' -> Fn $ \x'' -> f x x' x''+fn_4 f = Fn $ \x -> Fn $ \x' -> Fn $ \x'' -> Fn $ \x''' -> f x x' x'' x'''++-- | Maps a structure containing sums to the corresponding+-- product structure.+type family Prod (h :: (k -> *) -> (l -> *)) :: (k -> *) -> (l -> *)++-- | A generalization of 'Control.Applicative.<*>'.+class (Prod (Prod h) ~ Prod h, HPure (Prod h)) => HAp (h  :: (k -> *) -> (l -> *)) where++  -- | Corresponds to 'Control.Applicative.<*>'.+  --+  -- For products as well as products or products, 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.+  --+  -- The same combinator can also be used to combine a product+  -- structure of functions with a sum structure of arguments, which then+  -- results in another sum structure of results. The sum structure+  -- determines which part of the product structure will be used.+  --+  -- /Instances:/+  --+  -- @+  -- 'hap', 'Generics.SOP.NP.ap_NP'  :: 'Generics.SOP.NP.NP'  (f -.-> g) xs  -> 'Generics.SOP.NP.NP'  f xs  -> 'Generics.SOP.NP.NP'  g xs+  -- 'hap', 'Generics.SOP.NS.ap_NS'  :: 'Generics.SOP.NS.NP'  (f -.-> g) xs  -> 'Generics.SOP.NS.NS'  f xs  -> 'Generics.SOP.NS.NS'  g xs+  -- 'hap', 'Generics.SOP.NP.ap_POP' :: 'Generics.SOP.NP.POP' (f -.-> g) xss -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' g xss+  -- 'hap', 'Generics.SOP.NS.ap_SOP' :: 'Generics.SOP.NS.POP' (f -.-> g) xss -> 'Generics.SOP.NS.SOP' f xss -> 'Generics.SOP.NS.SOP' g xss+  -- @+  --+  hap :: Prod h (f -.-> g) xs -> h f xs -> h g xs++{-------------------------------------------------------------------------------+  Derived from application+-------------------------------------------------------------------------------}++-- | A generalized form of 'Control.Applicative.liftA',+-- which in turn is a generalized 'map'.+--+-- Takes a lifted function and applies it to every element of+-- a structure while preserving its shape.+--+-- /Specification:/+--+-- @+-- 'hliftA' f xs = 'hpure' ('fn' f) \` 'hap' \` xs+-- @+--+-- /Instances:/+--+-- @+-- 'hliftA', 'Generics.SOP.NP.liftA_NP'  :: 'SingI' xs  => (forall a. f a -> f' a) -> 'Generics.SOP.NP.NP'  f xs  -> 'Generics.SOP.NP.NP'  f' xs+-- 'hliftA', 'Generics.SOP.NS.liftA_NS'  :: 'SingI' xs  => (forall a. f a -> f' a) -> 'Generics.SOP.NS.NS'  f xs  -> 'Generics.SOP.NS.NS'  f' xs+-- 'hliftA', 'Generics.SOP.NP.liftA_POP' :: 'SingI' xss => (forall a. f a -> f' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss+-- 'hliftA', 'Generics.SOP.NS.liftA_SOP' :: 'SingI' xss => (forall a. f a -> f' a) -> 'Generics.SOP.NS.SOP' f xss -> 'Generics.SOP.NS.SOP' f' xss+-- @+--+hliftA  :: (SingI xs, HAp h)               => (forall a. f a -> f' a)                                                   -> h f   xs -> h f'   xs++-- | A generalized form of 'Control.Applicative.liftA2',+-- which in turn is a generalized 'zipWith'.+--+-- Takes a lifted binary function and uses it to combine two+-- structures of equal shape into a single structure.+--+-- It either takes two product structures to a product structure,+-- or one product and one sum structure to a sum structure.+--+-- /Specification:/+--+-- @+-- 'hliftA2' f xs ys = 'hpure' ('fn_2' f) \` 'hap' \` xs \` 'hap' \` ys+-- @+--+-- /Instances:/+--+-- @+-- 'hliftA2', 'Generics.SOP.NP.liftA2_NP'  :: 'SingI' xs  => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.NP'  f xs  -> 'Generics.SOP.NP.NP'  f' xs  -> 'Generics.SOP.NP.NP'  f'' xs+-- 'hliftA2', 'Generics.SOP.NS.liftA2_NS'  :: 'SingI' xs  => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.NP'  f xs  -> 'Generics.SOP.NS.NS'  f' xs  -> 'Generics.SOP.NS.NS'  f'' xs+-- 'hliftA2', 'Generics.SOP.NP.liftA2_POP' :: 'SingI' xss => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -> 'Generics.SOP.NP.POP' f'' xss+-- 'hliftA2', 'Generics.SOP.NS.liftA2_SOP' :: 'SingI' xss => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NS.SOP' f' xss -> 'Generics.SOP.NS.SOP' f'' xss+-- @+--+hliftA2 :: (SingI xs, HAp h, HAp (Prod h)) => (forall a. f a -> f' a -> f'' a)           -> Prod h f xs                 -> h f'  xs -> h f''  xs++-- | A generalized form of 'Control.Applicative.liftA3',+-- which in turn is a generalized 'zipWith3'.+--+-- Takes a lifted ternary function and uses it to combine three+-- structures of equal shape into a single structure.+--+-- It either takes three product structures to a product structure,+-- or two product structures and one sum structure to a sum structure.+--+-- /Specification:/+--+-- @+-- 'hliftA3' f xs ys zs = 'hpure' ('fn_3' f) \` 'hap' \` xs \` 'hap' \` ys \` 'hap' \` zs+-- @+--+-- /Instances:/+--+-- @+-- 'hliftA3', 'Generics.SOP.NP.liftA3_NP'  :: 'SingI' xs  => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.NP'  f xs  -> 'Generics.SOP.NP.NP'  f' xs  -> 'Generics.SOP.NP.NP'  f'' xs  -> 'Generics.SOP.NP.NP'  f''' xs+-- 'hliftA3', 'Generics.SOP.NS.liftA3_NS'  :: 'SingI' xs  => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.NP'  f xs  -> 'Generics.SOP.NP.NP'  f' xs  -> 'Generics.SOP.NS.NS'  f'' xs  -> 'Generics.SOP.NS.NS'  f''' xs+-- 'hliftA3', 'Generics.SOP.NP.liftA3_POP' :: 'SingI' xss => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -> 'Generics.SOP.NP.POP' f'' xss -> 'Generics.SOP.NP.POP' f''' xs+-- 'hliftA3', 'Generics.SOP.NS.liftA3_SOP' :: 'SingI' xss => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -> 'Generics.SOP.NS.SOP' f'' xss -> 'Generics.SOP.NP.SOP' f''' xs+-- @+--+hliftA3 :: (SingI xs, HAp h, HAp (Prod h)) => (forall a. f a -> f' a -> f'' a -> f''' a) -> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs++hliftA  f xs       = hpure (fn   f) `hap` xs+hliftA2 f xs ys    = hpure (fn_2 f) `hap` xs `hap` ys+hliftA3 f xs ys zs = hpure (fn_3 f) `hap` xs `hap` ys `hap` zs++-- | Variant of 'hliftA' that takes a constrained function.+--+-- /Specification:/+--+-- @+-- 'hcliftA' p f xs = 'hcpure' p ('fn' f) \` 'hap' \` xs+-- @+--+hcliftA  :: (AllMap (Prod h) c xs, SingI xs, HAp h)               => Proxy c -> (forall a. c a => f a -> f' a)                                                   -> h f   xs -> h f'   xs++-- | Variant of 'hcliftA2' that takes a constrained function.+--+-- /Specification:/+--+-- @+-- 'hcliftA2' p f xs ys = 'hcpure' p ('fn_2' f) \` 'hap' \` xs \` 'hap' \` ys+-- @+--+hcliftA2 :: (AllMap (Prod h) c xs, SingI xs, HAp h, HAp (Prod h)) => Proxy c -> (forall a. c a => f a -> f' a -> f'' a)           -> Prod h f xs                 -> h f'  xs -> h f''  xs++-- | Variant of 'hcliftA3' that takes a constrained function.+--+-- /Specification:/+--+-- @+-- 'hcliftA3' p f xs ys zs = 'hcpure' p ('fn_3' f) \` 'hap' \` xs \` 'hap' \` ys \` 'hap' \` zs+-- @+--+hcliftA3 :: (AllMap (Prod h) c xs, SingI xs, HAp h, HAp (Prod h)) => Proxy c -> (forall a. c a => f a -> f' a -> f'' a -> f''' a) -> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs++hcliftA  p f xs       = hcpure p (fn   f) `hap` xs+hcliftA2 p f xs ys    = hcpure p (fn_2 f) `hap` xs `hap` ys+hcliftA3 p f xs ys zs = hcpure p (fn_3 f) `hap` xs `hap` ys `hap` zs++-- | Maps products to lists, and sums to identities.+type family CollapseTo (h :: (k -> *) -> (l -> *)) :: * -> *++-- | A class for collapsing a heterogeneous structure into+-- a homogeneous one.+class HCollapse (h :: (k -> *) -> (l -> *)) where++  -- | Collapse a heterogeneous structure with homogeneous elements+  -- into a homogeneous structure.+  --+  -- If a heterogeneous structure is instantiated to the constant+  -- functor 'K', then it is in fact homogeneous. This function+  -- maps such a value to a simpler Haskell datatype reflecting that.+  -- An @'NS' ('K' a)@ contains a single @a@, and an @'NP' ('K' a)@ contains+  -- a list of @a@s.+  --+  -- /Instances:/+  --+  -- @+  -- 'hcollapse', 'Generics.SOP.NP.collapse_NP'  :: 'Generics.SOP.NP.NP'  ('K' a) xs  ->  [a]+  -- 'hcollapse', 'Generics.SOP.NS.collapse_NS'  :: 'Generics.SOP.NS.NS'  ('K' a) xs  ->   a+  -- 'hcollapse', 'Generics.SOP.NP.collapse_POP' :: 'Generics.SOP.NP.POP' ('K' a) xss -> [[a]]+  -- 'hcollapse', 'Generics.SOP.NS.collapse_SOP' :: 'Generics.SOP.NP.SOP' ('K' a) xss ->  [a]+  -- @+  --+  hcollapse :: SingI xs => h (K a) xs -> CollapseTo h a++-- | A generalization of 'Data.Traversable.sequenceA'.+class HAp h => HSequence (h :: (k -> *) -> (l -> *)) where++  -- | Corresponds to 'Data.Traversable.sequenceA'.+  --+  -- Lifts an applicative functor out of a structure.+  --+  -- /Instances:/+  --+  -- @+  -- 'hsequence'', 'Generics.SOP.NP.sequence'_NP'  :: ('SingI' xs , 'Applicative' f) => 'Generics.SOP.NP.NP'  (f ':.:' g) xs  -> f ('Generics.SOP.NP.NP'  g xs )+  -- 'hsequence'', 'Generics.SOP.NS.sequence'_NS'  :: ('SingI' xs , 'Applicative' f) => 'Generics.SOP.NS.NS'  (f ':.:' g) xs  -> f ('Generics.SOP.NS.NS'  g xs )+  -- 'hsequence'', 'Generics.SOP.NP.sequence'_POP' :: ('SingI' xss, 'Applicative' f) => 'Generics.SOP.NP.POP' (f ':.:' g) xss -> f ('Generics.SOP.NP.POP' g xss)+  -- 'hsequence'', 'Generics.SOP.NS.sequence'_SOP' :: ('SingI' xss, 'Applicative' f) => 'Generics.SOP.NS.SOP' (f ':.:' g) xss -> f ('Generics.SOP.NS.SOP' g xss)+  -- @+  --+  hsequence' :: (SingI xs, Applicative f) => h (f :.: g) xs -> f (h g xs)++-- | Special case of 'hsequence'' where @g = 'I'@.+hsequence :: (SingI xs, HSequence h) => Applicative f => h f xs -> f (h I xs)+hsequence = hsequence' . hliftA (Comp . fmap I)++-- | Special case of 'hsequence'' where @g = 'K' a@.+hsequenceK ::  (SingI xs, Applicative f, HSequence h) => h (K (f a)) xs -> f (h (K a) xs)+hsequenceK = hsequence' . hliftA (Comp . fmap K . unK)

@@ -0,0 +1,83 @@+{-# LANGUAGE PolyKinds #-}+-- | Constraints for indexed datatypes.+--+-- This module contains code that helps to specify that all+-- elements of an indexed structure must satisfy a particular+-- constraint.+--+module Generics.SOP.Constraint+  ( module Generics.SOP.Constraint+  , Constraint+  ) where++import GHC.Exts (Constraint)+import Generics.SOP.Sing++-- | Require a constraint for every element of a list.+--+-- If you have a datatype that is indexed over a type-level+-- list, then you can use 'All' to indicate that all elements+-- of that type-level list must satisfy a given constraint.+--+-- /Example:/ The constraint+--+-- > All Eq '[ Int, Bool, Char ]+--+-- is equivalent to the constraint+--+-- > (Eq Int, Eq Bool, Eq Char)+--+-- /Example:/ A type signature such as+--+-- > f :: All Eq xs => NP I xs -> ...+--+-- means that 'f' can assume that all elements of the n-ary+-- product satisfy 'Eq'.+--+type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint+type instance All c '[]       = ()+type instance All c (x ': xs) = (c x, All c xs)++-- | Require a constraint for every element of a list of lists.+--+-- If you have a datatype that is indexed over a type-level+-- list of lists, then you can use 'All2' to indicate that all+-- elements of the innert lists must satisfy a given constraint.+--+-- /Example:/ The constraint+--+-- > All2 Eq '[ '[ Int ], '[ Bool, Char ] ]+--+-- is equivalent to the constraint+--+-- > (Eq Int, Eq Bool, Eq Char)+--+-- /Example:/ A type signature such as+--+-- > f :: All2 Eq xss => SOP I xs -> ...+--+-- means that 'f' can assume that all elements of the sum+-- of product satisfy 'Eq'.+--+type family All2 (c :: k -> Constraint) (xs :: [[k]]) :: Constraint+type instance All2 c '[]       = ()+type instance All2 c (x ': xs) = (All c x, All2 c xs)++-- | A type-level 'map'.+type family Map (f :: k -> l) (xs :: [k]) :: [l]+type instance Map f '[]       = '[]+type instance Map f (x ': xs) = f x ': Map f xs++-- | A generalization of 'All' and 'All2'.+--+-- The family 'AllMap' expands to 'All' or 'All2' depending on whether+-- the argument is indexed by a list or a list of lists.+--+type family AllMap (h :: (k -> *) -> (l -> *)) (c :: k -> Constraint) (xs :: l) :: Constraint++-- | Dictionary for a constraint for all elements of a type-level list.+--+-- A value of type @'AllDict' c xs@ captures the constraint @'All' c xs@.+--+data AllDict (c :: k -> Constraint) (xs :: [k]) where+  AllDictC :: (SingI xs, All c xs) => AllDict c xs

@@ -0,0 +1,232 @@+{-# LANGUAGE UndecidableInstances #-}+-- | Derive @generics-sop@ boilerplate instances from GHC's 'GHC.Generic'.+module Generics.SOP.GGP+  ( GCode+  , GFrom+  , GTo+  , GDatatypeInfo+  , gfrom+  , gto+  , gdatatypeInfo+  ) where++import Data.Proxy+import GHC.Generics as GHC+import Generics.SOP.NP as SOP+import Generics.SOP.NS as SOP+import Generics.SOP.BasicFunctors as SOP+import Generics.SOP.Metadata as SOP+import Generics.SOP.Sing++type family ToSingleCode (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 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++data InfoProxy (c :: *) (f :: * -> *) (x :: *) = InfoProxy++class GDatatypeInfo' (a :: * -> *) where+  gDatatypeInfo' :: Proxy a -> DatatypeInfo (ToSumCode a '[])++#if !(MIN_VERSION_base(4,7,0))++-- | 'isNewtype' does not exist in "GHC.Generics" before GHC-7.8.+--+-- The only safe assumption to make is that it always returns 'False'.+--+isNewtype :: Datatype d => t d (f :: * -> *) a -> Bool+isNewtype _ = False++#endif++instance (SingI (ToSumCode a '[]), Datatype c, GConstructorInfos a) => GDatatypeInfo' (M1 D c a) where+  gDatatypeInfo' _ =+    let adt = ADT     (moduleName p) (datatypeName p)+        ci  = gConstructorInfos (Proxy :: Proxy a) Nil+    in if isNewtype p+       then case isNewtypeShape sing ci of+              NewYes c -> Newtype (moduleName p) (datatypeName p) c+              NewNo    -> adt ci -- should not happen+       else adt ci+    where+     p :: InfoProxy c a x+     p = InfoProxy++data IsNewtypeShape (xss :: [[*]]) where+  NewYes :: ConstructorInfo '[x] -> IsNewtypeShape '[ '[x] ]+  NewNo  :: IsNewtypeShape xss++isNewtypeShape :: Sing xss -> NP ConstructorInfo xss -> IsNewtypeShape xss+isNewtypeShape SCons (x :* Nil) = go shape x+  where+    go :: Shape xs -> ConstructorInfo xs -> IsNewtypeShape '[ xs ]+    go (ShapeCons ShapeNil) c   = NewYes c+    go _                    _   = NewNo+isNewtypeShape _     _          = NewNo++class GConstructorInfos (a :: * -> *) where+  gConstructorInfos :: Proxy a -> NP ConstructorInfo xss -> NP ConstructorInfo (ToSumCode a xss)++instance (GConstructorInfos a, GConstructorInfos b) => GConstructorInfos (a :+: b) where+  gConstructorInfos _ xss = gConstructorInfos (Proxy :: Proxy a) (gConstructorInfos (Proxy :: Proxy b) xss)++instance GConstructorInfos GHC.V1 where+  gConstructorInfos _ xss = xss++instance (Constructor c, GFieldInfos a, SingI (ToProductCode a '[])) => GConstructorInfos (M1 C c a) where+  gConstructorInfos _ xss+    | conIsRecord p = Record (conName p) (gFieldInfos (Proxy :: Proxy a) Nil) :* xss+    | otherwise     = case conFixity p of+        Prefix        -> Constructor (conName p) :* xss+        GHC.Infix a f -> case (shape :: Shape (ToProductCode a '[])) of+          ShapeCons (ShapeCons ShapeNil) -> SOP.Infix (conName p) a f :* xss+          _                              -> Constructor (conName p) :* xss -- should not happen+    where+      p :: InfoProxy c a x+      p = InfoProxy++class GFieldInfos (a :: * -> *) where+  gFieldInfos :: Proxy a -> NP FieldInfo xs -> NP FieldInfo (ToProductCode a xs)++instance (GFieldInfos a, GFieldInfos b) => GFieldInfos (a :*: b) where+  gFieldInfos _ xs = gFieldInfos (Proxy :: Proxy a) (gFieldInfos (Proxy :: Proxy b) xs)++instance GFieldInfos U1 where+  gFieldInfos _ xs = xs++instance (Selector c) => GFieldInfos (M1 S c a) where+  gFieldInfos _ xs = FieldInfo (selName p) :* xs+    where+      p :: InfoProxy c a x+      p = InfoProxy++class GSingleFrom (a :: * -> *) where+  gSingleFrom :: a x -> ToSingleCode a++instance GSingleFrom (K1 i a) where+  gSingleFrom (K1 a) = a++class GProductFrom (a :: * -> *) where+  gProductFrom :: a x -> NP I xs -> NP I (ToProductCode a xs)++instance (GProductFrom a, GProductFrom b) => GProductFrom (a :*: b) where+  gProductFrom (a :*: b) xs = gProductFrom a (gProductFrom b xs)++instance GProductFrom U1 where+  gProductFrom U1 xs = xs++instance GSingleFrom a => GProductFrom (M1 S c a) where+  gProductFrom (M1 a) xs = I (gSingleFrom a) :* xs++class GSingleTo (a :: * -> *) where+  gSingleTo :: ToSingleCode a -> a x++instance GSingleTo (K1 i a) where+  gSingleTo a = K1 a++class GProductTo (a :: * -> *) where+  gProductTo :: NP I (ToProductCode a xs) -> (a x -> NP I xs -> r) -> r++instance (GProductTo a, GProductTo b) => GProductTo (a :*: b) where+  gProductTo xs k = gProductTo xs (\ a ys -> gProductTo ys (\ b zs -> k (a :*: b) zs))++instance GSingleTo a => GProductTo (M1 S c a) where+  gProductTo (SOP.I a :* xs) k = k (M1 (gSingleTo a)) xs+  gProductTo _               _ = error "inaccessible"++instance GProductTo U1 where+  gProductTo xs k = k U1 xs++-- This can most certainly be simplified+class GSumFrom (a :: * -> *) where+  gSumFrom :: a x -> SOP I xss -> SOP I (ToSumCode a xss)+  gSumSkip :: Proxy a -> SOP I xss -> SOP I (ToSumCode a xss)++instance (GSumFrom a, GSumFrom b) => GSumFrom (a :+: b) where+  gSumFrom (L1 a) xss = gSumFrom a (gSumSkip (Proxy :: Proxy b) xss)+  gSumFrom (R1 b) xss = gSumSkip (Proxy :: Proxy a) (gSumFrom b xss)++  gSumSkip _ xss = gSumSkip (Proxy :: Proxy a) (gSumSkip (Proxy :: Proxy b) xss)++instance (GSumFrom a) => GSumFrom (M1 D c a) where+  gSumFrom (M1 a) xss = gSumFrom a xss+  gSumSkip _      xss = gSumSkip (Proxy :: Proxy a) xss++instance (GProductFrom a) => GSumFrom (M1 C c a) where+  gSumFrom (M1 a) _    = SOP (Z (gProductFrom a Nil))+  gSumSkip _ (SOP xss) = SOP (S xss)++class GSumTo (a :: * -> *) where+  gSumTo :: SOP I (ToSumCode a xss) -> (a x -> r) -> (SOP I xss -> r) -> r++instance (GSumTo a, GSumTo b) => GSumTo (a :+: b) where+  gSumTo xss s k = gSumTo xss (s . L1) (\ r -> gSumTo r (s . R1) k)++instance (GProductTo a) => GSumTo (M1 C c a) where+  gSumTo (SOP (Z xs)) s _ = s (M1 (gProductTo xs ((\ x Nil -> x) :: a x -> NP I '[] -> a x)))+  gSumTo (SOP (S xs)) _ k = k (SOP xs)++instance (GSumTo a) => GSumTo (M1 D c a) where+  gSumTo xss s k = gSumTo xss (s . M1) k++-- | Compute the SOP code of a datatype.+--+-- This requires that 'GHC.Rep' is defined, which in turn requires that+-- the type has a 'GHC.Generic' (from module "GHC.Generics") instance.+--+-- This is the default definition for 'Generics.SOP.Code'.+-- For more info, see 'Generics.SOP.Generic'.+--+type GCode (a :: *) = ToSumCode (GHC.Rep a) '[]++-- | Constraint for the class that computes 'gfrom'.+type GFrom a = GSumFrom (GHC.Rep a)++-- | Constraint for the class that computes 'gto'.+type GTo a = GSumTo (GHC.Rep a)++-- | Constraint for the class that computes 'gdatatypeInfo'.+type GDatatypeInfo a = GDatatypeInfo' (GHC.Rep a)++-- | An automatically computed version of 'Generics.SOP.from'.+--+-- This requires that the type being converted has a+-- 'GHC.Generic' (from module "GHC.Generics") instance.+--+-- This is the default definition for 'Generics.SOP.from'.+-- For more info, see 'Generics.SOP.Generic'.+--+gfrom :: (GFrom a, GHC.Generic a) => a -> SOP I (GCode a)+gfrom x = gSumFrom (GHC.from x) (error "gfrom: internal error" :: SOP.SOP SOP.I '[])++-- | An automatically computed version of 'Generics.SOP.to'.+--+-- This requires that the type being converted has a+-- 'GHC.Generic' (from module "GHC.Generics") instance.+--+-- This is the default definition for 'Generics.SOP.to'.+-- For more info, see 'Generics.SOP.Generic'.+--+gto :: forall a. (GTo a, GHC.Generic a) => SOP I (GCode a) -> a+gto x = GHC.to (gSumTo x id ((\ _ -> error "inaccessible") :: SOP I '[] -> (GHC.Rep a) x))++-- | An automatically computed version of 'Generics.SOP.datatypeInfo'.+--+-- This requires that the type being converted has a+-- 'GHC.Generic' (from module "GHC.Generics") instance.+--+-- This is the default definition for 'Generics.SOP.datatypeInfo'.+-- For more info, see 'Generics.SOP.HasDatatypeInfo'.+--+gdatatypeInfo :: forall a. (GDatatypeInfo a) => Proxy a -> DatatypeInfo (GCode a)+gdatatypeInfo _ = gDatatypeInfo' (Proxy :: Proxy (GHC.Rep a))+

@@ -0,0 +1,249 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fcontext-stack=50 #-}+-- | Instances for 'Generic' and 'HasMetadata'.+--+-- We define instances for datatypes from @generics-sop@ and+-- @base@ that are supported.+--+-- (There are only instances defined in this module, so the+-- documentation is empty.)+--+module Generics.SOP.Instances () where++import Control.Exception+import Data.Char+import Data.Complex+import Data.Data+import Data.Fixed+import Data.Monoid+import Data.Ord+#if !(MIN_VERSION_base(4,7,0))+import Data.Proxy+#endif+import Data.Version+import Foreign.C.Error+import Foreign.C.Types+import System.Console.GetOpt+import System.Exit+import System.IO+#if MIN_VERSION_base(4,7,0)+import Text.Printf+#endif+import Text.Read.Lex++import Generics.SOP.BasicFunctors+import Generics.SOP.TH++-- Types from Generics.SOP:++deriveGeneric ''I+deriveGeneric ''K+deriveGeneric ''(:.:)++-- Cannot derive instances for Sing+-- Cannot derive instances for Shape+-- Cannot derive instances for NP, NS, POP, SOP+-- Cannot derive instances for metadata types++-- Types from the Prelude:++deriveGeneric ''Bool+deriveGeneric ''Ordering+deriveGeneric ''Maybe+deriveGeneric ''Either+deriveGeneric ''()+deriveGeneric ''(,)              -- 2+deriveGeneric ''(,,)+deriveGeneric ''(,,,)+deriveGeneric ''(,,,,)           -- 5+deriveGeneric ''(,,,,,)+deriveGeneric ''(,,,,,,)+deriveGeneric ''(,,,,,,,)+deriveGeneric ''(,,,,,,,,)+deriveGeneric ''(,,,,,,,,,)      -- 10+deriveGeneric ''(,,,,,,,,,,)+deriveGeneric ''(,,,,,,,,,,,)+deriveGeneric ''(,,,,,,,,,,,,)+deriveGeneric ''(,,,,,,,,,,,,,)+deriveGeneric ''(,,,,,,,,,,,,,,) -- 15+deriveGeneric ''[]++-- Other types from base:++-- From Control.Exception:+deriveGeneric ''IOException+deriveGeneric ''ArithException+deriveGeneric ''ArrayException+deriveGeneric ''AssertionFailed+deriveGeneric ''AsyncException+deriveGeneric ''NonTermination+deriveGeneric ''NestedAtomically+deriveGeneric ''BlockedIndefinitelyOnMVar+deriveGeneric ''BlockedIndefinitelyOnSTM+deriveGeneric ''Deadlock+deriveGeneric ''NoMethodError+deriveGeneric ''PatternMatchFail+deriveGeneric ''RecConError+deriveGeneric ''RecSelError+deriveGeneric ''RecUpdError+deriveGeneric ''ErrorCall+deriveGeneric ''MaskingState++-- From Data.Char:+deriveGeneric ''GeneralCategory++-- From Data.Complex:+deriveGeneric ''Complex++-- From Data.Data:+deriveGeneric ''DataRep+deriveGeneric ''Fixity+deriveGeneric ''ConstrRep++-- From Data.Fixed:+deriveGeneric ''Fixed++-- From Data.Monoid:+deriveGeneric ''Dual+deriveGeneric ''Endo+deriveGeneric ''All+deriveGeneric ''Any+deriveGeneric ''Sum+deriveGeneric ''Product+deriveGeneric ''First+deriveGeneric ''Last++-- From Data.Ord:+deriveGeneric ''Down++-- From Data.Proxy:+deriveGeneric ''Proxy++-- From Data.Version:+deriveGeneric ''Version++-- From Foreign.C.Error:+deriveGeneric ''Errno++-- From Foreign.C.Types:+deriveGeneric ''CChar+deriveGeneric ''CSChar+deriveGeneric ''CUChar+deriveGeneric ''CShort+deriveGeneric ''CUShort+deriveGeneric ''CInt+deriveGeneric ''CUInt+deriveGeneric ''CLong+deriveGeneric ''CULong+deriveGeneric ''CPtrdiff+deriveGeneric ''CSize+deriveGeneric ''CWchar+deriveGeneric ''CSigAtomic+deriveGeneric ''CLLong+deriveGeneric ''CULLong+deriveGeneric ''CIntPtr+deriveGeneric ''CUIntPtr+deriveGeneric ''CIntMax+deriveGeneric ''CUIntMax+deriveGeneric ''CClock+deriveGeneric ''CTime+deriveGeneric ''CUSeconds+deriveGeneric ''CSUSeconds+deriveGeneric ''CFloat+deriveGeneric ''CDouble++-- From System.Console.GetOpt:++deriveGeneric ''ArgOrder+deriveGeneric ''OptDescr+deriveGeneric ''ArgDescr++-- From System.Exit:++deriveGeneric ''ExitCode++-- From System.IO:++deriveGeneric ''IOMode+deriveGeneric ''BufferMode+deriveGeneric ''SeekMode+deriveGeneric ''Newline+deriveGeneric ''NewlineMode++-- From Text.Printf:++#if MIN_VERSION_base(4,7,0)+deriveGeneric ''FieldFormat+deriveGeneric ''FormatAdjustment+deriveGeneric ''FormatSign+deriveGeneric ''FormatParse+#endif++-- From Text.Read.Lex:++deriveGeneric ''Lexeme+#if MIN_VERSION_base(4,7,0)+deriveGeneric ''Number+#endif++-- Abstract / primitive datatypes (we don't derive Generic for these):+--+-- Ratio+-- Integer+-- ThreadId+-- Chan+-- MVar+-- QSem+-- QSemN+-- DataType+-- Dynamic+-- IORef+-- TypeRep+-- TyCon+-- TypeRepKey+-- KProxy -- not abstract, but intended for kind-level use+-- STRef+-- Unique+-- ForeignPtr+-- CFile+-- CFpos+-- CJmpBuf+-- Pool+-- Ptr+-- FunPtr+-- IntPtr+-- WordPtr+-- StablePtr+-- Char+-- Double+-- Float+-- Int+-- Int8+-- Int16+-- Int32+-- Int64+-- Word+-- Word8+-- Word16+-- Word32+-- Word64+-- IO+-- ST+-- (->)+-- RealWorld+-- Handle+-- HandlePosn+-- TextEncoding+-- StableName+-- Weak+-- ReadP+-- ReadPrec+--+-- Datatypes we cannot currently handle:+--+-- SomeException+-- SomeAsyncException+-- Handler+-- Coercion+-- (:~:)

@@ -0,0 +1,81 @@+{-# LANGUAGE StandaloneDeriving, UndecidableInstances #-}+-- | Metadata about what a datatype looks like+--+-- In @generics-sop@, the metadata is completely independent of the main+-- universe. Many generic functions will use this metadata, but other don't,+-- and yet others might need completely different metadata.+--+-- This module defines a datatype to represent standard metadata, i.e., names+-- of the datatype, its constructors, and possibly its record selectors.+-- Metadata descriptions are in general GADTs indexed by the code of the+-- datatype they're associated with, so matching on the metadata will reveal+-- information about the shape of the datatype.+--+module Generics.SOP.Metadata+  ( module Generics.SOP.Metadata+    -- * re-exports+  , Associativity(..)+  ) where++import GHC.Generics (Associativity(..))++import Generics.SOP.Constraint+import Generics.SOP.NP+import Generics.SOP.Sing++-- | Metadata for a datatype.+--+-- A value of type @'DatatypeInfo' c@ contains the information about a datatype+-- that is not contained in @'Code' c@. This information consists+-- primarily of the names of the datatype, its constructors, and possibly its+-- record selectors.+--+-- The constructor indicates whether the datatype has been declared using @newtype@+-- or not.+--+data DatatypeInfo :: [[*]] -> * where+  -- Standard algebraic datatype+  ADT     :: ModuleName -> DatatypeName -> NP ConstructorInfo xss -> DatatypeInfo xss+  -- Newtype+  Newtype :: ModuleName -> DatatypeName -> ConstructorInfo '[x]   -> DatatypeInfo '[ '[x] ]++deriving instance All Show (Map ConstructorInfo xs) => Show (DatatypeInfo xs)+deriving instance All Eq   (Map ConstructorInfo xs) => Eq   (DatatypeInfo xs)+deriving instance (All Eq (Map ConstructorInfo xs), All Ord (Map ConstructorInfo xs)) => Ord (DatatypeInfo xs)++-- | Metadata for a single constructors.+--+-- This is indexed by the product structure of the constructor components.+--+data ConstructorInfo :: [*] -> * where+  -- Normal constructor+  Constructor :: SingI xs => ConstructorName -> ConstructorInfo xs+  -- Infix constructor+  Infix :: ConstructorName -> Associativity -> Fixity -> ConstructorInfo '[ x, y ]+  -- Record constructor+  Record :: SingI xs => ConstructorName -> NP FieldInfo xs -> ConstructorInfo xs++deriving instance All Show (Map FieldInfo xs) => Show (ConstructorInfo xs)+deriving instance All Eq   (Map FieldInfo xs) => Eq   (ConstructorInfo xs)+deriving instance (All Eq (Map FieldInfo xs), All Ord (Map FieldInfo xs)) => Ord (ConstructorInfo xs)++-- | For records, this functor maps the component to its selector name.+data FieldInfo :: * -> * where+  FieldInfo :: FieldName -> FieldInfo a+  deriving (Show, Eq, Ord, Functor)++-- | The name of a datatype.+type DatatypeName    = String++-- | The name of a module.+type ModuleName      = String++-- | The name of a data constructor.+type ConstructorName = String++-- | The name of a field / record selector.+type FieldName       = String++-- | The fixity of an infix constructor.+type Fixity          = Int+

@@ -0,0 +1,376 @@+{-# LANGUAGE PolyKinds, StandaloneDeriving, UndecidableInstances #-}+-- | n-ary products (and products of products)+module Generics.SOP.NP+  ( -- * Datatypes+    NP(..)+  , POP(..)+  , unPOP+    -- * Constructing products+  , pure_NP+  , pure_POP+  , cpure_NP+  , cpure_POP+    -- ** Construction from a list+  , fromList+    -- * Application+  , ap_NP+  , ap_POP+    -- * Lifting / mapping+  , liftA_NP+  , liftA_POP+  , liftA2_NP+  , liftA2_POP+  , liftA3_NP+  , liftA3_POP+  , cliftA_NP+  , cliftA_POP+  , cliftA2_NP+  , cliftA2_POP+    -- * Dealing with @'All' c@+  , allDict_NP+  , hcliftA'+  , hcliftA2'+  , hcliftA3'+  , cliftA2'_NP+    -- * Collapsing+  , collapse_NP+  , collapse_POP+    -- * Sequencing+  , sequence'_NP+  , sequence'_POP+  , sequence_NP+  , sequence_POP+  ) where++import Control.Applicative+import Data.Proxy (Proxy(..))++import Generics.SOP.BasicFunctors+import Generics.SOP.Classes+import Generics.SOP.Constraint+import Generics.SOP.Sing++-- | An n-ary product.+--+-- The product is parameterized by a type constructor @f@ and+-- indexed by a type-level list @xs@. The length of the list+-- determines the number of elements in the product, and if the+-- @i@-th element of the list is of type @x@, then the @i@-th+-- element of the product is of type @f x@.+--+-- The constructor names are chosen to resemble the names of the+-- list constructors.+--+-- Two common instantiations of @f@ are the identity functor 'I'+-- and the constant functor 'K'. For 'I', the product becomes a+-- heterogeneous list, where the type-level list describes the+-- types of its components. For @'K' a@, the product becomes a+-- homogeneous list, where the contents of the type-level list are+-- ignored, but its length still specifies the number of elements.+--+-- In the context of the SOP approach to generic programming, an+-- n-ary product describes the structure of the arguments of a+-- single data constructor.+--+-- /Examples:/+--+-- > I 'x'    :* I True  :* Nil  ::  NP I       '[ Char, Bool ]+-- > K 0      :* K 1     :* Nil  ::  NP (K Int) '[ Char, Bool ]+-- > Just 'x' :* Nothing :* Nil  ::  NP Maybe   '[ Char, Bool ]+--+data NP :: (k -> *) -> [k] -> * where+  Nil  :: NP f '[]+  (:*) :: f x -> NP f xs -> NP f (x ': xs)++infixr 5 :*++deriving instance All Show (Map f xs) => Show (NP f xs)+deriving instance All Eq   (Map f xs) => Eq   (NP f xs)+deriving instance (All Eq (Map f xs), All Ord (Map f xs)) => Ord (NP f xs)++-- | A product of products.+--+-- This is a 'newtype' for an 'NP' of an 'NP'. The elements of the+-- inner products are applications of the parameter @f@. The type+-- 'POP' is indexed by the list of lists that determines the lengths+-- of both the outer and all the inner products, as well as the types+-- of all the elements of the inner products.+--+-- A 'POP' is reminiscent of a two-dimensional table (but the inner+-- lists can all be of different length). In the context of the SOP+-- approach to generic programming, a 'POP' is useful to represent+-- information that is available for all arguments of all constructors+-- of a datatype.+--+newtype POP (f :: (k -> *)) (xss :: [[k]]) = POP (NP (NP f) xss)+  deriving (Show, Eq, Ord)++-- | Unwrap a product of products.+unPOP :: POP f xss -> NP (NP f) xss+unPOP (POP xss) = xss++type instance AllMap NP  c xs = All  c xs+type instance AllMap POP c xs = All2 c xs++-- * Constructing products++-- | Specialization of 'hpure'.+--+-- The call @'pure_NP' x@ generates a product that contains 'x' in every+-- element position.+--+-- /Example:/+--+-- >>> pure_NP [] :: NP [] '[Char, Bool]+-- > "" :* [] :* Nil+-- >>> pure_NP (K 0) :: NP (K Int) '[Double, Int, String]+-- > K 0 :* K 0 :* K 0 :* Nil+--+pure_NP :: forall f xs. SingI xs => (forall a. f a) -> NP f xs+pure_NP f = case sing :: Sing xs of+  SNil   -> Nil+  SCons  -> f :* pure_NP f++-- | Specialization of 'hpure'.+--+-- The call @'pure_POP' x@ generates a product of products that contains 'x'+-- in every element position.+--+pure_POP :: forall f xss. SingI xss => (forall a. f a) -> POP f xss+pure_POP f = case sing :: Sing xss of+  SNil   -> POP Nil+  SCons  -> POP (pure_NP f :* unPOP (pure_POP f))++-- | Specialization of 'hcpure'.+--+-- The call @'cpure_NP' p x@ generates a product that contains 'x' in every+-- element position.+--+cpure_NP :: forall c xs f. (All c xs, SingI xs)+         => Proxy c -> (forall a. c a => f a) -> NP f xs+cpure_NP p f = case sing :: Sing xs of+  SNil   -> Nil+  SCons  -> f :* cpure_NP p f++-- | Specialization of 'hcpure'.+--+-- The call @'cpure_NP' p x@ generates a product of products that contains 'x'+-- in every element position.+--+cpure_POP :: forall c f xss. (All2 c xss, SingI xss)+          => Proxy c -> (forall a. c a => f a) -> POP f xss+cpure_POP p f = case sing :: Sing xss of+  SNil   -> POP Nil+  SCons  -> POP (cpure_NP p f :* unPOP (cpure_POP p f))++instance HPure NP where+  hpure  = pure_NP+  hcpure = cpure_NP++instance HPure POP where+  hpure  = pure_POP+  hcpure = cpure_POP++-- ** Construction from a list++-- | Construct a homogeneous n-ary product from a normal Haskell list.+--+-- Returns 'Nothing' if the length of the list does not exactly match the+-- expected size of the product.+--+fromList :: (SingI xs) => [a] -> Maybe (NP (K a) xs)+fromList = go sing+  where+    go :: Sing xs -> [a] -> Maybe (NP (K a) xs)+    go SNil  []     = return Nil+    go SCons (x:xs) = do ys <- go sing xs ; return (K x :* ys)+    go _     _      = Nothing++-- * Application++-- | Specialization of 'hap'.+--+-- Applies a product of (lifted) functions pointwise to a product of+-- suitable arguments.+--+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+ap_NP _ _ = error "inaccessible"++-- | Specialization of 'hap'.+--+-- Applies a product of (lifted) functions pointwise to a product of+-- suitable arguments.+--+ap_POP  :: POP (f -.-> g) xs -> POP  f xs -> POP  g xs+ap_POP (POP Nil        ) (POP Nil        ) = POP Nil+ap_POP (POP (fs :* fss)) (POP (xs :* xss)) = POP (ap_NP fs xs :* unPOP (ap_POP (POP fss) (POP xss)))+ap_POP _ _ = error "inaccessible"++type instance Prod NP  = NP+type instance Prod POP = POP++instance HAp NP  where hap = ap_NP+instance HAp POP where hap = ap_POP++-- * Lifting / mapping++-- | Specialization of 'hliftA'.+liftA_NP  :: SingI xs  => (forall a. f a -> g a) -> NP  f xs  -> NP  g xs+-- | Specialization of 'hliftA'.+liftA_POP :: SingI xss => (forall a. f a -> g a) -> POP f xss -> POP g xss++liftA_NP  = hliftA+liftA_POP = hliftA++-- | Specialization of 'hliftA2'.+liftA2_NP  :: SingI xs  => (forall a. f a -> g a -> h a) -> NP  f xs  -> NP  g xs  -> NP   h xs+-- | Specialization of 'hliftA2'.+liftA2_POP :: SingI xss => (forall a. f a -> g a -> h a) -> POP f xss -> POP g xss -> POP  h xss++liftA2_NP  = hliftA2+liftA2_POP = hliftA2++-- | Specialization of 'hliftA3'.+liftA3_NP  :: SingI xs  => (forall a. f a -> g a -> h a -> i a) -> NP  f xs  -> NP  g xs  -> NP  h xs  -> NP  i xs+-- | Specialization of 'hliftA3'.+liftA3_POP :: SingI xss => (forall a. f a -> g a -> h a -> i a) -> POP f xss -> POP g xss -> POP h xss -> POP i xss++liftA3_NP  = hliftA3+liftA3_POP = hliftA3++-- | Specialization of 'hcliftA'.+cliftA_NP  :: (All  c xs,  SingI xs)  => Proxy c -> (forall a. c a => f a -> g a) -> NP   f xs  -> NP  g xs+-- | Specialization of 'hcliftA'.+cliftA_POP :: (All2 c xss, SingI xss) => Proxy c -> (forall a. c a => f a -> g a) -> POP  f xss -> POP g xss++cliftA_NP  = hcliftA+cliftA_POP = hcliftA++-- | Specialization of 'hcliftA2'.+cliftA2_NP  :: (All  c xs,  SingI xs)  => Proxy c -> (forall a. c a => f a -> g a -> h a) -> NP  f xs  -> NP  g xs  -> NP  h xs+-- | Specialization of 'hcliftA2'.+cliftA2_POP :: (All2 c xss, SingI xss) => Proxy c -> (forall a. c a => f a -> g a -> h a) -> POP f xss -> POP g xss -> POP h xss++cliftA2_NP  = hcliftA2+cliftA2_POP = hcliftA2++-- * Dealing with @'All' c@++-- | Construct a product of dictionaries for a type-level list of lists.+--+-- The structure of the product matches the outer list, the dictionaries+-- contained are 'AllDict'-dictionaries for the inner list.+--+allDict_NP :: forall (c :: k -> Constraint) (xss :: [[k]]). (All2 c xss, SingI xss)+           => Proxy c -> NP (AllDict c) xss+allDict_NP p = case sing :: Sing xss of+  SNil  -> Nil+  SCons -> AllDictC :* allDict_NP p++-- | Lift a constrained function operating on a list-indexed structure+-- to a function on a list-of-list-indexed structure.+--+-- This is a variant of 'hcliftA'.+--+-- /Specification:/+--+-- @+-- 'hcliftA'' p f xs = 'hpure' ('fn_2' $ \\ 'AllDictC' -> f) \` 'hap' \` 'allDict_NP' p \` 'hap' \` xs+-- @+--+-- /Instances:/+--+-- @+-- 'hcliftA'' :: ('All2' c xss, 'SingI' xss) => 'Proxy' c -> (forall xs. ('SingI' xs, 'All' c xs) => f xs -> f' xs) -> 'NP' f xss -> 'NP' f' xss+-- 'hcliftA'' :: ('All2' c xss, 'SingI' xss) => 'Proxy' c -> (forall xs. ('SingI' xs, 'All' c xs) => f xs -> f' xs) -> 'Generics.SOP.NS.NS' f xss -> 'Generics.SOP.NS.NS' f' xss+-- @+--+hcliftA'  :: (All2 c xss, SingI xss, Prod h ~ NP, HAp h) => Proxy c -> (forall xs. (SingI xs, All c xs) => f xs -> f' xs)                                                       -> h f   xss -> h f'   xss++-- | Like 'hcliftA'', but for binary functions.+hcliftA2' :: (All2 c xss, SingI xss, Prod h ~ NP, HAp h) => Proxy c -> (forall xs. (SingI xs, All c xs) => f xs -> f' xs -> f'' xs)            -> Prod h f xss                  -> h f'  xss -> h f''  xss++-- | Like 'hcliftA'', but for ternay functions.+hcliftA3' :: (All2 c xss, SingI xss, Prod h ~ NP, HAp h) => Proxy c -> (forall xs. (SingI xs, All c xs) => f xs -> f' xs -> f'' xs -> f''' xs) -> Prod h f xss -> Prod h f' xss -> h f'' xss -> h f''' xss++hcliftA'  p f xs       = hpure (fn_2 $ \AllDictC -> f) `hap` allDict_NP p `hap` xs+hcliftA2' p f xs ys    = hpure (fn_3 $ \AllDictC -> f) `hap` allDict_NP p `hap` xs `hap` ys+hcliftA3' p f xs ys zs = hpure (fn_4 $ \AllDictC -> f) `hap` allDict_NP p `hap` xs `hap` ys `hap` zs++-- | Specialization of 'hcliftA2''.+cliftA2'_NP :: (All2 c xss, SingI xss) => Proxy c -> (forall xs. (SingI xs, All c xs) => f xs -> g xs -> h xs) -> NP f xss -> NP g xss -> NP h xss++cliftA2'_NP = hcliftA2'++-- * Collapsing++-- | Specialization of 'hcollapse'.+--+-- /Example:/+--+-- >>> collapse_NP (K 1 :* K 2 :* K 3 :* Nil)+-- > [1,2,3]+--+collapse_NP  ::              NP  (K a) xs  ->  [a]++-- | Specialization of 'hcollapse'.+--+-- /Example:/+--+-- >>> collapse_POP (POP ((K 'a' :* Nil) :* (K 'b' :* K 'c' :* Nil) :* Nil) :: POP (K Char) '[ '[(a :: *)], '[b, c] ])+-- > ["a", "bc"]+--+-- (The type signature is only necessary in this case to fix the kind of the type variables.)+--+collapse_POP :: SingI xss => POP (K a) xss -> [[a]]++collapse_NP Nil         = []+collapse_NP (K x :* xs) = x : collapse_NP xs++collapse_POP = collapse_NP . hliftA (K . collapse_NP) . unPOP++type instance CollapseTo NP  = []+type instance CollapseTo POP = ([] :.: [])++instance HCollapse NP  where hcollapse = collapse_NP+instance HCollapse POP where hcollapse = Comp . collapse_POP++-- * Sequencing++-- | Specialization of 'hsequence''.+sequence'_NP  ::             Applicative f  => NP  (f :.: g) xs  -> f (NP  g xs)++-- | Specialization of 'hsequence''.+sequence'_POP :: (SingI xss, Applicative f) => POP (f :.: g) xss -> f (POP g xss)++sequence'_NP Nil         = pure Nil+sequence'_NP (mx :* mxs) = (:*) <$> unComp mx <*> sequence'_NP mxs++sequence'_POP = fmap POP . sequence'_NP . hliftA (Comp . sequence'_NP) . unPOP++instance HSequence NP  where hsequence' = sequence'_NP+instance HSequence POP where hsequence' = sequence'_POP++-- | Specialization of 'hsequence'.+--+-- /Example:/+--+-- >>> sequence_NP (Just 1 :* Just 2 :* Nil)+-- > Just (I 1 :* I 2 :* Nil)+--+sequence_NP  :: (SingI xs,  Applicative f) => NP  f xs  -> f (NP  I xs)++-- | Specialization of 'hsequence'.+--+-- /Example:/+--+-- >>> sequence_POP (POP ((Just 1 :* Nil) :* (Just 2 :* Just 3 :* Nil) :* Nil))+-- > Just (POP ((I 1 :* Nil) :* ((I 2 :* (I 3 :* Nil)) :* Nil)))+--+sequence_POP :: (SingI xss, Applicative f) => POP f xss -> f (POP I xss)++sequence_NP   = hsequence+sequence_POP  = hsequence+

@@ -0,0 +1,278 @@+{-# LANGUAGE PolyKinds, StandaloneDeriving, UndecidableInstances #-}+-- | n-ary sums (and sums of products)+module Generics.SOP.NS+  ( -- * Datatypes+    NS(..)+  , SOP(..)+  , unSOP+    -- * Constructing sums+  , Injection+  , injections+  , shift+  , apInjs_NP+  , apInjs_POP+    -- * Application+  , ap_NS+  , ap_SOP+    -- * Lifting / mapping+  , liftA_NS+  , liftA_SOP+  , liftA2_NS+  , liftA2_SOP+  , cliftA_NS+  , cliftA_SOP+  , cliftA2_NS+  , cliftA2_SOP+    -- * Dealing with @'All' c@+  , cliftA2'_NS+    -- * Collapsing+  , collapse_NS+  , collapse_SOP+    -- * Sequencing+  , sequence'_NS+  , sequence'_SOP+  , sequence_NS+  , sequence_SOP+  ) where++import Control.Applicative+import Data.Proxy (Proxy(..))++import Generics.SOP.BasicFunctors+import Generics.SOP.Classes+import Generics.SOP.Constraint+import Generics.SOP.NP+import Generics.SOP.Sing++-- * Datatypes++-- | An n-ary sum.+--+-- The sum is parameterized by a type constructor @f@ and+-- indexed by a type-level list @xs@. The length of the list+-- determines the number of choices in the sum and if the+-- @i@-th element of the list is of type @x@, then the @i@-th+-- choice of the sum is of type @f x@.+--+-- The constructor names are chosen to resemble Peano-style+-- natural numbers, i.e., 'Z' is for "zero", and 'S' is for+-- "successor". Chaining 'S' and 'Z' chooses the corresponding+-- component of the sum.+--+-- /Examples:/+--+-- > Z         :: f x -> NS f (x ': xs)+-- > S . Z     :: f y -> NS f (x ': y ': xs)+-- > S . S . Z :: f z -> NS f (x ': y ': z ': xs)+-- > ...+--+-- Note that empty sums (indexed by an empty list) have no+-- non-bottom elements.+--+-- Two common instantiations of @f@ are the identity functor 'I'+-- and the constant functor 'K'. For 'I', the sum becomes a+-- direct generalization of the 'Either' type to arbitrarily many+-- choices. For @'K' a@, the result is a homogeneous choice type,+-- where the contents of the type-level list are ignored, but its+-- length specifies the number of options.+--+-- In the context of the SOP approach to generic programming, an+-- n-ary sum describes the top-level structure of a datatype,+-- which is a choice between all of its constructors.+--+-- /Examples:/+--+-- > Z (I 'x')      :: NS I       '[ Char, Bool ]+-- > S (Z (I True)) :: NS I       '[ Char, Bool ]+-- > S (Z (I 1))    :: NS (K Int) '[ Char, Bool ]+--+data NS :: (k -> *) -> [k] -> * where+  Z :: f x -> NS f (x ': xs)+  S :: NS f xs -> NS f (x ': xs)++deriving instance All Show (Map f xs) => Show (NS f xs)+deriving instance All Eq   (Map f xs) => Eq   (NS f xs)+deriving instance (All Eq (Map f xs), All Ord (Map f xs)) => Ord (NS f xs)++-- | A sum of products.+--+-- This is a 'newtype' for an 'NS' of an 'NP'. The elements of the+-- (inner) products are applications of the parameter @f@. The type+-- 'SOP' is indexed by the list of lists that determines the sizes+-- of both the (outer) sum and all the (inner) products, as well as+-- the types of all the elements of the inner products.+--+-- An @'SOP' 'I'@ reflects the structure of a normal Haskell datatype.+-- The sum structure represents the choice between the different+-- constructors, the product structure represents the arguments of+-- each constructor.+--+newtype SOP (f :: (k -> *)) (xss :: [[k]]) = SOP (NS (NP f) xss)+  deriving (Show, Eq, Ord)++-- | Unwrap a sum of products.+unSOP :: SOP f xss -> NS (NP f) xss+unSOP (SOP xss) = xss++-- * Constructing sums++-- | The type of injections into an n-ary sum.+--+-- If you expand the type synonyms and newtypes involved, you get+--+-- > Injection f xs a = (f -.-> K (NS f xs)) a ~= f a -> K (NS f xs) a ~= f a -> K (NS f xs)+--+-- If we pick @a@ to be an element of @xs@, this indeed corresponds to an+-- injection into the sum.+--+type Injection (f :: k -> *) (xs :: [k]) = f -.-> K (NS f xs)++-- | Compute all injections into an n-ary sum.+--+-- Each element of the resulting product contains one of the injections.+--+injections :: forall xs f. SingI xs => NP (Injection f xs) xs+injections = case sing :: Sing xs of+  SNil   -> Nil+  SCons  -> fn (K . Z) :* liftA_NP shift injections++-- | 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++-- | Apply injections to a product.+--+-- Given a product containing all possible choices, produce a+-- list of sums by applying each injection to the appropriate+-- element.+--+-- /Example:/+--+-- >>> apInjs_NP (I 'x' :* I True :* I 2 :* Nil)+-- > [Z (I 'x'), S (Z (I True)), S (S (Z (I 2)))]+--+apInjs_NP  :: SingI xs  => NP  f xs  -> [NS  f xs]+apInjs_NP  = hcollapse . hap injections++-- | Apply injections to a product of product.+--+-- This operates on the outer product only. Given a product+-- containing all possible choices (that are products),+-- produce a list of sums (of products) by applying each+-- injection to the appropriate element.+--+-- /Example:/+--+-- >>> apInjs_POP (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil))+-- > [SOP (Z (I 'x' :* Nil)),SOP (S (Z (I True :* (I 2 :* Nil))))]+--+apInjs_POP :: SingI xss => POP f xss -> [SOP f xss]+apInjs_POP = map SOP . apInjs_NP . unPOP++-- * Application++-- | Specialization of 'hap'.+ap_NS :: NP (f -.-> g) xs -> NS f xs -> NS g xs+ap_NS (Fn f  :* _)   (Z x)   = Z (f x)+ap_NS (_     :* fs)  (S xs)  = S (ap_NS fs xs)+ap_NS _ _ = error "inaccessible"++-- | Specialization of 'hap'.+ap_SOP  :: POP (f -.-> g) xs -> SOP  f xs -> SOP  g xs+ap_SOP (POP (fs :* _)  ) (SOP (Z xs) ) = SOP (Z (ap_NP  fs  xs))+ap_SOP (POP (_  :* fss)) (SOP (S xss)) = SOP (S (unSOP (ap_SOP (POP fss) (SOP xss))))+ap_SOP _ _ = error "inaccessible"++type instance Prod NS  = NP+type instance Prod SOP = POP++instance HAp NS  where hap = ap_NS+instance HAp SOP where hap = ap_SOP++-- * Lifting / mapping++-- | Specialization of 'hliftA'.+liftA_NS  :: SingI xs  => (forall a. f a -> g a) -> NS  f xs  -> NS  g xs+-- | Specialization of 'hliftA'.+liftA_SOP :: SingI xss => (forall a. f a -> g a) -> SOP f xss -> SOP g xss++liftA_NS  = hliftA+liftA_SOP = hliftA++-- | Specialization of 'hliftA2'.+liftA2_NS  :: SingI xs  => (forall a. f a -> g a -> h a) -> NP  f xs  -> NS  g xs  -> NS   h xs+-- | Specialization of 'hliftA2'.+liftA2_SOP :: SingI xss => (forall a. f a -> g a -> h a) -> POP f xss -> SOP g xss -> SOP  h xss++liftA2_NS  = hliftA2+liftA2_SOP = hliftA2++-- | Specialization of 'hcliftA'.+cliftA_NS  :: (All  c xs,  SingI xs)  => Proxy c -> (forall a. c a => f a -> g a) -> NS   f xs  -> NS  g xs+-- | Specialization of 'hcliftA'.+cliftA_SOP :: (All2 c xss, SingI xss) => Proxy c -> (forall a. c a => f a -> g a) -> SOP  f xss -> SOP g xss++cliftA_NS  = hcliftA+cliftA_SOP = hcliftA++-- | Specialization of 'hcliftA2'.+cliftA2_NS  :: (All  c xs,  SingI xs)  => Proxy c -> (forall a. c a => f a -> g a -> h a) -> NP  f xs  -> NS  g xs  -> NS  h xs+-- | Specialization of 'hcliftA2'.+cliftA2_SOP :: (All2 c xss, SingI xss) => Proxy c -> (forall a. c a => f a -> g a -> h a) -> POP f xss -> SOP g xss -> SOP h xss++cliftA2_NS  = hcliftA2+cliftA2_SOP = hcliftA2++-- * Dealing with @'All' c@++-- | Specialization of 'hcliftA2''.+cliftA2'_NS :: (All2 c xss, SingI xss) => Proxy c -> (forall xs. (SingI xs, All c xs) => f xs -> g xs -> h xs) -> NP f xss -> NS g xss -> NS h xss++cliftA2'_NS = hcliftA2'++-- * Collapsing++-- | Specialization of 'hcollapse'.+collapse_NS  ::              NS  (K a) xs  ->   a+-- | Specialization of 'hcollapse'.+collapse_SOP :: SingI xss => SOP (K a) xss ->  [a]++collapse_NS (Z (K x)) = x+collapse_NS (S xs)    = collapse_NS xs++collapse_SOP = collapse_NS . hliftA (K . collapse_NP) . unSOP++type instance CollapseTo NS  = I+type instance CollapseTo SOP = []++instance HCollapse NS  where hcollapse = I . collapse_NS+instance HCollapse SOP where hcollapse = collapse_SOP++-- * Sequencing++-- | Specialization of 'hsequence''.+sequence'_NS  ::             Applicative f  => NS  (f :.: g) xs  -> f (NS  g xs)++-- | Specialization of 'hsequence''.+sequence'_SOP :: (SingI xss, Applicative f) => SOP (f :.: g) xss -> f (SOP g xss)++sequence'_NS (Z mx)  = Z <$> unComp mx+sequence'_NS (S mxs) = S <$> sequence'_NS mxs++sequence'_SOP = fmap SOP . sequence'_NS . hliftA (Comp . sequence'_NP) . unSOP++instance HSequence NS  where hsequence' = sequence'_NS+instance HSequence SOP where hsequence' = sequence'_SOP++-- | Specialization of 'hsequence'.+sequence_NS  :: (SingI xs,  Applicative f) => NS  f xs  -> f (NS  I xs)++-- | Specialization of 'hsequence'.+sequence_SOP :: (SingI xss, Applicative f) => SOP f xss -> f (SOP I xss)++sequence_NS   = hsequence+sequence_SOP  = hsequence+

@@ -0,0 +1,104 @@+{-# LANGUAGE PolyKinds, StandaloneDeriving #-}+#if MIN_VERSION_base(4,7,0)+{-# LANGUAGE NoAutoDeriveTypeable #-}+#endif+-- | Singleton types corresponding to type-level data structures.+--+-- The implementation is similar, but subtly different to that of the+-- @<https://hackage.haskell.org/packages/singletons singletons>@ package.+-- See the <http://www.andres-loeh.de/TrueSumsOfProducts "True Sums of Products">+-- paper for details.+--+module Generics.SOP.Sing+  ( -- * Singletons+    Sing(..)+  , SingI(..)+    -- ** Shape of type-level lists+  , Shape(..)+  , shape+  , lengthSing+  ) where++import Data.Proxy (Proxy(..))++-- * Singletons++-- | Explicit singleton.+--+-- A singleton can be used to reveal the structure of a type+-- argument that the function is quantified over.+--+-- The family 'Sing' should have at most one instance per kind,+-- and there should be a matching instance for 'SingI'.+--+data family Sing (a :: k)++-- | Singleton for type-level lists.+data instance Sing (xs :: [k]) where+  SNil  :: Sing '[]+  SCons :: (SingI x, SingI xs) => Sing (x ': xs)++deriving instance Show (Sing (xs :: [k]))+deriving instance Eq   (Sing (xs :: [k]))+deriving instance Ord  (Sing (xs :: [k]))++-- | Singleton for types of kind '*'.+--+-- For types of kind '*', we explicitly /don't/ want to reveal+-- more type analysis. Even functions that have a 'Sing' constraint+-- should still be parametric in everything that is of kind '*'.+--+data instance Sing (x :: *) where+  SStar :: Sing (x :: *)++deriving instance Show (Sing (x :: *))+deriving instance Eq   (Sing (x :: *))+deriving instance Ord  (Sing (x :: *))++-- | Implicit singleton.+--+-- A singleton can be used to reveal the structure of a type+-- argument that the function is quantified over.+--+-- The class 'SingI' should have instances that match the+-- family instances for 'Sing'.+--+class SingI (a :: k) where+  -- | Get hold of the explicit singleton (that one can then+  -- pattern match on).+  sing :: Sing a++instance SingI (x :: *) where+  sing = SStar++instance SingI '[] where+  sing = SNil++instance (SingI x, SingI xs) => SingI (x ': xs) where+  sing = SCons++-- * Shape of type-level lists++-- | Occassionally it is useful to have an explicit, term-level, representation+-- of type-level lists (esp because of https://ghc.haskell.org/trac/ghc/ticket/9108)+data Shape :: [k] -> * where+  ShapeNil  :: Shape '[]+  ShapeCons :: SingI xs => Shape xs -> Shape (x ': xs)++deriving instance Show (Shape xs)+deriving instance Eq   (Shape xs)+deriving instance Ord  (Shape xs)++-- | The shape of a type-level list.+shape :: forall (xs :: [k]). SingI xs => Shape xs+shape = case sing :: Sing xs of+          SNil  -> ShapeNil+          SCons -> ShapeCons shape++-- | The length of a type-level list.+lengthSing :: forall (xs :: [k]). SingI xs => Proxy xs -> Int+lengthSing _ = lengthShape (shape :: Shape xs)+  where+    lengthShape :: forall xs'. Shape xs' -> Int+    lengthShape ShapeNil      = 0+    lengthShape (ShapeCons s) = 1 + lengthShape s

@@ -0,0 +1,238 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Generate @generics-sop@ boilerplate instances using Template Haskell.+module Generics.SOP.TH+  ( deriveGeneric+  , deriveGenericOnly+  ) where++import Control.Monad (replicateM)+import Data.Maybe (fromMaybe)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax hiding (Infix)++import Generics.SOP.BasicFunctors+import Generics.SOP.Metadata+import Generics.SOP.NP+import Generics.SOP.NS+import Generics.SOP.Universe++-- | Generate @generics-sop@ boilerplate for the given datatype.+--+-- This function takes the name of a datatype and generates:+--+--   * a 'Code' instance+--   * a 'Generic' instance+--   * a 'HasDatatypeInfo' instance+--+-- Note that the generated code will require the @TypeFamilies@ and+-- @DataKinds@ extensions to be enabled for the module.+--+-- /Example:/ If you have the datatype+--+-- > data Tree = Leaf Int | Node Tree Tree+--+-- and say+--+-- > deriveGeneric ''Tree+--+-- then you get code that is equivalent to:+--+-- > instance Generic Tree where+-- >+-- >   type Code Tree = '[ '[Int], '[Tree, Tree] ]+-- >+-- >   from (Leaf x)   = SOP (   Z (I x :* Nil))+-- >   from (Node l r) = SOP (S (Z (I l :* I r :* Nil)))+-- >+-- >   to (SOP    (Z (I x :* Nil)))         = Leaf x+-- >   to (SOP (S (Z (I l :* I r :* Nil)))) = Node l r+-- >   to _ = error "unreachable" -- to avoid GHC warnings+-- >+-- > instance HasDatatypeInfo Tree where+-- >   datatypeInfo _ = ADT "Main" "Tree"+-- >     (Constructor "Leaf" :* Constructor "Node" :* Nil)+--+-- /Limitations:/ Generation does not work for GADTs, for+-- datatypes that involve existential quantification, for+-- datatypes with unboxed fields.+--+deriveGeneric :: Name -> Q [Dec]+deriveGeneric n = do+  dec <- reifyDec n+  ds1 <- withDataDec dec deriveGenericForDataDec+  ds2 <- withDataDec dec deriveMetadataForDataDec+  return (ds1 ++ ds2)++-- | Like 'deriveGeneric', but omit the 'HasDatatypeInfo' instance.+deriveGenericOnly :: Name -> Q [Dec]+deriveGenericOnly n = do+  dec <- reifyDec n+  withDataDec dec deriveMetadataForDataDec++deriveGenericForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Q [Dec]+deriveGenericForDataDec _isNewtype _cxt name bndrs cons _derivs = do+  let typ = appTyVars name bndrs+#if MIN_VERSION_template_haskell(2,9,0)+  let codeSyn = tySynInstD ''Code $ tySynEqn [typ] (codeFor cons)+#else+  let codeSyn = tySynInstD ''Code [typ] (codeFor cons)+#endif+  inst <- instanceD+            (cxt [])+            [t| Generic $typ |]+            [codeSyn, embedding cons, projection cons]+  return [inst]++deriveMetadataForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Q [Dec]+deriveMetadataForDataDec isNewtype _cxt name bndrs cons _derivs = do+  let typ = appTyVars name bndrs+  md   <- instanceD (cxt [])+            [t| HasDatatypeInfo $typ |]+            [metadata isNewtype name cons]+  return [md]++{-------------------------------------------------------------------------------+  Computing the code for a data type+-------------------------------------------------------------------------------}++codeFor :: [Con] -> Q Type+codeFor = promotedTypeList . map go+  where+    go :: Con -> Q Type+    go c = do (_, ts) <- conInfo c+              promotedTypeList ts++{-------------------------------------------------------------------------------+  Computing the embedding/projection pair+-------------------------------------------------------------------------------}++embedding :: [Con] -> Q Dec+embedding = funD 'from . go (\e -> [| Z $e |])+  where+    go :: (Q Exp -> Q Exp) -> [Con] -> [Q Clause]+    go _  []     = []+    go br (c:cs) = mkClause br c : go (\e -> [| S $(br e) |]) cs++    mkClause :: (Q Exp -> Q Exp) -> Con -> Q Clause+    mkClause br c = do+      (n, ts) <- conInfo c+      vars    <- replicateM (length ts) (newName "x")+      clause [conP n (map varP vars)]+             (normalB [| SOP $(br . npE . map (appE (conE 'I) . varE) $ vars) |])+             []++projection :: [Con] -> Q Dec+projection = funD 'to . go (\p -> conP 'Z [p])+  where+    go :: (Q Pat -> Q Pat) -> [Con] -> [Q Clause]+    go _ [] = [unreachable]+    go br (c:cs) = mkClause br c : go (\p -> conP 'S [br p]) cs++    mkClause :: (Q Pat -> Q Pat) -> Con -> Q Clause+    mkClause br c = do+      (n, ts) <- conInfo c+      vars    <- replicateM (length ts) (newName "x")+      clause [conP 'SOP [br . npP . map (\v -> conP 'I [varP v]) $ vars]]+             (normalB . appsE $ conE n : map varE vars)+             []++unreachable :: Q Clause+unreachable = clause [wildP]+                     (normalB [| error "unreachable" |])+                     []++{-------------------------------------------------------------------------------+  Compute metadata+-------------------------------------------------------------------------------}++metadata :: Bool -> Name -> [Con] -> Q Dec+metadata isNewtype typeName cs =+    funD 'datatypeInfo [clause [wildP] (normalB md) []]+  where+    md :: Q Exp+    md | isNewtype = [| Newtype $(stringE (nameModule' typeName))+                                $(stringE (nameBase typeName))+                                $(mdCon (head cs))+                      |]+       | otherwise = [| ADT     $(stringE (nameModule' typeName))+                                $(stringE (nameBase typeName))+                                $(npE $ map mdCon cs)+                      |]+++    mdCon :: Con -> Q Exp+    mdCon (NormalC n _)   = [| Constructor $(stringE (nameBase n)) |]+    mdCon (RecC n ts)     = [| Record      $(stringE (nameBase n))+                                           $(npE (map mdField ts))+                             |]+    mdCon (InfixC _ n _)  = do+      i <- reify n+      case i of+        DataConI _ _ _ (Fixity f a) ->+                            [| Infix       $(stringE (nameBase n)) $(mdAssociativity a) f |]+        _                -> fail "Strange infix operator"+    mdCon (ForallC _ _ _) = fail "Existentials not supported"++    mdField :: VarStrictType -> Q Exp+    mdField (n, _, _) = [| FieldInfo $(stringE (nameBase n)) |]++    mdAssociativity :: FixityDirection -> Q Exp+    mdAssociativity InfixL = [| LeftAssociative  |]+    mdAssociativity InfixR = [| RightAssociative |]+    mdAssociativity InfixN = [| NotAssociative   |]++nameModule' :: Name -> String+nameModule' = fromMaybe "" . nameModule++{-------------------------------------------------------------------------------+  Constructing n-ary pairs+-------------------------------------------------------------------------------}++-- Given+--+-- > [a, b, c]+--+-- Construct+--+-- > a :* b :* c :* Nil+npE :: [Q Exp] -> Q Exp+npE []     = [| Nil |]+npE (e:es) = [| $e :* $(npE es) |]++-- Like npE, but construct a pattern instead+npP :: [Q Pat] -> Q Pat+npP []     = conP 'Nil []+npP (p:ps) = conP '(:*) [p, npP ps]++{-------------------------------------------------------------------------------+  Some auxiliary definitions for working with TH+-------------------------------------------------------------------------------}++conInfo :: Con -> Q (Name, [Q Type])+conInfo (NormalC n ts) = return (n, map (return . (\(_, t)    -> t)) ts)+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"++promotedTypeList :: [Q Type] -> Q Type+promotedTypeList []     = promotedNilT+promotedTypeList (t:ts) = [t| $promotedConsT $t $(promotedTypeList ts) |]++appTyVars :: Name -> [TyVarBndr] -> Q Type+appTyVars n = go (conT n)+  where+    go :: Q Type -> [TyVarBndr] -> Q Type+    go t []                  = t+    go t (PlainTV  v   : vs) = go [t| $t $(varT v) |] vs+    go t (KindedTV v _ : vs) = go [t| $t $(varT v) |] vs++reifyDec :: Name -> Q Dec+reifyDec name =+  do info <- reify name+     case info of TyConI dec -> return dec+                  _          -> fail "Info must be type declaration type."++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+withDataDec _ _ = fail "Can only derive labels for datatypes and newtypes."

@@ -0,0 +1,137 @@+{-# LANGUAGE UndecidableInstances #-}+-- | Codes and interpretations+module Generics.SOP.Universe where++import Data.Proxy+import qualified GHC.Generics as GHC++import Generics.SOP.BasicFunctors+import Generics.SOP.NS+import Generics.SOP.Sing+import Generics.SOP.GGP+import Generics.SOP.Metadata++-- | The (generic) representation of a datatype.+--+-- A datatype is isomorphic to the sum-of-products of its code.+-- The isomorphism is witnessed by 'from' and 'to' from the+-- 'Generic' class.+--+type Rep a = SOP I (Code a)++-- | The class of representable datatypes.+--+-- The SOP approach to generic programming is based on viewing+-- datatypes as a representation ('Rep') built from the sum of+-- products of its components. The components of are datatype+-- are specified using the 'Code' type family.+--+-- The isomorphism between the original Haskell datatype and its+-- representation is witnessed by the methods of this class,+-- 'from' and 'to'. So for instances of this class, the following+-- laws should (in general) hold:+--+-- @+-- 'to' '.' 'from' === 'id' :: a -> a+-- 'from' '.' 'to' === 'id' :: 'Rep' a -> 'Rep' a+-- @+--+-- You typically don't define instances of this class by hand, but+-- rather derive the class instance automatically.+--+-- /Option 1:/ Derive via the built-in GHC-generics. For this, you+-- need to use the @DeriveGeneric@ extension to first derive an+-- instance of the 'GHC.Generics.Generic' class from module "GHC.Generics".+-- With this, you can then give an empty instance for 'Generic', and+-- the default definitions will just work. The pattern looks as+-- follows:+--+-- @+-- import qualified "GHC.Generics" as GHC+-- import "Generics.SOP"+--+-- ...+--+-- data T = ... deriving (GHC.'GHC.Generics.Generic', ...)+--+-- instance 'Generic' T -- empty+-- instance 'HasDatatypeInfo' T -- empty, if you want/need metadata+-- @+--+-- /Option 2:/ Derive via Template Haskell. For this, you need to+-- enable the @TemplateHaskell@ extension. You can then use+-- 'Generics.SOP.TH.deriveGeneric' from module "Generics.SOP.TH"+-- to have the instance generated for you. The pattern looks as+-- follows:+--+-- @+-- import "Generics.SOP"+-- import "Generics.SOP.TH"+--+-- ...+--+-- data T = ...+--+-- 'Generics.SOP.TH.deriveGeneric' \'\'T -- derives 'HasDatatypeInfo' as well+-- @+--+-- /Tradeoffs:/ Whether to use Option 1 or 2 is mainly a matter+-- of personal taste. The version based on Template Haskell probably+-- has less run-time overhead.+--+-- /Non-standard instances:/+-- It is possible to give 'Generic' instances manually that deviate+-- from the standard scheme, as long as at least+--+-- @+-- 'to' '.' 'from' === 'id' :: a -> a+-- @+--+-- still holds.+--+class SingI (Code a) => Generic (a :: *) where+  -- | The code of a datatype.+  --+  -- This is a list of lists of its components. The outer list contains+  -- one element per constructor. The inner list contains one element+  -- per constructor argument (field).+  --+  -- /Example:/ The datatype+  --+  -- > data Tree = Leaf Int | Node Tree Tree+  --+  -- is supposed to have the following code:+  --+  -- > type instance Code (Tree a) =+  -- >   '[ '[ Int ]+  -- >    , '[ Tree, Tree ]+  -- >    ]+  --+  type Code a :: [[*]]+  type Code a = GCode a++  -- | Converts from a value to its structural representation.+  from         :: a -> Rep a+  default from :: (GFrom a, GHC.Generic a) => a -> SOP I (GCode a)+  from = gfrom++  -- | Converts from a structural representation back to the+  -- original value.+  to         :: Rep a -> a+  default to :: (GTo a, GHC.Generic a) => SOP I (GCode a) -> a+  to = gto++-- | A class of datatypes that have associated metadata.+--+-- It is possible to use the sum-of-products approach to generic programming+-- without metadata. If you need metadata in a function, an additional+-- constraint on this class is in order.+--+-- You typically don't define instances of this class by hand, but+-- rather derive the class instance automatically. See the documentation+-- of 'Generic' for the options.+--+class HasDatatypeInfo a where+  datatypeInfo         :: Proxy a -> DatatypeInfo (Code a)+  default datatypeInfo :: (GDatatypeInfo a) => Proxy a -> DatatypeInfo (GCode a)+  datatypeInfo = gdatatypeInfo