packages feed

one-liner 0.5.2 → 0.6

raw patch · 10 files changed

+207/−883 lines, 10 filesdep +profunctorsdep ~basedep ~contravariantdep ~ghc-prim

Dependencies added: profunctors

Dependency ranges changed: base, contravariant, ghc-prim, transformers

Files

examples/defaultsignature.hs view
@@ -22,7 +22,7 @@   enumAll :: [t]    default enumAll :: (ADT t, Constraints t EnumAll) => [t]-  enumAll = concat $ createA (For :: For EnumAll) enumAll+  enumAll = concat $ createA (For :: For EnumAll) [enumAll]  instance EnumAll Bool instance EnumAll a => EnumAll (Maybe a)
examples/realworld.hs view
@@ -3,12 +3,11 @@ import Generics.OneLiner  import Data.Monoid-import Control.Lens (Traversal')-import Data.Typeable+-- import Control.Lens (Traversal')+-- import Data.Typeable import Control.DeepSeq import Test.SmallCheck.Series import Control.Monad.Logic.Class-import Control.Applicative import Control.Monad import Data.Hashable import Data.Functor.Contravariant@@ -18,16 +17,7 @@ import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen --- http://hackage.haskell.org/package/lens-4.3.3/docs/Generics-Deriving-Lens.html-whenCastableOrElse :: forall a b f. (Typeable a, Typeable b) => (b -> f b) -> (a -> f a) -> a -> f a-whenCastableOrElse f g = maybe g (\Refl -> f) (eqT :: Maybe (a :~: b)) -tinplate :: forall t b. (Typeable b, Deep Typeable t) => Traversal' t b-tinplate f-  | isAtom (Proxy :: Proxy t) = f `whenCastableOrElse` pure-  | otherwise = gtraverse (For :: For (Deep Typeable)) $ f `whenCastableOrElse` tinplate f-- -- http://hackage.haskell.org/package/deepseq-generics-0.1.1.1/docs/src/Control-DeepSeq-Generics.html -- This would work if the monoid instance of () would have been strict, now it doesn't... grnf :: (ADT t, Constraints t NFData) => t -> ()@@ -41,12 +31,12 @@   Fair fs <*> Fair as = Fair $ fs <~> as  gseries :: forall t m. (ADT t, Constraints t (Serial m), MonadLogic m) => Series m t-gseries = foldr ((\/) . decDepth . runFair) mzero $ createA (For :: For (Serial m)) (Fair series)+gseries = foldr ((\/) . decDepth . runFair) mzero $ createA (For :: For (Serial m)) [Fair series]  newtype CoSeries m a = CoSeries { runCoSeries :: forall r. Series m r -> Series m (a -> r) } instance Contravariant (CoSeries m) where   contramap f (CoSeries g) = CoSeries $ fmap (. f) . g-instance MonadLogic m => Divisible (CoSeries m) where+instance Divisible (CoSeries m) where   divide f (CoSeries g) (CoSeries h) = CoSeries $ \rs -> do     rs' <- fixDepth rs     f2 <- decDepthChecked (constM $ constM rs') (g $ h rs')@@ -70,11 +60,7 @@  -- http://hackage.haskell.org/package/binary-0.7.2.1/docs/Data-Binary.html gget :: (ADT t, Constraints t Binary) => Get t-gget = getWord8 >>= \ix -> createA (For :: For Binary) get !! fromEnum ix--instance Monoid Put where-  mempty = return ()-  mappend = (>>)+gget = getWord8 >>= \ix -> createA (For :: For Binary) [get] !! fromEnum ix  gput :: (ADT t, Constraints t Binary) => t -> Put gput t = putWord8 (toEnum (ctorIndex t)) <> gfoldMap (For :: For Binary) put t@@ -89,9 +75,19 @@   conquer = CoArb $ const id instance Decidable CoArb where   choose f (CoArb g) (CoArb h) = CoArb $ \a -> case f a of-    Left b -> variant 0 . g b-    Right c -> variant 1 . h c+    Left b -> variant (0::Int) . g b+    Right c -> variant (1::Int) . h c   lose f = CoArb $ absurd . f  gcoarbitrary :: (ADT t, Constraints t CoArbitrary) => t -> Gen b -> Gen b gcoarbitrary = unCoArb $ consume (For :: For CoArbitrary) (CoArb coarbitrary)+++-- -- http://hackage.haskell.org/package/lens-4.3.3/docs/Generics-Deriving-Lens.html+-- whenCastableOrElse :: forall a b f. (Typeable a, Typeable b) => (b -> f b) -> (a -> f a) -> a -> f a+-- whenCastableOrElse f g = maybe g (\Refl -> f) (eqT :: Maybe (a :~: b))+--+-- tinplate :: forall t b. (Typeable b, Deep Typeable t) => Traversal' t b+-- tinplate f+--   | isAtom (Proxy :: Proxy t) = f `whenCastableOrElse` pure+--   | otherwise = gtraverse (For :: For (Deep Typeable)) $ f `whenCastableOrElse` tinplate f
one-liner.cabal view
@@ -1,5 +1,5 @@ Name:                 one-liner-Version:              0.5.2+Version:              0.6 Synopsis:             Constraint-based generics Description:          Write short and concise generic instances of type classes.                       .@@ -27,17 +27,14 @@    Exposed-modules:     Generics.OneLiner-    Generics.OneLiner.ADT-    Generics.OneLiner.ADT1-    Generics.OneLiner.Functions-    Generics.OneLiner.Functions1-    Generics.OneLiner.Info+    Generics.OneLiner.Internal    Build-depends:-      base         >= 4.7 && < 5-    , transformers >= 0.3 && < 0.6-    , contravariant >= 1.2 && < 1.4-    , ghc-prim+      base          >= 4.9 && < 5+    , transformers  >= 0.5 && < 0.6+    , contravariant >= 1.4 && < 1.5+    , ghc-prim      >= 0.5 && < 1.0+    , profunctors   >= 5.2 && < 6.0  source-repository head   type:     git
src/Generics/OneLiner.hs view
@@ -13,17 +13,10 @@ -- ----------------------------------------------------------------------------- {-# LANGUAGE-    GADTs-  , DataKinds-  , RankNTypes+    RankNTypes   , TypeFamilies-  , TypeOperators   , ConstraintKinds   , FlexibleContexts-  , FlexibleInstances-  , ScopedTypeVariables-  , UndecidableInstances-  , MultiParamTypeClasses   #-} module Generics.OneLiner (   -- * Producing values@@ -36,181 +29,81 @@   consume,   -- * Single constructor functions   op0, op1, op2,+  -- * Generic programming with profunctors+  GenericProfunctor(..), generic,   -- * Types-  ADT, ADTRecord, ADTNonEmpty, CtorCount, Constraints, For(..), Deep, DeepConstraint, isAtom+  ADT, ADTRecord, ADTNonEmpty, CtorCount, Constraints, For(..) ) where  import GHC.Generics-import GHC.Prim (Constraint)-import GHC.TypeLits import Control.Applicative import Data.Functor.Identity-import Data.Monoid-import Data.Proxy-import Data.Typeable import Data.Functor.Contravariant import Data.Functor.Contravariant.Divisible+import Data.Profunctor+import Generics.OneLiner.Internal -type family Constraints' (t :: * -> *) (c :: * -> Constraint) :: Constraint-type instance Constraints' V1 c = ()-type instance Constraints' U1 c = ()-type instance Constraints' (f :+: g) c = (Constraints' f c, Constraints' g c)-type instance Constraints' (f :*: g) c = (Constraints' f c, Constraints' g c)-type instance Constraints' (K1 i v) c = c v-type instance Constraints' (M1 i t f) c = Constraints' f c -class ADT' (t :: * -> *) where-  type CtorCount' t :: Nat-  type CtorCount' t = 1-  ctorIndex' :: t x -> Int-  ctorIndex' _ = 0-  ctorCount :: proxy t -> Int-  ctorCount _ = 1-  f0 :: (Constraints' t c, Applicative f)-     => for c -> (forall s. c s => f s) -> [f (t ())]-  f1 :: (Constraints' t c, Applicative f)-     => for c -> (forall s. c s => s -> f s) -> t x -> f (t x)-  f2 :: (Constraints' t c, Applicative f)-     => for c -> (forall s. c s => s -> s -> f s) -> t x -> t x -> Maybe (f (t x))-  c0 :: (Constraints' t c, Decidable f)-     => for c -> (forall s. c s => f s) -> f (t ())+newtype Zip f a b = Zip { runZip :: a -> a -> Maybe (f b) }+instance Functor f => Profunctor (Zip f) where+  dimap f g (Zip h) = Zip $ \a1 a2 -> fmap (fmap g) (h (f a1) (f a2))+instance Applicative f => GenericProfunctor (Zip f) where+  zero = Zip . const $ Just . pure+  unit = Zip . const $ Just . pure+  plus (Zip f) (Zip g) = Zip h where+    h (L1 a) (L1 b) = fmap (fmap L1) (f a b)+    h (R1 a) (R1 b) = fmap (fmap R1) (g a b)+    h _ _ = Nothing+  mult (Zip f) (Zip g) = Zip $ \(al :*: ar) (bl :*: br) -> liftA2 (:*:) <$> f al bl <*> g ar br -instance ADT' V1 where-  type CtorCount' V1 = 0-  ctorCount _ = 0-  f0 _ _ = []-  f1 _ _ = pure-  f2 _ _ _ = Just . pure-  c0 _ _ = lose (\v -> v `seq` undefined)+newtype Create f a b = Create { unCreate :: [f b] }+instance Functor f => Profunctor (Create f) where+  dimap _ f = Create . map (fmap f) . unCreate+instance Applicative f => GenericProfunctor (Create f) where+  zero = Create []+  unit = Create [pure U1]+  plus (Create l) (Create r) = Create $ map (fmap L1) l ++ map (fmap R1) r+  mult (Create l) (Create r) = Create $ liftA2 (:*:) <$> l <*> r -instance (ADT' f, ADT' g) => ADT' (f :+: g) where-  type CtorCount' (f :+: g) = CtorCount' f + CtorCount' g-  ctorIndex' (L1 l) = ctorIndex' l-  ctorIndex' (R1 r) = ctorCount (Proxy :: Proxy f) + ctorIndex' r-  ctorCount _ = ctorCount (Proxy :: Proxy f) + ctorCount (Proxy :: Proxy g)-  f0 for f = map (fmap L1) (f0 for f) ++ map (fmap R1) (f0 for f)-  f1 for f (L1 l) = L1 <$> f1 for f l-  f1 for f (R1 r) = R1 <$> f1 for f r-  f2 for f (L1 a) (L1 b) = fmap (fmap L1) (f2 for f a b)-  f2 for f (R1 a) (R1 b) = fmap (fmap R1) (f2 for f a b)-  f2 _ _ _ _ = Nothing-  c0 for f = choose h (c0 for f) (c0 for f) where+newtype Consume f a b = Consume { unConsume :: f a }+instance Contravariant f => Profunctor (Consume f) where+  dimap f _ = Consume . contramap f . unConsume+instance Decidable f => GenericProfunctor (Consume f) where+  zero = Consume $ lose (\v -> v `seq` undefined)+  unit = Consume conquer+  plus (Consume f) (Consume g) = Consume $ choose h f g where     h (L1 l) = Left l     h (R1 r) = Right r+  mult (Consume f) (Consume g) = Consume $ divide (\(l :*: r) -> (l, r)) f g -instance ADT' U1 where-  f0 _ _ = [pure U1]-  f1 _ _ = pure-  f2 _ _ _ = Just . pure-  c0 _ _ = conquer -instance (ADT' f, ADT' g) => ADT' (f :*: g) where-  f0 for f = [(:*:) <$> head (f0 for f) <*> head (f0 for f)]-  f1 for f (l :*: r) = (:*:) <$> f1 for f l <*> f1 for f r-  f2 for f (al :*: ar) (bl :*: br) = liftA2 (:*:) <$> f2 for f al bl <*> f2 for f ar br-  c0 for f = divide (\(l :*: r) -> (l, r)) (c0 for f) (c0 for f)--instance ADT' (K1 i v) where-  f0 _ f = [K1 <$> f]-  f1 _ f (K1 v) = K1 <$> f v-  f2 _ f (K1 l) (K1 r) = Just $ K1 <$> f l r-  c0 _ f = contramap unK1 f--instance ADT' f => ADT' (M1 i t f) where-  type CtorCount' (M1 i t f) = CtorCount' f-  ctorIndex' = ctorIndex' . unM1-  ctorCount _ = ctorCount (Proxy :: Proxy f)-  f0 for f = map (fmap M1) (f0 for f)-  f1 for f = fmap M1 . f1 for f . unM1-  f2 for f (M1 l) (M1 r) = fmap (fmap M1) (f2 for f l r)-  c0 for f = contramap unM1 (c0 for f)---- | `Constraints` is a constraint type synonym, containing the constraint requirements for an instance for `t` of class `c`.--- It requires an instance of class `c` for each component of `t`.-type Constraints t c = Constraints' (Rep t) c---- | `ADT` is a constraint type synonym. The `Generic` instance can be derived,--- and any generic representation will be an instance of `ADT'`.-type ADT t = (Generic t, ADT' (Rep t))---- | `CtorCount` is the number of constructors of a type at the type level.--- F.e. if you want to require that a type has at least two constructors,--- you can add the constraint @(2 `GHC.TypeLits.<=` `CtorCount` t)@.-type CtorCount t = CtorCount' (Rep t)---- | `ADTRecord` is a constraint type synonym. An instance is an `ADT` with *exactly* one constructor.-type ADTRecord t = (ADT t, 1 ~ CtorCount t)---- | `ADTNonEmpty` is a constraint type synonym. An instance is an `ADT` with *at least* one constructor.-type ADTNonEmpty t = (ADT t, 1 <= CtorCount t)---- | Tell the compiler which class we want to use in the traversal. Should be used like this:------ > (For :: For Show)------ Where @Show@ can be any class.-data For (c :: * -> Constraint) = For---- | @Deep c@ recursively requires all parts of the datatype to be an instance of `c` and of `Generic`.-class DeepConstraint c t => Deep (c :: * -> Constraint) t where-instance DeepConstraint c t => Deep c t---- http://stackoverflow.com/questions/14133121/can-i-constrain-a-type-family--- | A trick to avoid GHC from detecting a cycle.-type family DeepConstraint (c :: * -> Constraint) t :: Constraint-type instance DeepConstraint c t = (c t, ADT t, Constraints t (Deep c), Constraints t c)---- | For primitive values like `Int`, `Float`, `Double` and `Char`, the generic representation--- of a value contains itself. If you use generics recursively (f.e. using `Deep`),--- use `isAtom` to detect primitive values and prevent an infinite loop.-isAtom :: forall t proxy. (ADT t, Typeable t, Constraints t Typeable) => proxy t -> Bool-isAtom pt = case createA (For :: For Typeable) f :: [Const [Bool] t] of-  [Const [True]] -> True-  _ -> False-  where-    f :: forall a. Typeable a => Const [Bool] a-    f = Const [tRep == typeRep (undefined :: [a])]-    tRep = typeRep pt- -- | Create a value (one for each constructor), given how to construct the components. -- -- @--- `minBound` = `head` `$` `create` (`For` :: `For` `Bounded`) `minBound`--- `maxBound` = `last` `$` `create` (`For` :: `For` `Bounded`) `maxBound`+-- `minBound` = `head` `$` `create` (`For` :: `For` `Bounded`) [`minBound`]+-- `maxBound` = `last` `$` `create` (`For` :: `For` `Bounded`) [`maxBound`] -- @ create :: (ADT t, Constraints t c)-       => for c -> (forall s. c s => s) -> [t]-create for f = map runIdentity (createA for (Identity f))+       => for c -> (forall s. c s => [s]) -> [t]+create for f = map runIdentity (createA for (Identity <$> f))  -- | Create a value (one for each constructor), given how to construct the components, under an applicative effect. -- -- Here's how to implement `get` from the `binary` package: -- -- @--- get = getWord8 `>>=` \\ix -> `createA` (`For` :: `For` Binary) get `!!` `fromEnum` ix+-- get = getWord8 `>>=` \\ix -> `createA` (`For` :: `For` Binary) [get] `!!` `fromEnum` ix -- @ createA :: (ADT t, Constraints t c, Applicative f)-        => for c -> (forall s. c s => f s) -> [f t]-createA for f = map (fmap to) (f0 for f)+        => for c -> (forall s. c s => [f s]) -> [f t]+createA for f = unCreate $ generic for (Create f)  -- | Generate ways to consume values of type `t`. This is the contravariant version of `createA`. consume :: (ADT t, Constraints t c, Decidable f)         => for c -> (forall s. c s => f s) -> f t-consume for f = contramap from (c0 for f)+consume for f = unConsume $ generic for (Consume f)  --- | Get the index in the lists returned by `create` and `createA` of the constructor of the given value.------ For example, this is the implementation of `put` that generates the binary data that--- the above implentation of `get` expects:------ @--- `put` t = `putWord8` (`toEnum` (`ctorIndex` t)) `<>` `gfoldMap` (`For` :: `For` `Binary`) `put` t--- @------ /Note that this assumes a straightforward `Monoid` instance of `Put` which `binary` unfortunately does not provide./-ctorIndex :: ADT t => t -> Int-ctorIndex = ctorIndex' . from  -- | Map over a structure, updating each component. gmap :: (ADT t, Constraints t c)@@ -231,13 +124,13 @@ -- | Map each component of a structure to an action, evaluate these actions from left to right, and collect the results. gtraverse :: (ADT t, Constraints t c, Applicative f)           => for c -> (forall s. c s => s -> f s) -> t -> f t-gtraverse for f = fmap to . f1 for f . from+gtraverse for f = runStar $ generic for (Star f)  -- | Combine two values by combining each component of the structures with the given function. -- Returns `Nothing` if the constructors don't match. gzipWith :: (ADT t, Constraints t c)-         => for c -> (forall s. c s => s -> s -> s) -> t -> t -> Maybe t-gzipWith for f l r = runIdentity <$> zipWithA for (\x y -> Identity (f x y)) l r+         => for c -> (forall s. c s => s -> s -> Maybe s) -> t -> t -> Maybe t+gzipWith for f l r = runIdentity <$> zipWithA for (\x y -> Identity <$> f x y) l r  -- | Combine two values by combining each component of the structures to a monoid, and combine the results. -- Returns `mempty` if the constructors don't match.@@ -247,13 +140,13 @@ -- @ mzipWith :: (ADT t, Constraints t c, Monoid m)          => for c -> (forall s. c s => s -> s -> m) -> t -> t -> m-mzipWith for f l r = maybe mempty getConst $ zipWithA for (\x y -> Const (f x y)) l r+mzipWith for f l r = maybe mempty getConst $ zipWithA for (\x y -> Just . Const $ f x y) l r  -- | Combine two values by combining each component of the structures with the given function, under an applicative effect. -- Returns `Nothing` if the constructors don't match. zipWithA :: (ADT t, Constraints t c, Applicative f)-         => for c -> (forall s. c s => s -> s -> f s) -> t -> t -> Maybe (f t)-zipWithA for f l r = fmap (fmap to) (f2 for f (from l) (from r))+         => for c -> (forall s. c s => s -> s -> Maybe (f s)) -> t -> t -> Maybe (f t)+zipWithA for f = runZip $ generic for (Zip f)  -- | Implement a nullary operator by calling the operator for each component. --@@ -263,7 +156,7 @@ -- @ op0 :: (ADTRecord t, Constraints t c)     => for c -> (forall s. c s => s) -> t-op0 for f = head $ create for f+op0 for f = head $ create for [f]  -- | Implement a unary operator by calling the operator on the components. -- This is here for consistency, it is the same as `gmap`.@@ -283,6 +176,6 @@ -- @ op2 :: (ADTRecord t, Constraints t c)     => for c -> (forall s. c s => s -> s -> s) -> t -> t -> t-op2 for f l r = case gzipWith for f l r of+op2 for f l r = case gzipWith for (\a b -> Just (f a b)) l r of   Just t -> t   Nothing -> error "op2: constructor mismatch should not be possible for ADTRecord"
− src/Generics/OneLiner/ADT.hs 
@@ -1,288 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Generics.OneLiner.ADT--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  sjoerd@w3future.com--- Stability   :  experimental--- Portability :  non-portable------ This module is for writing generic functions on algebraic data types--- of kind @*@. These data types must be an instance of the `ADT` type class.------ Here's an example how to write such an instance for this data type:------ @--- data T a = A Int a | B a (T a)--- @------ @--- instance `ADT` (T a) where---   `ctorIndex` A{} = 0---   `ctorIndex` B{} = 1---   `ctorInfo` _ 0 = `ctor` \"A\"---   `ctorInfo` _ 1 = `ctor` \"B\"---   type `Constraints` (T a) c = (c Int, c a, c (T a))---   `buildsRecA` _ sub rec =---     [ A `<$>` sub (`FieldInfo` (\\(A i _) -> i)) `<*>` sub (`FieldInfo` (\\(A _ a) -> a))---     , B `<$>` sub (`FieldInfo` (\\(B a _) -> a)) `<*>` rec (`FieldInfo` (\\(B _ t) -> t))---     ]--- @------ And this is how you would write generic equality, using the `All` monoid:------ @--- eqADT :: (`ADT` t, `Constraints` t `Eq`) => t -> t -> `Bool`--- eqADT s t = `ctorIndex` s == `ctorIndex` t `&&`---   `getAll` (`mbuilds` (`For` :: `For` `Eq`) (\\fld -> `All` $ s `!` fld `==` t `!` fld) \``at`\` s)--- @-------------------------------------------------------------------------------{-# LANGUAGE-    RankNTypes-  , TypeFamilies-  , ConstraintKinds-  , FlexibleInstances-  , DefaultSignatures-  , ScopedTypeVariables-  #-}-module Generics.OneLiner.ADT (--    -- * Re-exports-    module Generics.OneLiner.Info-  , Constraint-    -- | The kind of constraints--    -- * The @ADT@ type class-  , ADT(..)-  , ADTRecord(..)-  , For(..)--    -- * Helper functions-  , (!)-  , at--    -- * Derived traversal schemes-  , builds-  , mbuilds-  , gmap-  , gfoldMap-  , gtraverse--    -- ** ...for single constructor data types-  , build-  , op0-  , op1-  , op2--  ) where--import Generics.OneLiner.Info--import GHC.Prim (Constraint)-import Control.Applicative-import Data.Functor.Identity-import Data.Functor.Constant-import Data.Monoid--import Data.Maybe (fromJust)----- | Tell the compiler which class we want to use in the traversal. Should be used like this:------ > (For :: For Show)------ Where @Show@ can be any class.-data For (c :: * -> Constraint) = For---- | Type class for algebraic data types of kind @*@. Implement either `buildsA`--- if the type @t@ is not recursive, or `buildsRecA` if the type @t@ is recursive.-class ADT t where--  -- | Gives the index of the constructor of the given value in the list returned by `buildsA` and `buildsRecA`.-  ctorIndex :: t -> Int-  ctorIndex _ = 0--  -- | @ctorInfo n@ gives constructor information, f.e. its name, for the @n@th constructor.-  --   The first argument is a dummy argument and can be @(undefined :: t)@.-  ctorInfo :: t -> Int -> CtorInfo--  -- | The constraints needed to run `buildsA` and `buildsRecA`.-  -- It should be a list of all the types of the subcomponents of @t@, each applied to @c@.-  type Constraints t (c :: * -> Constraint) :: Constraint--  buildsA :: (Constraints t c, Applicative f)-          => for c -- ^ Witness for the constraint @c@.-          -> (forall s. c s => FieldInfo (t -> s) -> f s) -- ^ This function should return a value-             -- for each subcomponent of @t@, wrapped in an applicative functor @f@. It is given-             -- information about the field, which contains a projector function to get the subcomponent-             -- from a value of type @t@. The type of the subcomponent is an instance of class @c@.-          -> [f t] -- ^ A list of results, one for each constructor of type @t@. Each element is the-             -- result of applicatively applying the constructor to the results of the given function-             -- for each field of the constructor.--  default buildsA :: (c t, Constraints t c, Applicative f)-                  => for c -> (forall s. c s => FieldInfo (t -> s) -> f s) -> [f t]-  buildsA for f = buildsRecA for f f--  buildsRecA :: (Constraints t c, Applicative f)-             => for c -- ^ Witness for the constraint @c@.-             -> (forall s. c s => FieldInfo (t -> s) -> f s) -- ^ This function should return a value-                -- for each subcomponent of @t@, wrapped in an applicative functor @f@. It is given-                -- information about the field, which contains a projector function to get the subcomponent-                -- from a value of type @t@. The type of the subcomponent is an instance of class @c@.-             -> (FieldInfo (t -> t) -> f t) -- ^ This function should return a value-                -- for each subcomponent of @t@ that is itself of type @t@.-             -> [f t] -- ^ A list of results, one for each constructor of type @t@. Each element is the-             -- result of applicatively applying the constructor to the results of the given function-             -- for each field of the constructor.-  buildsRecA for sub _ = buildsA for sub--  {-# MINIMAL ctorInfo, (buildsA | buildsRecA) #-}---- | Add an instance for this class if the data type has exactly one constructor.------   This class has no methods.-class ADT t => ADTRecord t where---- | `buildsA` specialized to the `Identity` applicative functor.-builds :: (ADT t, Constraints t c)-       => for c -> (forall s. c s => FieldInfo (t -> s) -> s) -> [t]-builds for f = runIdentity <$> buildsA for (Identity . f)---- | `buildsA` specialized to the `Constant` applicative functor, which collects monoid values @m@.-mbuilds :: forall t c m for. (ADT t, Constraints t c, Monoid m)-        => for c -> (forall s. c s => FieldInfo (t -> s) -> m) -> [m]-mbuilds for f = getConstant <$> (buildsA for (Constant . f) :: [Constant m t])---- | Transform a value by transforming each subcomponent.-gmap :: (ADT t, Constraints t c)-     => for c -> (forall s. c s => s -> s) -> t -> t-gmap for f t = builds for (\fld -> f (t ! fld)) `at` t---- | Fold a value, by mapping each subcomponent to a monoid value and collecting those.-gfoldMap :: (ADT t, Constraints t c, Monoid m)-         => for c -> (forall s. c s => s -> m) -> t -> m-gfoldMap for f = getConstant . gtraverse for (Constant . f)---- | Applicative traversal given a way to traverse each subcomponent.-gtraverse :: (ADT t, Constraints t c, Applicative f)-          => for c -> (forall s. c s => s -> f s) -> t -> f t-gtraverse for f t = buildsA for (\fld -> f (t ! fld)) `at` t---- | `builds` for data types with exactly one constructor-build :: (ADTRecord t, Constraints t c)-      => for c -> (forall s. c s => FieldInfo (t -> s) -> s) -> t-build for f = head $ builds for f---- | Derive a 0-ary operation by applying the operation to every subcomponent.-op0 :: (ADTRecord t, Constraints t c) => for c -> (forall s. c s => s) -> t-op0 for op = build for (const op)---- | Derive a unary operation by applying the operation to every subcomponent.-op1 :: (ADTRecord t, Constraints t c) => for c -> (forall s. c s => s -> s) -> t -> t-op1 for op t = build for (\fld -> op $ t ! fld)---- | Derive a binary operation by applying the operation to every subcomponent.-op2 :: (ADTRecord t, Constraints t c) => for c -> (forall s. c s => s -> s -> s) -> t -> t -> t-op2 for op s t = build for (\fld -> (s ! fld) `op` (t ! fld))-----infixl 9 !--- | Get the subcomponent by using the projector from the field information.-(!) :: t -> FieldInfo (t -> s) -> s-t ! fld = project fld t---- | Get the value from the result of one of the @builds@ functions that matches the constructor of @t@.-at :: ADT t => [a] -> t -> a-at as t = as !! ctorIndex t----instance ADT () where--  type Constraints () c = ()-  ctorInfo _ 0 = ctor "()"-  buildsA _ _ = [ pure () ]--instance ADTRecord () where--instance ADT (a, b) where--  type Constraints (a, b) c = (c a, c b)-  ctorInfo _ 0 = ctor "(,)"-  buildsA _ f = [ (,) <$> f (FieldInfo fst) <*> f (FieldInfo snd) ]--instance ADTRecord (a, b) where--instance ADT (a, b, c) where--  type Constraints (a, b, c) tc = (tc a, tc b, tc c)-  ctorInfo _ 0 = ctor "(,,)"-  buildsA _ f = [(,,) <$> f (FieldInfo (\(a, _, _) -> a))-                      <*> f (FieldInfo (\(_, b, _) -> b))-                      <*> f (FieldInfo (\(_, _, c) -> c))-                ]--instance ADTRecord (a, b, c) where--instance ADT (a, b, c, d) where--  type Constraints (a, b, c, d) tc = (tc a, tc b, tc c, tc d)-  ctorInfo _ 0 = ctor "(,,,)"-  buildsA _ f = [(,,,) <$> f (FieldInfo (\(a, _, _, _) -> a))-                       <*> f (FieldInfo (\(_, b, _, _) -> b))-                       <*> f (FieldInfo (\(_, _, c, _) -> c))-                       <*> f (FieldInfo (\(_, _, _, d) -> d))-                ]--instance ADTRecord (a, b, c, d) where--instance ADT Bool where--  ctorIndex False = 0-  ctorIndex True  = 1-  ctorInfo _ 0 = ctor "False"-  ctorInfo _ 1 = ctor "True"--  type Constraints Bool c = ()-  buildsA for _ = [ pure False, pure True ]--instance ADT (Either a b) where--  ctorIndex Left{}  = 0-  ctorIndex Right{} = 1-  ctorInfo _ 0 = ctor "Left"-  ctorInfo _ 1 = ctor "Right"--  type Constraints (Either a b) c = (c a, c b)-  buildsA for f =-    [ Left  <$> f (FieldInfo (\(Left a)  -> a))-    , Right <$> f (FieldInfo (\(Right a) -> a))-    ]--instance ADT (Maybe a) where--  ctorIndex Nothing = 0-  ctorIndex Just{}  = 1-  ctorInfo _ 0 = ctor "Nothing"-  ctorInfo _ 1 = ctor "Just"--  type Constraints (Maybe a) c = c a-  buildsA for f =-    [ pure Nothing-    , Just <$> f (FieldInfo fromJust)-    ]--instance ADT [a] where--  ctorIndex []    = 0-  ctorIndex (_:_) = 1-  ctorInfo _ 0 = ctor "[]"-  ctorInfo _ 1 = CtorInfo ":" False (Infix RightAssociative 5)--  type Constraints [a] c = (c a, c [a])-  buildsRecA for sub rec =-    [ pure []-    , (:) <$> sub (FieldInfo head) <*> rec (FieldInfo tail)]
− src/Generics/OneLiner/ADT1.hs 
@@ -1,202 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Generics.OneLiner.ADT1--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  sjoerd@w3future.com--- Stability   :  experimental--- Portability :  non-portable------ This module is for writing generic functions on algebraic data types--- of kind @* -> *@.--- These data types must be an instance of the `ADT1` type class.------ Here's an example how to write such an instance for this data type:------ @--- data T a = A [a] | B a (T a)--- @------ @--- instance `ADT1` T where---   `ctorIndex` A{} = 0---   `ctorIndex` B{} = 1---   `ctorInfo` _ 0 = `ctor` \"A\"---   `ctorInfo` _ 1 = `ctor` \"B\"---   type `Constraints` T c = (c [], c T)---   `buildsRecA` _ par sub rec =---     [ A `<$>` sub (`component` (\\(A l) -> l)---     , B `<$>` par (`param` (\\(B a _) -> a)) `<*>` rec (`component` (\\(B _ t) -> t))---     ]--- @-------------------------------------------------------------------------------{-# LANGUAGE-    RankNTypes-  , TypeFamilies-  , TypeOperators-  , ConstraintKinds-  , FlexibleInstances-  , DefaultSignatures-  , ScopedTypeVariables-  #-}-module Generics.OneLiner.ADT1 (--    -- * Re-exports-    module Generics.OneLiner.Info-  , Constraint-    -- | The kind of constraints--    -- * The @ADT1@ type class-  , ADT1(..)-  , ADT1Record(..)-  , For(..)-  , Extract(..)-  , (:~>)(..)--    -- * Helper functions-  , (!)-  , (!~)-  , at-  , param-  , component--  -- * Derived traversal schemes-  , builds-  , mbuilds-  , build--  ) where--import Generics.OneLiner.Info--import GHC.Prim (Constraint)-import Control.Applicative-import Data.Functor.Identity-import Data.Functor.Constant-import Data.Monoid--import Data.Maybe (fromJust)---newtype f :~> g = Nat { getNat :: forall x. f x -> g x }-newtype Extract f = Extract { getExtract :: forall x. f x -> x }----- | Tell the compiler which class we want to use in the traversal. Should be used like this:------ > (For :: For Show)------ Where @Show@ can be any class.-data For (c :: (* -> *) -> Constraint) = For---- | Type class for algebraic data types of kind @* -> *@. Implement either `buildsA`--- if the type @t@ is not recursive, or `buildsRecA` if the type @t@ is recursive.-class ADT1 t where--  -- | Gives the index of the constructor of the given value in the list returned by `buildsA` and `buildsRecA`.-  ctorIndex :: t a -> Int-  ctorIndex _ = 0--  -- | @ctorInfo n@ gives constructor information, f.e. its name, for the @n@th constructor.-  --   The first argument is a dummy argument and can be @(undefined :: t a)@.-  ctorInfo :: t a -> Int -> CtorInfo--  -- | The constraints needed to run `buildsA` and `buildsRecA`.-  -- It should be a list of all the types of the subcomponents of @t@, each applied to @c@.-  type Constraints t (c :: (* -> *) -> Constraint) :: Constraint-  buildsA :: (Constraints t c, Applicative f)-          => for c -- ^ Witness for the constraint @c@.-          -> (FieldInfo (Extract t) -> f b)-          -> (forall s. c s => FieldInfo (t :~> s) -> f (s b))-          -> [f (t b)]--  default buildsA :: (c t, Constraints t c, Applicative f)-                  => for c-                  -> (FieldInfo (Extract t) -> f b)-                  -> (forall s. c s => FieldInfo (t :~> s) -> f (s b))-                  -> [f (t b)]-  buildsA for param sub = buildsRecA for param sub sub--  buildsRecA :: (Constraints t c, Applicative f)-             => for c -- ^ Witness for the constraint @c@.-             -> (FieldInfo (Extract t) -> f b)-             -> (forall s. c s => FieldInfo (t :~> s) -> f (s b))-             -> (FieldInfo (t :~> t) -> f (t b))-             -> [f (t b)]-  buildsRecA for param sub _ = buildsA for param sub--  {-# MINIMAL ctorInfo, (buildsA | buildsRecA) #-}---- | Add an instance for this class if the data type has exactly one constructor.------   This class has no methods.-class ADT1 t => ADT1Record t where---- | `buildsA` specialized to the `Identity` applicative functor.-builds :: (ADT1 t, Constraints t c)-       => for c-       -> (FieldInfo (Extract t) -> b)-       -> (forall s. c s => FieldInfo (t :~> s) -> s b)-       -> [t b]-builds for f g = runIdentity <$> buildsA for (Identity . f) (Identity . g)---- | `buildsA` specialized to the `Constant` applicative functor, which collects monoid values @m@.-mbuilds :: forall t c m for. (ADT1 t, Constraints t c, Monoid m)-        => for c-        -> (FieldInfo (Extract t) -> m)-        -> (forall s. c s => FieldInfo (t :~> s) -> m)-        -> [m]-mbuilds for f g = getConstant <$> (buildsA for (Constant . f) (Constant . g) :: [Constant m (t b)])---- | `builds` for data types with exactly one constructor-build :: (ADT1Record t, Constraints t c)-       => for c-       -> (FieldInfo (Extract t) -> b)-       -> (forall s. c s => FieldInfo (t :~> s) -> s b)-       -> t b-build for f g = head $ builds for f g---- | Get the value from the result of one of the @builds@ functions that matches the constructor of @t@.-at :: ADT1 t => [a] -> t b -> a-at as t = as !! ctorIndex t--param :: (forall a. t a -> a) -> FieldInfo (Extract t)-param f = FieldInfo (Extract f)--component :: (forall a. t a -> s a) -> FieldInfo (t :~> s)-component f = FieldInfo (Nat f)--infixl 9 !-(!) :: t a -> FieldInfo (Extract t) -> a-t ! info = getExtract (project info) t--infixl 9 !~-(!~) :: t a -> FieldInfo (t :~> s) -> s a-t !~ info = getNat (project info) t---instance ADT1 Maybe where--  ctorIndex Nothing = 0-  ctorIndex Just{}  = 1-  ctorInfo _ 0 = ctor "Nothing"-  ctorInfo _ 1 = ctor "Just"--  type Constraints Maybe c = ()-  buildsA _ f _ =-    [ pure Nothing-    , Just <$> f (param fromJust)-    ]--instance ADT1 [] where--  ctorIndex []    = 0-  ctorIndex (_:_) = 1-  ctorInfo _ 0 = ctor "[]"-  ctorInfo _ 1 = CtorInfo ":" False (Infix RightAssociative 5)--  type Constraints [] c = c []-  buildsRecA _ p _ r =-    [ pure []-    , (:) <$> p (param head) <*> r (component tail)-    ]
− src/Generics/OneLiner/Functions.hs 
@@ -1,114 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Generics.OneLiner.Functions--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  sjoerd@w3future.com--- Stability   :  experimental--- Portability :  non-portable-------------------------------------------------------------------------------{-# LANGUAGE RankNTypes, ConstraintKinds, ScopedTypeVariables #-}-module Generics.OneLiner.Functions (-  -- * For all instances-    eqADT-  , compareADT-  , minBoundADT-  , maxBoundADT-  , showsPrecADT-  , readPrecADT-  -- * For datatypes with one constructor-  , memptyADT-  , mappendADT-  , fromIntegerADT-  ) where--import Generics.OneLiner.ADT-import Control.Applicative-import Data.Monoid--import Text.Read-import Control.Monad-import Control.Monad.Trans.State-import qualified Control.Monad.Trans.Class as T--eqADT :: (ADT t, Constraints t Eq) => t -> t -> Bool-eqADT s t = ctorIndex s == ctorIndex t &&-  getAll (mbuilds (For :: For Eq) (\fld -> All $ s ! fld == t ! fld) `at` s)--compareADT :: (ADT t, Constraints t Ord) => t -> t -> Ordering-compareADT s t = compare (ctorIndex s) (ctorIndex t) <>-  mbuilds (For :: For Ord) (\fld -> compare (s ! fld) (t ! fld)) `at` s--minBoundADT :: (ADT t, Constraints t Bounded) => t-minBoundADT = head $ builds (For :: For Bounded) (const minBound)--maxBoundADT :: (ADT t, Constraints t Bounded) => t-maxBoundADT = last $ builds (For :: For Bounded) (const maxBound)--showsPrecADT :: forall t. (ADT t, Constraints t Show) => Int -> t -> ShowS-showsPrecADT d t = inner fty-  where-    CtorInfo name rec fty = ctorInfo t (ctorIndex t)--    inner (Infix _ d') = showParen (d > d') $ let [f0, f1] = fields (d' + 1) in-      f0 . showChar ' ' . showString name . showChar ' ' . f1-    inner _ = showParen (d > 10) $ showString name . showChar ' ' . body--    body = if rec-      then showChar '{' . conc (showString ", ") (fields 0) . showChar '}'-      else conc (showString " ") (fields 11)--    fields d' = mbuilds (For :: For Show) (return . f d') `at` t--    f :: Show s => Int -> FieldInfo (t -> s) -> ShowS-    f d' info = if rec-      then showString (selectorName info) . showString " = " . showsPrec d' (t ! info)-      else showsPrec d' (t ! info)--    conc sep = foldr1 (\g ss -> g . sep . ss)--readPrecADT :: forall t. (ADT t, Constraints t Read) => ReadPrec t-readPrecADT = parens (choice ctorReads)-  where-    ctorReads = ctorParse <$> zip (fmap (ctorInfo (undefined :: t)) [0..]) (buildsA (For :: For Read) fieldParse)--    ctorParse (CtorInfo name _ (Infix _ d), getFields) =-      let flds = evalStateT getFields $ do { Symbol name' <- lexP; guard (name' == name) }-      in prec d flds--    ctorParse (CtorInfo name rec _, getFields) =-      let flds = evalStateT getFields (return ())-      in prec (if rec then 11 else 10) $ do-        Ident name' <- lexP-        guard (name == name')-        if rec then do-            Punc "{" <- lexP-            res <- flds-            Punc "}" <- lexP-            return res-          else-            flds--    -- StateT is used to parse an infix operator after the first field-    fieldParse :: Read s => FieldInfo (t -> s) -> StateT (ReadPrec ()) ReadPrec s-    fieldParse (SelectorInfo name _) = StateT $ \parseOp -> do-      Ident name' <- lexP-      guard (name == name')-      Punc "=" <- lexP-      res <- reset readPrec-      parseOp-      return (res, return ())-    fieldParse _ = StateT $ \parseOp -> do-      res <- step readPrec-      parseOp-      return (res, return ())---memptyADT :: (ADTRecord t, Constraints t Monoid) => t-memptyADT = op0 (For :: For Monoid) mempty--mappendADT :: (ADTRecord t, Constraints t Monoid) => t -> t -> t-mappendADT = op2 (For :: For Monoid) mappend--fromIntegerADT :: (ADTRecord t, Constraints t Num) => Integer -> t-fromIntegerADT i = op0 (For :: For Num) (fromInteger i)
− src/Generics/OneLiner/Functions1.hs 
@@ -1,52 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Generics.OneLiner.Functions1--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  sjoerd@w3future.com--- Stability   :  experimental--- Portability :  non-portable-------------------------------------------------------------------------------{-# LANGUAGE RankNTypes, ConstraintKinds, ScopedTypeVariables #-}-module Generics.OneLiner.Functions1 (-  -- * For all instances-    fmapADT-  , foldMapADT-  , traverseADT-  -- * For datatypes with one constructor-  , pureADT-  , apADT-  , bindADT-  , mfixADT-) where--import Generics.OneLiner.ADT1-import Control.Applicative-import Control.Monad.Fix-import Data.Monoid-import Data.Foldable-import Data.Traversable--fmapADT :: (ADT1 t, Constraints t Functor) => (a -> b) -> t a -> t b-fmapADT f ta = builds (For :: For Functor) (\fld -> f (ta ! fld)) (\fld -> fmap f (ta !~ fld)) `at` ta--foldMapADT :: (ADT1 t, Constraints t Foldable, Monoid m) => (a -> m) -> t a -> m-foldMapADT f ta = mbuilds (For :: For Foldable) (\fld -> f (ta ! fld)) (\fld -> foldMap f (ta !~ fld)) `at` ta--traverseADT :: (ADT1 t, Constraints t Traversable, Applicative f) => (a -> f b) -> t a -> f (t b)-traverseADT f ta = buildsA (For :: For Traversable) (\fld -> f (ta ! fld)) (\fld -> traverse f (ta !~ fld)) `at` ta---- unfoldADT :: (ADT1 t, Constraints t Unfoldable, Unfolder f) => f a -> f (t a)--- unfoldADT fa = choose $ buildsA (For :: For Unfoldable) (const fa) (const $ unfold fa)--pureADT :: (ADT1Record t, Constraints t Applicative) => a -> t a-pureADT a = build (For :: For Applicative) (const a) (const $ pure a)--apADT :: (ADT1Record t, Constraints t Applicative) => t (a -> b) -> t a -> t b-apADT tf ta = build (For :: For Applicative) (\fld -> (tf ! fld) (ta ! fld)) (\fld -> (tf !~ fld) <*> (ta !~ fld))--bindADT :: (ADT1Record t, Constraints t Monad) => t a -> (a -> t b) -> t b-bindADT ta f = build (For :: For Monad) (\fld -> f (ta ! fld) ! fld) (\fld -> (ta !~ fld) >>= ((!~ fld) . f))--mfixADT :: (ADT1Record t, Constraints t MonadFix) => (a -> t a) -> t a-mfixADT f = build (For :: For MonadFix) (\fld -> fix ((! fld) . f)) (\fld -> mfix ((!~ fld) . f))
− src/Generics/OneLiner/Info.hs 
@@ -1,39 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Generics.OneLiner.Info--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  sjoerd@w3future.com--- Stability   :  experimental--- Portability :  non-portable-------------------------------------------------------------------------------module Generics.OneLiner.Info where--data CtorInfo = CtorInfo-  { ctorName  :: String-  , isRecord  :: Bool-  , fixity    :: Fixity-  }-  deriving (Eq, Show, Ord, Read)--ctor :: String -> CtorInfo-ctor name = CtorInfo name False Prefix--data Fixity = Prefix | Infix Associativity Int-  deriving (Eq, Show, Ord, Read)--data Associativity = LeftAssociative | RightAssociative | NotAssociative-  deriving (Eq, Show, Ord, Read)--data FieldInfo p-  = SelectorInfo-    { selectorName :: String-    , project      :: p-    }-  | FieldInfo-    { project      :: p-    }--instance Functor FieldInfo where-  fmap f (SelectorInfo s p) = SelectorInfo s (f p)-  fmap f (FieldInfo p) = FieldInfo (f p)
+ src/Generics/OneLiner/Internal.hs view
@@ -0,0 +1,133 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Generics.OneLiner.Internal+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+{-# LANGUAGE+    GADTs+  , DataKinds+  , RankNTypes+  , LambdaCase+  , TypeFamilies+  , TypeOperators+  , ConstraintKinds+  , FlexibleContexts+  , ScopedTypeVariables+  , UndecidableInstances+  #-}+module Generics.OneLiner.Internal where++import GHC.Generics+import GHC.Types (Constraint)+import GHC.TypeLits+import Data.Proxy+import Data.Profunctor++type family Constraints' (t :: * -> *) (c :: * -> Constraint) :: Constraint+type instance Constraints' V1 c = ()+type instance Constraints' U1 c = ()+type instance Constraints' (f :+: g) c = (Constraints' f c, Constraints' g c)+type instance Constraints' (f :*: g) c = (Constraints' f c, Constraints' g c)+type instance Constraints' (M1 i t f) c = Constraints' f c+type instance Constraints' (K1 i a) c = c a++class ADT' (t :: * -> *) where+  type CtorCount' t :: Nat+  type CtorCount' t = 1+  ctorIndex' :: t x -> Int+  ctorIndex' _ = 0+  ctorCount :: proxy t -> Int+  ctorCount _ = 1++  p :: (Constraints' t c, GenericProfunctor p)+    => for c -> (forall s. c s => p s s) -> p (t x) (t x)++instance ADT' V1 where+  type CtorCount' V1 = 0+  ctorCount _ = 0+  p _ _ = zero++instance (ADT' f, ADT' g) => ADT' (f :+: g) where+  type CtorCount' (f :+: g) = CtorCount' f + CtorCount' g+  ctorIndex' (L1 l) = ctorIndex' l+  ctorIndex' (R1 r) = ctorCount (Proxy :: Proxy f) + ctorIndex' r+  ctorCount _ = ctorCount (Proxy :: Proxy f) + ctorCount (Proxy :: Proxy g)+  p for f = plus (p for f) (p for f)++instance ADT' U1 where+  p _ _ = unit++instance (ADT' f, ADT' g) => ADT' (f :*: g) where+  p for f = mult (p for f) (p for f)++instance ADT' (K1 i v) where+  p _ = dimap unK1 K1++instance ADT' f => ADT' (M1 i t f) where+  type CtorCount' (M1 i t f) = CtorCount' f+  ctorIndex' = ctorIndex' . unM1+  ctorCount _ = ctorCount (Proxy :: Proxy f)+  p for f = dimap unM1 M1 (p for f)+++class Profunctor p => GenericProfunctor p where+  zero :: p (V1 a) (V1 a)+  unit :: p (U1 a) (U1 a)+  plus :: p (f a) (f' a) -> p (g a) (g' a) -> p ((f :+: g) a) ((f' :+: g') a)+  mult :: p (f a) (f' a) -> p (g a) (g' a) -> p ((f :*: g) a) ((f' :*: g') a)++instance Applicative f => GenericProfunctor (Star f) where+  zero = Star pure+  unit = Star pure+  plus (Star f) (Star g) = Star $ \case+    L1 l -> L1 <$> f l+    R1 r -> R1 <$> g r+  mult (Star f) (Star g) = Star $ \(l :*: r) -> (:*:) <$> f l <*> g r++-- | All the above functions have been implemented using this single function,+-- using different `profunctor`s.+generic :: (ADT t, Constraints t c, GenericProfunctor p)+        => for c -> (forall s. c s => p s s) -> p t t+generic for f = dimap from to $ p for f++-- | `Constraints` is a constraint type synonym, containing the constraint requirements for an instance for `t` of class `c`.+-- It requires an instance of class `c` for each component of `t`.+type Constraints t c = Constraints' (Rep t) c++-- | `ADT` is a constraint type synonym. The `Generic` instance can be derived,+-- and any generic representation will be an instance of `ADT'`.+type ADT t = (Generic t, ADT' (Rep t))++-- | `CtorCount` is the number of constructors of a type at the type level.+-- F.e. if you want to require that a type has at least two constructors,+-- you can add the constraint @(2 `GHC.TypeLits.<=` `CtorCount` t)@.+type CtorCount t = CtorCount' (Rep t)++-- | `ADTRecord` is a constraint type synonym. An instance is an `ADT` with *exactly* one constructor.+type ADTRecord t = (ADT t, 1 ~ CtorCount t)++-- | `ADTNonEmpty` is a constraint type synonym. An instance is an `ADT` with *at least* one constructor.+type ADTNonEmpty t = (ADT t, 1 <= CtorCount t)++-- | Tell the compiler which class we want to use in the traversal. Should be used like this:+--+-- > (For :: For Show)+--+-- Where @Show@ can be any class.+data For (c :: * -> Constraint) = For++-- | Get the index in the lists returned by `create` and `createA` of the constructor of the given value.+--+-- For example, this is the implementation of `put` that generates the binary data that+-- the above implentation of `get` expects:+--+-- @+-- `put` t = `putWord8` (`toEnum` (`ctorIndex` t)) `<>` `gfoldMap` (`For` :: `For` `Binary`) `put` t+-- @+ctorIndex :: ADT t => t -> Int+ctorIndex = ctorIndex' . from