packages feed

one-liner 1.0 → 2.0

raw patch · 8 files changed

+352/−136 lines, 8 filesdep +linear-basedep ~base

Dependencies added: linear-base

Dependency ranges changed: base

Files

CHANGELOG view
@@ -1,8 +1,14 @@ CHANGELOG +1.0 -> 2.0+  - Require GHC 9+  - Change Generics.OneLiner.Internal to use linear profunctors+  - Add linear traversals+  - Add `GenericConstantProfunctor` which is only needed by `generic1`.+ 0.9 -> 1.0-  - Added type changing traversals with Generics.OneLiner.Binary-  - Changed Generics.OneLiner.Internal to work on binary type classes.-  - Added Generics.OneLiner.Internal.Unary to convert the internals to unary-  - Moved classes to Generics.OneLiner.Classes-  - Started a change log+  - Add type changing traversals with Generics.OneLiner.Binary+  - Change Generics.OneLiner.Internal to work on binary type classes.+  - Add Generics.OneLiner.Internal.Unary to convert the internals to unary+  - Move classes to Generics.OneLiner.Classes+  - Start a change log
one-liner.cabal view
@@ -1,54 +1,57 @@-Name:                 one-liner-Version:              1.0-Synopsis:             Constraint-based generics-Description:          Write short and concise generic instances of type classes.+cabal-version:        2.0+name:                 one-liner+version:              2.0+synopsis:             Constraint-based generics+description:          Write short and concise generic instances of type classes.                       one-liner is particularly useful for writing default                       implementations of type class methods.-Homepage:             https://github.com/sjoerdvisscher/one-liner-Bug-reports:          https://github.com/sjoerdvisscher/one-liner/issues-License:              BSD3-License-file:         LICENSE-Author:               Sjoerd Visscher, Xia Li-yao-Maintainer:           sjoerd@w3future.com-Category:             Generics-Build-type:           Simple-Cabal-version:        >= 1.8+homepage:             https://github.com/sjoerdvisscher/one-liner+bug-reports:          https://github.com/sjoerdvisscher/one-liner/issues+license:              BSD3+license-file:         LICENSE+author:               Sjoerd Visscher, Xia Li-yao+maintainer:           sjoerd@w3future.com+category:             Generics+build-type:           Simple -Extra-Source-Files:+extra-source-files:   examples/*.hs   CHANGELOG -Library-  HS-Source-Dirs:  src+library+  hs-source-dirs:     src+  default-language:   Haskell2010 -  Exposed-modules:+  exposed-modules:     Generics.OneLiner     Generics.OneLiner.Binary     Generics.OneLiner.Classes     Generics.OneLiner.Internal     Generics.OneLiner.Internal.Unary -  Build-depends:+  build-depends:       base          >= 4.9 && < 5     , transformers  >= 0.5 && < 0.6-    , contravariant >= 1.4 && < 1.5+    , contravariant >= 1.4 && < 1.6     , ghc-prim      >= 0.5 && < 1.0     , bifunctors    >= 5.4 && < 6.0     , profunctors   >= 5.2 && < 6.0     , tagged        >= 0.8 && < 0.9+    , linear-base   >= 0.1 && < 1.0  source-repository head   type:     git   location: git://github.com/sjoerdvisscher/one-liner.git -Test-suite unittests-  Hs-source-dirs:  test-  Main-is:         unittests.hs+test-suite unittests+  hs-source-dirs:  test+  main-is:         unittests.hs+  default-language:   Haskell2010 -  Build-depends:+  build-depends:       base     , contravariant     , HUnit     , one-liner -  Type: exitcode-stdio-1.0+  type: exitcode-stdio-1.0
src/Generics/OneLiner.hs view
@@ -8,7 +8,7 @@ -- Portability :  non-portable -- -- All functions without postfix are for instances of `Generic`, and functions--- with postfix @1@ are for instances of `Generic1` (with kind @* -> *@) which+-- with postfix @1@ are for instances of `Generic1` (with kind @Type -> Type@) which -- get an extra argument to specify how to deal with the parameter. -- Functions with postfix @01@ are also for `Generic1` but they get yet another -- argument that, like the `Generic` functions, allows handling of constant leaves.@@ -18,6 +18,7 @@ {-# LANGUAGE     RankNTypes   , Trustworthy+  , LinearTypes   , TypeFamilies   , ConstraintKinds   , FlexibleContexts@@ -32,7 +33,9 @@   createA_,   -- * Traversing values   gmap, gfoldMap, gtraverse,+  glmap, glfoldMap, gltraverse,   gmap1, gfoldMap1, gtraverse1,+  glmap1, gltraverse1, gltraverse01,   -- * Combining values   mzipWith, mzipWith', zipWithA,   mzipWith1, mzipWith1', zipWithA1,@@ -52,10 +55,12 @@   GenericRecordProfunctor,   GenericNonEmptyProfunctor,   GenericProfunctor,+  Generic1Profunctor,   GenericUnitProfunctor(..),   GenericProductProfunctor(..),   GenericSumProfunctor(..),   GenericEmptyProfunctor(..),+  GenericConstantProfunctor(..),   -- * Types   ADT, ADTNonEmpty, ADTRecord, Constraints,   ADT1, ADTNonEmpty1, ADTRecord1, Constraints1, Constraints01,@@ -69,7 +74,12 @@ import Data.Bifunctor.Joker import Data.Functor.Compose import Data.Functor.Contravariant.Divisible+import qualified Control.Functor.Linear as CL+import qualified Data.Functor.Linear as DL+import qualified Data.Monoid.Linear as Linear+import qualified Data.Unrestricted.Linear as Linear import Data.Profunctor+import Data.Profunctor.Kleisli.Linear import Data.Tagged import Generics.OneLiner.Classes import Generics.OneLiner.Internal (FunConstraints, FunResult, autoApply, Pair(..), (.:))@@ -152,6 +162,14 @@ gmap = generic @c {-# INLINE gmap #-} +-- | Map over a structure linearly, updating each component.+--+-- `glmap` is `generic` specialized to the linear arrow.+glmap :: forall c t. (ADT t, Constraints t c)+     => (forall s. c s => s %1-> s) -> t %1-> t+glmap = generic @c+{-# INLINE glmap #-}+ -- | Map each component of a structure to a monoid, and combine the results. -- -- If you have a class `Size`, which measures the size of a structure, then this could be the default implementation:@@ -166,6 +184,20 @@ gfoldMap f = getConst . gtraverse @c (Const . f) {-# INLINE gfoldMap #-} +-- | Map each component of a structure to a monoid, and combine the results.+--+-- If you have a class `Size`, which measures the size of a structure, then this could be the default implementation:+--+-- @+-- consume = `glfoldMap` \@`Linear.Consumable` `Linear.consume`+-- @+--+-- `glfoldMap` is `gltraverse` specialized to `Const`.+glfoldMap :: forall c t m. (ADT t, Constraints t c, Linear.Monoid m)+          => (forall s. c s => s %1-> m) -> t %1-> m+glfoldMap f t = (\(Const c) -> c) (gltraverse @c (\x -> Const (f x)) t)+{-# INLINE glfoldMap #-}+ -- | Map each component of a structure to an action, evaluate these actions from left to right, and collect the results. -- -- `gtraverse` is `generic` specialized to `Star`.@@ -174,6 +206,19 @@ gtraverse f = runStar $ generic @c $ Star f {-# INLINE gtraverse #-} +-- | Map each component of a structure to an action linearly, evaluate these actions from left to right, and collect the results.+--+-- @+-- dupV = `gltraverse` \@`Linear.Dupable` `Linear.dupV`+-- move = `gltraverse` \@`Linear.Movable` `Linear.move`+-- @+--+-- `gltraverse` is `generic` specialized to linear `Kleisli`.+gltraverse :: forall c t f. (ADT t, Constraints t c, DL.Applicative f)+           => (forall s. c s => s %1-> f s) -> t %1-> f t+gltraverse f = runKleisli $ generic @c $ Kleisli f+{-# INLINE gltraverse #-}+ -- | -- @ -- fmap = `gmap1` \@`Functor` `fmap`@@ -181,12 +226,23 @@ -- -- `gmap1` is `generic1` specialized to @(->)@. gmap1 :: forall c t a b. (ADT1 t, Constraints1 t c)-     => (forall d e s. c s => (d -> e) -> s d -> s e) -> (a -> b) -> t a -> t b+      => (forall d e s. c s => (d -> e) -> s d -> s e) -> (a -> b) -> t a -> t b gmap1 = generic1 @c {-# INLINE gmap1 #-}  -- | -- @+-- fmap = `gmap1` \@`Linear.Functor` `Linear.fmap`+-- @+--+-- `glmap1` is `generic1` specialized to the linear arrow.+glmap1 :: forall c t a b. (ADT1 t, Constraints1 t c)+       => (forall d e s. c s => (d %1-> e) -> s d %1-> s e) -> (a %1-> b) -> t a %1-> t b+glmap1 = generic1 @c+{-# INLINE glmap1 #-}++-- |+-- @ -- foldMap = `gfoldMap1` \@`Foldable` `foldMap` -- @ --@@ -206,6 +262,26 @@            => (forall d e s. c s => (d -> f e) -> s d -> f (s e)) -> (a -> f b) -> t a -> f (t b) gtraverse1 f = dimap Star runStar $ generic1 @c $ dimap runStar Star f {-# INLINE gtraverse1 #-}++-- |+-- @+-- traverse = `gltraverse1` \@`DL.Traversable` `DL.traverse`+-- @+--+-- `gltraverse1` is `generic1` specialized to linear `Kleisli`.+gltraverse1 :: forall c t f a b. (ADT1 t, Constraints1 t c, CL.Applicative f)+            => (forall d e s. c s => (d %1-> f e) -> s d %1-> f (s e)) -> (a %1-> f b) -> t a %1-> f (t b)+gltraverse1 f = dimap Kleisli runKleisli $ generic1 @c $ dimap runKleisli Kleisli f+{-# INLINE gltraverse1 #-}++-- | `gltraverse01` is `generic01` specialized to linear `Kleisli`, requiring `Linear.Movable` for constants.+gltraverse01 :: forall c t f a b. (ADT1 t, Constraints01 t Linear.Movable c, DL.Applicative f)+             => (forall d e s. c s => (d %1-> f e) -> s d %1-> f (s e)) -> (a %1-> f b) -> t a %1-> f (t b)+gltraverse01 f = dimap Kleisli runKleisli $ generic01 @Linear.Movable @c (Kleisli (\a -> urpure (Linear.move a))) $ dimap runKleisli Kleisli f+{-# INLINE gltraverse01 #-}++urpure :: DL.Applicative f => Linear.Ur a %1 -> f a+urpure (Linear.Ur a) = DL.pure a  -- | 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.
src/Generics/OneLiner/Binary.hs view
@@ -7,18 +7,19 @@ -- Stability   :  experimental -- Portability :  non-portable ----- These generic functions allow changing the types of the constant leaves. --- They require type classes with 2 parameters, the first for the input type +-- These generic functions allow changing the types of the constant leaves.+-- They require type classes with 2 parameters, the first for the input type -- and the second for the output type. -- -- All functions without postfix are for instances of `Generic`, and functions--- with postfix @1@ are for instances of `Generic1` (with kind @* -> *@) which+-- with postfix @1@ are for instances of `Generic1` (with kind @Type -> Type@) which -- get an extra argument to specify how to deal with the parameter. -- Functions with postfix @01@ are also for `Generic1` but they get yet another -- argument that, like the `Generic` functions, allows handling of constant leaves. ----------------------------------------------------------------------------- {-# LANGUAGE     RankNTypes+  , LinearTypes   , Trustworthy   , TypeFamilies   , ConstraintKinds@@ -27,10 +28,13 @@   , AllowAmbiguousTypes   , ScopedTypeVariables   #-}-module Generics.OneLiner.Binary (+module Generics.OneLiner.Binary+(   -- * Traversing values   gmap, gtraverse,+  glmap, gltraverse,   gmap1, gtraverse1,+  glmap1, gltraverse1, gltraverse01,   -- * Combining values   zipWithA, zipWithA1,   -- * Functions for records@@ -46,23 +50,30 @@   GenericRecordProfunctor,   GenericNonEmptyProfunctor,   GenericProfunctor,+  Generic1Profunctor,   GenericUnitProfunctor(..),   GenericProductProfunctor(..),   GenericSumProfunctor(..),   GenericEmptyProfunctor(..),+  GenericConstantProfunctor(..),   -- * Types   ADT, ADTNonEmpty, ADTRecord, Constraints,   ADT1, ADTNonEmpty1, ADTRecord1, Constraints1, Constraints01,   FunConstraints, FunResult,   AnyType-) where+)+where -import GHC.Generics import Control.Applicative import Data.Bifunctor.Biff import Data.Profunctor+import Data.Profunctor.Kleisli.Linear import Generics.OneLiner.Classes import Generics.OneLiner.Internal+import Generics.OneLiner.Internal.Unary (D)+import qualified Data.Functor.Linear as DL+import qualified Data.Unrestricted.Linear as Linear+import qualified Control.Functor.Linear as CL  -- | Map over a structure, updating each component. --@@ -72,6 +83,14 @@ gmap = generic @c {-# INLINE gmap #-} +-- | Map over a structure linearly, updating each component.+--+-- `glmap` is `generic` specialized to the linear arrow.+glmap :: forall c t t'. (ADT t t', Constraints t t' c)+      => (forall s s'. c s s' => s %1-> s') -> t %1-> t'+glmap = generic @c+{-# INLINE glmap #-}+ -- | Map each component of a structure to an action, evaluate these actions from left to right, and collect the results. -- -- `gtraverse` is `generic` specialized to `Star`.@@ -80,17 +99,46 @@ gtraverse f = runStar $ generic @c $ Star f {-# INLINE gtraverse #-} +-- | Map each component of a structure to an action linearly, evaluate these actions from left to right, and collect the results.+--+-- `gltraverse` is `generic` specialized to linear `Kleisli`.+gltraverse :: forall c t t' f. (ADT t t', Constraints t t' c, DL.Applicative f)+           => (forall s s'. c s s' => s %1-> f s') -> t %1-> f t'+gltraverse f = runKleisli $ generic @c $ Kleisli f+{-# INLINE gltraverse #-}+ -- | `gmap1` is `generic1` specialized to @(->)@. gmap1 :: forall c t t' a b. (ADT1 t t', Constraints1 t t' c)-     => (forall d e s s'. c s s' => (d -> e) -> s d -> s' e) -> (a -> b) -> t a -> t' b+      => (forall d e s s'. c s s' => (d -> e) -> s d -> s' e) -> (a -> b) -> t a -> t' b gmap1 = generic1 @c {-# INLINE gmap1 #-} +-- | `glmap1` is `generic1` specialized to the linear arrow.+glmap1 :: forall c t t' a b. (ADT1 t t', Constraints1 t t' c)+       => (forall d e s s'. c s s' => (d %1-> e) -> s d %1-> s' e) -> (a %1-> b) -> t a %1-> t' b+glmap1 = generic1 @c+{-# INLINE glmap1 #-}+ -- | `gtraverse1` is `generic1` specialized to `Star`. gtraverse1 :: forall c t t' f a b. (ADT1 t t', Constraints1 t t' c, Applicative f)            => (forall d e s s'. c s s' => (d -> f e) -> s d -> f (s' e)) -> (a -> f b) -> t a -> f (t' b) gtraverse1 f = dimap Star runStar $ generic1 @c $ dimap runStar Star f {-# INLINE gtraverse1 #-}++-- | `gltraverse1` is `generic1` specialized to linear `Kleisli`.+gltraverse1 :: forall c t t' f a b. (ADT1 t t', Constraints1 t t' c, CL.Applicative f)+            => (forall d e s s'. c s s' => (d %1-> f e) -> s d %1-> f (s' e)) -> (a %1-> f b) -> t a %1-> f (t' b)+gltraverse1 f = dimap Kleisli runKleisli $ generic1 @c $ dimap runKleisli Kleisli f+{-# INLINE gltraverse1 #-}++-- | `gltraverse01` is `generic01` specialized to linear `Kleisli`, requiring `Linear.Movable` for constants.+gltraverse01 :: forall c t t' f a b. (ADT1 t t', Constraints01 t t' (D Linear.Movable) c, DL.Applicative f)+             => (forall d e s s'. c s s' => (d %1-> f e) -> s d %1-> f (s' e)) -> (a %1-> f b) -> t a %1-> f (t' b)+gltraverse01 f = dimap Kleisli runKleisli $ generic01 @(D Linear.Movable) @c (Kleisli (\a -> urpure (Linear.move a))) $ dimap runKleisli Kleisli f+{-# INLINE gltraverse01 #-}++urpure :: DL.Applicative f => Linear.Ur a %1-> f a+urpure (Linear.Ur a) = DL.pure a  -- | Combine two values by combining each component of the structures with the given function, under an applicative effect. -- Returns `empty` if the constructors don't match.
src/Generics/OneLiner/Classes.hs view
@@ -8,10 +8,13 @@ -- Portability :  non-portable -- -----------------------------------------------------------------------------+{-# OPTIONS -Wno-orphans #-} {-# LANGUAGE     EmptyCase   , LambdaCase+  , LinearTypes   , TypeOperators+  , BlockArguments   , MonoLocalBinds   , FlexibleInstances   , UndecidableInstances@@ -25,10 +28,20 @@ import Data.Bifunctor.Joker import Data.Bifunctor.Product import Data.Bifunctor.Tannen+import Data.Functor.Contravariant import Data.Functor.Contravariant.Divisible import Data.Functor.Compose-import Data.Profunctor+import Data.Kind (FUN)+import Data.Profunctor hiding (Profunctor(..))+import qualified Data.Profunctor as P+import Data.Profunctor.Linear (Profunctor(..))+import Data.Profunctor.Kleisli.Linear import Data.Tagged+import Data.Unrestricted.Linear ()+import GHC.Types (Multiplicity(..))+import Prelude.Linear (forget)+import qualified Data.Functor.Linear as DL+import qualified Control.Functor.Linear as CL  -- | A generic function using a `GenericRecordProfunctor` works on any data type -- with exactly one constructor, a.k.a. records,@@ -45,11 +58,19 @@ instance (GenericRecordProfunctor p, GenericSumProfunctor p) => GenericNonEmptyProfunctor p where  -- | A generic function using a `GenericProfunctor` works on any--- algebraic data type, including those with no constructors and constants.+-- algebraic data type of kind @Type@, including those with no constructors and constants. class (GenericNonEmptyProfunctor p, GenericEmptyProfunctor p) => GenericProfunctor p where instance (GenericNonEmptyProfunctor p, GenericEmptyProfunctor p) => GenericProfunctor p where +-- | A generic function using a `Generic1Profunctor` works on any+-- algebraic data type of kind @Type -> Type@, including those with no constructors and constants.+class (GenericProfunctor p, GenericConstantProfunctor p) => Generic1Profunctor p where+instance (GenericProfunctor p, GenericConstantProfunctor p) => Generic1Profunctor p where ++dimapForget :: P.Profunctor p => (a %1-> b) -> (c %1-> d) -> p b c -> p a d+dimapForget l r = P.dimap (forget l) (forget r)+ class Profunctor p => GenericUnitProfunctor p where   unit :: p (U1 a) (U1 a') @@ -59,26 +80,48 @@ class Profunctor p => GenericSumProfunctor p where   plus :: p (f a) (f' a') -> p (g a) (g' a') -> p ((f :+: g) a) ((f' :+: g') a') +class Profunctor p => GenericConstantProfunctor p where+  identity :: p c c+ class Profunctor p => GenericEmptyProfunctor p where-  identity :: p a a   zero :: p (V1 a) (V1 a')  +instance Profunctor (FUN 'One) where+  dimap f g h = \x -> g (h (f x))+instance GenericUnitProfunctor (FUN 'One) where+  unit U1 = U1+  {-# INLINE unit #-}+instance GenericProductProfunctor (FUN 'One) where+  mult f g (l :*: r) = f l :*: g r+  {-# INLINE mult #-}+instance GenericSumProfunctor (FUN 'One) where+  plus f g = e1 (\x -> L1 (f x)) (\x -> R1 (g x))+  {-# INLINE plus #-}+instance GenericEmptyProfunctor (FUN 'One) where+  zero = \case+  {-# INLINE zero #-}+instance GenericConstantProfunctor (FUN 'One) where+  identity x = x+  {-# INLINE identity #-}+ instance GenericUnitProfunctor (->) where-  unit _ = U1+  unit U1 = U1   {-# INLINE unit #-} instance GenericProductProfunctor (->) where   mult f g (l :*: r) = f l :*: g r   {-# INLINE mult #-} instance GenericSumProfunctor (->) where-  plus f g = e1 (L1 . f) (R1 . g)+  plus f g = e1 (\x -> L1 (f x)) (\x -> R1 (g x))   {-# INLINE plus #-} instance GenericEmptyProfunctor (->) where-  zero = absurd+  zero = \case   {-# INLINE zero #-}-  identity = id+instance GenericConstantProfunctor (->) where+  identity x = x   {-# INLINE identity #-} +instance Profunctor Tagged where dimap = dimapForget instance GenericUnitProfunctor Tagged where   unit = Tagged U1   {-# INLINE unit #-}@@ -86,6 +129,7 @@   mult (Tagged l) (Tagged r) = Tagged $ l :*: r   {-# INLINE mult #-} +instance Functor f => Profunctor (Star f) where dimap = dimapForget instance Applicative f => GenericUnitProfunctor (Star f) where   unit = Star $ \_ -> pure U1   {-# INLINE unit #-}@@ -95,12 +139,30 @@ instance Applicative f => GenericSumProfunctor (Star f) where   plus (Star f) (Star g) = Star $ e1 (fmap L1 . f) (fmap R1 . g)   {-# INLINE plus #-}-instance Applicative f => GenericEmptyProfunctor (Star f) where-  zero = Star absurd+instance Functor f => GenericEmptyProfunctor (Star f) where+  zero = Star \case   {-# INLINE zero #-}+instance Applicative f => GenericConstantProfunctor (Star f) where   identity = Star pure   {-# INLINE identity #-} +instance DL.Applicative f => GenericUnitProfunctor (Kleisli f) where+  unit = Kleisli $ \U1 -> DL.pure U1+  {-# INLINE unit #-}+instance DL.Applicative f => GenericProductProfunctor (Kleisli f) where+  mult (Kleisli f) (Kleisli g) = Kleisli $ \(l :*: r) -> (:*:) DL.<$> f l DL.<*> g r+  {-# INLINE mult #-}+instance DL.Applicative f => GenericSumProfunctor (Kleisli f) where+  plus (Kleisli f) (Kleisli g) = Kleisli $ e1 (\x -> DL.fmap L1 (f x)) (\x -> DL.fmap R1 (g x))+  {-# INLINE plus #-}+instance DL.Applicative f => GenericEmptyProfunctor (Kleisli f) where+  zero = Kleisli \case+  {-# INLINE zero #-}+instance CL.Applicative f => GenericConstantProfunctor (Kleisli f) where+  identity = Kleisli CL.pure+  {-# INLINE identity #-}++instance Functor f => Profunctor (Costar f) where dimap = dimapForget instance Functor f => GenericUnitProfunctor (Costar f) where   unit = Costar $ const U1   {-# INLINE unit #-}@@ -108,16 +170,18 @@   mult (Costar f) (Costar g) = Costar $ \lr -> f (fst1 <$> lr) :*: g (snd1 <$> lr)   {-# INLINE mult #-} -instance (Functor f, Applicative g, Profunctor p, GenericUnitProfunctor p) => GenericUnitProfunctor (Biff p f g) where-  unit = Biff $ dimap (const U1) pure unit+instance (Functor f, Applicative g, P.Profunctor p) => Profunctor (Biff p f g) where dimap = dimapForget+instance (Functor f, Applicative g, P.Profunctor p, GenericUnitProfunctor p) => GenericUnitProfunctor (Biff p f g) where+  unit = Biff $ P.dimap (const U1) pure unit   {-# INLINE unit #-}-instance (Functor f, Applicative g, Profunctor p, GenericProductProfunctor p) => GenericProductProfunctor (Biff p f g) where-  mult (Biff f) (Biff g) = Biff $ dimap+instance (Functor f, Applicative g, P.Profunctor p, GenericProductProfunctor p) => GenericProductProfunctor (Biff p f g) where+  mult (Biff f) (Biff g) = Biff $ P.dimap     (liftA2 (:*:) (Compose . fmap fst1) (Compose . fmap snd1))     (\(Compose l :*: Compose r) -> liftA2 (:*:) l r)-    (mult (dimap getCompose Compose f) (dimap getCompose Compose g))+    (mult (P.dimap getCompose Compose f) (P.dimap getCompose Compose g))   {-# INLINE mult #-} +instance Functor f => Profunctor (Joker f) where dimap = dimapForget instance Applicative f => GenericUnitProfunctor (Joker f) where   unit = Joker $ pure U1   {-# INLINE unit #-}@@ -130,9 +194,11 @@ instance Alternative f => GenericEmptyProfunctor (Joker f) where   zero = Joker empty   {-# INLINE zero #-}+instance Alternative f => GenericConstantProfunctor (Joker f) where   identity = Joker empty   {-# INLINE identity #-} +instance Contravariant f => Profunctor (Clown f) where dimap = dimapForget instance Divisible f => GenericUnitProfunctor (Clown f) where   unit = Clown conquer   {-# INLINE unit #-}@@ -143,11 +209,14 @@   plus (Clown f) (Clown g) = Clown $ choose (e1 Left Right) f g   {-# INLINE plus #-} instance Decidable f => GenericEmptyProfunctor (Clown f) where-  zero = Clown $ lose absurd+  zero = Clown $ lose \case   {-# INLINE zero #-}+instance Decidable f => GenericConstantProfunctor (Clown f) where   identity = Clown conquer   {-# INLINE identity #-} +instance (Profunctor p, Profunctor q) => Profunctor (Product p q) where+  dimap f g (Pair l r) = Pair (dimap f g l) (dimap f g r) instance (GenericUnitProfunctor p, GenericUnitProfunctor q) => GenericUnitProfunctor (Product p q) where   unit = Pair unit unit   {-# INLINE unit #-}@@ -160,9 +229,12 @@ instance (GenericEmptyProfunctor p, GenericEmptyProfunctor q) => GenericEmptyProfunctor (Product p q) where   zero = Pair zero zero   {-# INLINE zero #-}+instance (GenericConstantProfunctor p, GenericConstantProfunctor q) => GenericConstantProfunctor (Product p q) where   identity = Pair identity identity   {-# INLINE identity #-} +instance (Applicative f, Profunctor p) => Profunctor (Tannen f p) where+  dimap f g (Tannen p) = Tannen $ dimap f g <$> p instance (Applicative f, GenericUnitProfunctor p) => GenericUnitProfunctor (Tannen f p) where   unit = Tannen (pure unit)   {-# INLINE unit #-}@@ -175,13 +247,14 @@ instance (Applicative f, GenericEmptyProfunctor p) => GenericEmptyProfunctor (Tannen f p) where   zero = Tannen (pure zero)   {-# INLINE zero #-}+instance (Applicative f, GenericConstantProfunctor p) => GenericConstantProfunctor (Tannen f p) where   identity = Tannen (pure identity)   {-# INLINE identity #-}   newtype Zip f a b = Zip { runZip :: a -> a -> f b } instance Functor f => Profunctor (Zip f) where-  dimap f g (Zip h) = Zip $ \a1 a2 -> fmap g (h (f a1) (f a2))+  dimap f g (Zip h) = Zip $ \a1 a2 -> fmap (forget g) (h (f a1) (f a2))   {-# INLINE dimap #-} instance Applicative f => GenericUnitProfunctor (Zip f) where   unit = Zip $ \_ _ -> pure U1@@ -195,18 +268,15 @@     h (R1 a) (R1 b) = fmap R1 (g a b)     h _ _ = empty   {-# INLINE plus #-}-instance Alternative f => GenericEmptyProfunctor (Zip f) where-  zero = Zip absurd+instance Functor f => GenericEmptyProfunctor (Zip f) where+  zero = Zip \case   {-# INLINE zero #-}+instance Alternative f => GenericConstantProfunctor (Zip f) where   identity = Zip $ \_ _ -> empty   {-# INLINE identity #-}  -absurd :: V1 a -> b-absurd = \case {}-{-# INLINE absurd #-}--e1 :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> b+e1 :: (f a %m-> b) -> (g a %m-> b) -> (f :+: g) a %m-> b e1 f _ (L1 l) = f l e1 _ f (R1 r) = f r {-# INLINE e1 #-}
src/Generics/OneLiner/Internal.hs view
@@ -13,6 +13,7 @@   , DataKinds   , PolyKinds   , RankNTypes+  , LinearTypes   , TypeFamilies   , TypeOperators   , ConstraintKinds@@ -26,15 +27,29 @@   #-} module Generics.OneLiner.Internal where -import GHC.Generics+import GHC.Generics hiding (from, to, from1, to1)+import qualified GHC.Generics as G import GHC.Types (Constraint)-import Data.Profunctor-import Data.Proxy import Data.Functor.Identity+import Data.Kind (Type)+import Data.Profunctor.Linear (Profunctor(..))+import Data.Proxy+import Prelude (Functor(..), Applicative(..), ($), (.), (+))+import Prelude.Linear hiding (zero, ($), (.), (+))+import qualified Unsafe.Linear as Unsafe  import Generics.OneLiner.Classes -type family Constraints' (t :: * -> *) (t' :: * -> *) (c :: * -> * -> Constraint) (c1 :: (* -> *) -> (* -> *) -> Constraint) :: Constraint+to :: Generic a => Rep a x %1-> a+to = Unsafe.toLinear G.to+from :: Generic a => a %1-> Rep a x+from = Unsafe.toLinear G.from+to1 :: Generic1 f => Rep1 f x %1-> f x+to1 = Unsafe.toLinear G.to1+from1 :: Generic1 f => f x %1-> Rep1 f x+from1 = Unsafe.toLinear G.from1++type family Constraints' (t :: Type -> Type) (t' :: Type -> Type) (c :: Type -> Type -> Constraint) (c1 :: (Type -> Type) -> (Type -> Type) -> Constraint) :: Constraint type instance Constraints' V1 V1 c c1 = () type instance Constraints' U1 U1 c c1 = () type instance Constraints' (f :+: g) (f' :+: g') c c1 = (Constraints' f f' c c1, Constraints' g g' c c1)@@ -49,118 +64,110 @@ type ADTNonEmpty' = ADT_ Identity Proxy NonEmptyProfunctor type ADTRecord' = ADT_ Identity Proxy RecordProfunctor -type ADT1' t t' = (ADT_ Identity Identity ADTProfunctor t t', ADT_ Proxy Identity ADTProfunctor t t')+type ADT1' t t' = (ADT_ Identity Identity ADTProfunctor t t', ADT_ Proxy Identity ADT1Profunctor t t') type ADTNonEmpty1' t t' = (ADT_ Identity Identity NonEmptyProfunctor t t', ADT_ Proxy Identity NonEmptyProfunctor t t') type ADTRecord1' t t' = (ADT_ Identity Identity RecordProfunctor t t', ADT_ Proxy Identity RecordProfunctor t t')  type ADTProfunctor = GenericEmptyProfunctor ': NonEmptyProfunctor+type ADT1Profunctor = GenericConstantProfunctor ': ADTProfunctor type NonEmptyProfunctor = GenericSumProfunctor ': RecordProfunctor type RecordProfunctor = '[GenericProductProfunctor, GenericUnitProfunctor, Profunctor] -type family Satisfies (p :: * -> * -> *) (ks :: [(* -> * -> *) -> Constraint]) :: Constraint+type family Satisfies (p :: Type -> Type -> Type) (ks :: [(Type -> Type -> Type) -> Constraint]) :: Constraint type instance Satisfies p (k ': ks) = (k p, Satisfies p ks) type instance Satisfies p '[] = () -class (ks :: [(* -> * -> *) -> Constraint]) |- (k :: (* -> * -> *) -> Constraint) where-  (|-) :: Satisfies p ks => proxy0 ks -> proxy1 k -> (k p => p a b) -> p a b+class (ks :: [(Type -> Type -> Type) -> Constraint]) |- (k :: (Type -> Type -> Type) -> Constraint) where+  implies :: Satisfies p ks => (k p => p a b) -> p a b  instance {-# OVERLAPPABLE #-} ks |- k => (_k ': ks) |- k where-  (_ :: proxy0 (_k ': ks)) |- proxy1 = (Proxy :: Proxy ks) |- proxy1-  {-# INLINE (|-) #-}+  implies = implies @ks @k+  {-# INLINE implies #-}  instance (k ': _ks) |- k where-  _ |- _ = id-  {-# INLINE (|-) #-}+  implies p = p+  {-# INLINE implies #-} -generic' :: forall t t' c p ks a b proxy0 for. (ADT_ Identity Proxy ks t t', Constraints' t t' c AnyType, Satisfies p ks)-         => proxy0 ks-         -> for c-         -> (forall s s'. c s s' => p s s')+generic' :: forall ks c p t t' a b. (ADT_ Identity Proxy ks t t', Constraints' t t' c AnyType, Satisfies p ks)+         => (forall s s'. c s s' => p s s')          -> p (t a) (t' b)-generic' proxy0 for f = generic_ proxy0 (Proxy :: Proxy Identity) for (Identity f) (Proxy :: Proxy AnyType) Proxy Proxy+generic' f = generic_ @Identity @Proxy @ks (Proxy @c) (Identity f) (Proxy @AnyType) Proxy Proxy {-# INLINE generic' #-} -generic1' :: forall t t' c1 p ks a b proxy0 for. (ADT_ Proxy Identity ks t t', Constraints' t t' AnyType c1, Satisfies p ks)-           => proxy0 ks-           -> for c1-           -> (forall s s' d e. c1 s s' => p d e -> p (s d) (s' e))+generic1' :: forall ks c1 p t t' a b. (ADT_ Proxy Identity ks t t', Constraints' t t' AnyType c1, Satisfies p ks)+           => (forall s s' d e. c1 s s' => p d e -> p (s d) (s' e))            -> p a b            -> p (t a) (t' b)-generic1' proxy0 for f p = generic_ proxy0 (Proxy :: Proxy Proxy) (Proxy :: Proxy AnyType) Proxy for (Identity f) (Identity p)+generic1' f p = generic_ @Proxy @Identity @ks (Proxy @AnyType) Proxy (Proxy @c1) (Identity f) (Identity p) {-# INLINE generic1' #-} -generic01' :: forall t t' c0 c1 p ks a b proxy0 for for1. (ADT_ Identity Identity ks t t', Constraints' t t' c0 c1, Satisfies p ks)-          => proxy0 ks-          -> for c0-          -> (forall s s'. c0 s s' => p s s')-          -> for1 c1+generic01' :: forall ks c0 c1 p t t' a b. (ADT_ Identity Identity ks t t', Constraints' t t' c0 c1, Satisfies p ks)+          => (forall s s'. c0 s s' => p s s')           -> (forall s s' d e. c1 s s' => p d e -> p (s d) (s' e))           -> p a b           -> p (t a) (t' b)-generic01' proxy0 for0 k for1 f p = generic_ proxy0 (Proxy :: Proxy Identity) for0 (Identity k) for1 (Identity f) (Identity p)+generic01' k f p = generic_ @Identity @Identity @ks (Proxy @c0) (Identity k) (Proxy @c1) (Identity f) (Identity p) {-# INLINE generic01' #-} -class ADT_ (nullary :: * -> *) (unary :: * -> *) (ks :: [(* -> * -> *) -> Constraint]) (t :: * -> *) (t' :: * -> *) where-  generic_ :: (Constraints' t t' c c1, Satisfies p ks)-           => proxy0 ks-           -> proxy1 nullary-           -> for c+class ADT_ (nullary :: Type -> Type) (unary :: Type -> Type) (ks :: [(Type -> Type -> Type) -> Constraint]) (t :: Type -> Type) (t' :: Type -> Type) where+  generic_ :: forall c c1 p a b. (Constraints' t t' c c1, Satisfies p ks)+           => Proxy c            -> (forall s s'. c s s' => nullary (p s s'))-           -> for1 c1+           -> Proxy c1            -> (forall r1 s1 d e. c1 r1 s1 => unary (p d e -> p (r1 d) (s1 e)))            -> unary (p a b)            -> p (t a) (t' b)  instance ks |- GenericEmptyProfunctor => ADT_ nullary unary ks V1 V1 where-  generic_ proxy0 _ _ _ _ _ _ = (proxy0 |- (Proxy :: Proxy GenericEmptyProfunctor)) zero+  generic_ _ _ _ _ _ = implies @ks @GenericEmptyProfunctor zero   {-# INLINE generic_ #-}  instance ks |- GenericUnitProfunctor => ADT_ nullary unary ks U1 U1 where-  generic_ proxy0 _ _ _ _ _ _ = (proxy0 |- (Proxy :: Proxy GenericUnitProfunctor)) unit+  generic_ _ _ _ _ _ = implies @ks @GenericUnitProfunctor unit   {-# INLINE generic_ #-}  instance (ks |- GenericSumProfunctor, ADT_ nullary unary ks f f', ADT_ nullary unary ks g g') => ADT_ nullary unary ks (f :+: g) (f' :+: g') where-  generic_ proxy0 proxy1 for f for1 f1 p1 = (proxy0 |- (Proxy :: Proxy GenericSumProfunctor))-    (plus (generic_ proxy0 proxy1 for f for1 f1 p1) (generic_ proxy0 proxy1 for f for1 f1 p1))+  generic_ for f for1 f1 p1 = implies @ks @GenericSumProfunctor+    (plus (generic_ @nullary @unary @ks for f for1 f1 p1) (generic_ @nullary @unary @ks for f for1 f1 p1))   {-# INLINE generic_ #-}  instance (ks |- GenericProductProfunctor, ADT_ nullary unary ks f f', ADT_ nullary unary ks g g') => ADT_ nullary unary ks (f :*: g) (f' :*: g') where-  generic_ proxy0 proxy1 for f for1 f1 p1 = (proxy0 |- (Proxy :: Proxy GenericProductProfunctor))-    (mult (generic_ proxy0 proxy1 for f for1 f1 p1) (generic_ proxy0 proxy1 for f for1 f1 p1))+  generic_ for f for1 f1 p1 = implies @ks @GenericProductProfunctor+    (mult (generic_ @nullary @unary @ks for f for1 f1 p1) (generic_ @nullary @unary @ks for f for1 f1 p1))   {-# INLINE generic_ #-}  instance ks |- Profunctor => ADT_ Identity unary ks (K1 i v) (K1 i' v') where-  generic_ proxy0 _ _ f _ _ _ = (proxy0 |- (Proxy :: Proxy Profunctor)) (dimap unK1 K1 (runIdentity f))+  generic_ _ f _ _ _ = implies @ks @Profunctor (dimap (\(K1 x) -> x) K1 (runIdentity f))   {-# INLINE generic_ #-} -instance ks |- GenericEmptyProfunctor => ADT_ Proxy unary ks (K1 i v) (K1 i' v) where-  generic_ proxy0 _ _ _ _ _ _ = (proxy0 |- (Proxy :: Proxy GenericEmptyProfunctor)) (dimap unK1 K1 identity)+instance ks |- GenericConstantProfunctor => ADT_ Proxy unary ks (K1 i v) (K1 i' v) where+  generic_ _ _ _ _ _ = implies @ks @GenericConstantProfunctor (dimap (\(K1 x) -> x) K1 identity)   {-# INLINE generic_ #-}  instance (ks |- Profunctor, ADT_ nullary unary ks f f') => ADT_ nullary unary ks (M1 i c f) (M1 i' c' f') where-  generic_ proxy0 proxy1 for f for1 f1 p1 = (proxy0 |- (Proxy :: Proxy Profunctor))-    (dimap unM1 M1 (generic_ proxy0 proxy1 for f for1 f1 p1))+  generic_ for f for1 f1 p1 = implies @ks @Profunctor+    (dimap (\(M1 x) -> x) M1 (generic_ @nullary @unary @ks for f for1 f1 p1))   {-# INLINE generic_ #-}  instance (ks |- Profunctor, ADT_ nullary Identity ks g g') => ADT_ nullary Identity ks (f :.: g) (f' :.: g') where-  generic_ proxy0 proxy1 for f for1 f1 p1 = (proxy0 |- (Proxy :: Proxy Profunctor))-    (dimap unComp1 Comp1 $ runIdentity f1 (generic_ proxy0 proxy1 for f for1 f1 p1))+  generic_ for f for1 f1 p1 = implies @ks @Profunctor+    (dimap (\(Comp1 x) -> x) Comp1 $ runIdentity f1 (generic_ @nullary @Identity @ks for f for1 f1 p1))   {-# INLINE generic_ #-}  instance ks |- Profunctor => ADT_ nullary Identity ks Par1 Par1 where-  generic_ proxy0 _ _ _ _ _ p = (proxy0 |- (Proxy :: Proxy Profunctor))-    (dimap unPar1 Par1 (runIdentity p))+  generic_ _ _ _ _ p = implies @ks @Profunctor+    (dimap (\(Par1 x) -> x) Par1 (runIdentity p))   {-# INLINE generic_ #-}  instance ks |- Profunctor => ADT_ nullary Identity ks (Rec1 f) (Rec1 f') where-  generic_ proxy0 _ _ _ _ f p = (proxy0 |- (Proxy :: Proxy Profunctor))-    (dimap unRec1 Rec1 (runIdentity (f <*> p)))+  generic_ _ _ _ f p = implies @ks @Profunctor+    (dimap (\(Rec1 x) -> x) Rec1 (runIdentity (f <*> p)))   {-# INLINE generic_ #-}   data Ctor a b = Ctor { index :: a -> Int, count :: Int } instance Profunctor Ctor where-  dimap l _ (Ctor i c) = Ctor (i . l) c+  dimap l _ (Ctor i c) = Ctor (i . forget l) c   {-# INLINE dimap #-} instance GenericUnitProfunctor Ctor where   unit = Ctor (const 0) 1@@ -174,52 +181,53 @@ instance GenericEmptyProfunctor Ctor where   zero = Ctor (const 0) 0   {-# INLINE zero #-}+instance GenericConstantProfunctor Ctor where   identity = Ctor (const 0) 1   {-# INLINE identity #-}  record :: forall c p t t'. (ADTRecord t t', Constraints t t' c, GenericRecordProfunctor p)        => (forall s s'. c s s' => p s s') -> p t t'-record f = dimap from to $ generic' (Proxy :: Proxy RecordProfunctor) (Proxy :: Proxy c) f+record f = dimap from to $ generic' @RecordProfunctor @c f {-# INLINE record #-}  record1 :: forall c p t t' a b. (ADTRecord1 t t', Constraints1 t t' c, GenericRecordProfunctor p)         => (forall d e s s'. c s s' => p d e -> p (s d) (s' e)) -> p a b -> p (t a) (t' b)-record1 f p = dimap from1 to1 $ generic1' (Proxy :: Proxy RecordProfunctor) (Proxy :: Proxy c) f p+record1 f p = dimap from1 to1 $ generic1' @RecordProfunctor @c f p {-# INLINE record1 #-}  record01 :: forall c0 c1 p t t' a b. (ADTRecord1 t t', Constraints01 t t' c0 c1, GenericRecordProfunctor p)          => (forall s s'. c0 s s' => p s s') -> (forall d e s s'. c1 s s' => p d e -> p (s d) (s' e)) -> p a b -> p (t a) (t' b)-record01 k f p = dimap from1 to1 $ generic01' (Proxy :: Proxy RecordProfunctor) (Proxy :: Proxy c0) k (Proxy :: Proxy c1) f p+record01 k f p = dimap from1 to1 $ generic01' @RecordProfunctor @c0 @c1 k f p {-# INLINE record01 #-}  nonEmpty :: forall c p t t'. (ADTNonEmpty t t', Constraints t t' c, GenericNonEmptyProfunctor p)          => (forall s s'. c s s' => p s s') -> p t t'-nonEmpty f = dimap from to $ generic' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c) f+nonEmpty f = dimap from to $ generic' @NonEmptyProfunctor @c f {-# INLINE nonEmpty #-}  nonEmpty1 :: forall c p t t' a b. (ADTNonEmpty1 t t', Constraints1 t t' c, GenericNonEmptyProfunctor p)           => (forall d e s s'. c s s' => p d e -> p (s d) (s' e)) -> p a b -> p (t a) (t' b)-nonEmpty1 f p = dimap from1 to1 $ generic1' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c) f p+nonEmpty1 f p = dimap from1 to1 $ generic1' @NonEmptyProfunctor @c f p {-# INLINE nonEmpty1 #-}  nonEmpty01 :: forall c0 c1 p t t' a b. (ADTNonEmpty1 t t', Constraints01 t t' c0 c1, GenericNonEmptyProfunctor p)            => (forall s s'. c0 s s' => p s s') -> (forall d e s s'. c1 s s' => p d e -> p (s d) (s' e)) -> p a b -> p (t a) (t' b)-nonEmpty01 k f p = dimap from1 to1 $ generic01' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c0) k (Proxy :: Proxy c1) f p+nonEmpty01 k f p = dimap from1 to1 $ generic01' @NonEmptyProfunctor @c0 @c1 k f p {-# INLINE nonEmpty01 #-}  generic :: forall c p t t'. (ADT t t', Constraints t t' c, GenericProfunctor p)         => (forall s s'. c s s' => p s s') -> p t t'-generic f = dimap from to $ generic' (Proxy :: Proxy ADTProfunctor) (Proxy :: Proxy c) f+generic f = dimap from to $ generic' @ADTProfunctor @c f {-# INLINE generic #-} -generic1 :: forall c p t t' a b. (ADT1 t t', Constraints1 t t' c, GenericProfunctor p)+generic1 :: forall c p t t' a b. (ADT1 t t', Constraints1 t t' c, Generic1Profunctor p)          => (forall d e s s'. c s s' => p d e -> p (s d) (s' e)) -> p a b -> p (t a) (t' b)-generic1 f p = dimap from1 to1 $ generic1' (Proxy :: Proxy ADTProfunctor) (Proxy :: Proxy c) f p+generic1 f p = dimap from1 to1 $ generic1' @ADT1Profunctor @c f p {-# INLINE generic1 #-}  generic01 :: forall c0 c1 p t t' a b. (ADT1 t t', Constraints01 t t' c0 c1, GenericProfunctor p)           => (forall s s'. c0 s s' => p s s') -> (forall d e s s'. c1 s s' => p d e -> p (s d) (s' e)) -> p a b -> p (t a) (t' b)-generic01 k f p = dimap from1 to1 $ generic01' (Proxy :: Proxy ADTProfunctor) (Proxy :: Proxy c0) k (Proxy :: Proxy c1) f p+generic01 k f p = dimap from1 to1 $ generic01' @ADTProfunctor @c0 @c1 k f p {-# INLINE generic01 #-}  -- | `Constraints` is a constraint type synonym, containing the constraint@@ -292,9 +300,8 @@ instance Functor Pair where   fmap f (Pair a b) = Pair (f a) (f b)   {-# INLINE fmap #-}-  + infixr 9 .: (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) (.:) = (.) . (.) {-# INLINE (.:) #-}-
src/Generics/OneLiner/Internal/Unary.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE     PolyKinds   , RankNTypes+  , LinearTypes   , TypeFamilies   , ConstraintKinds   , FlexibleContexts@@ -48,47 +49,47 @@  record :: forall c p t. (ADTRecord t, Constraints t c, GenericRecordProfunctor p)        => (forall s. c s => p s s) -> p t t-record = I.record @(D c)+record p = I.record @(D c) p {-# INLINE record #-}  record1 :: forall c p t a b. (ADTRecord1 t, Constraints1 t c, GenericRecordProfunctor p)         => (forall d e s. c s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b)-record1 = I.record1 @(D c)+record1 f = I.record1 @(D c) f {-# INLINE record1 #-}  record01 :: forall c0 c1 p t a b. (ADTRecord1 t, Constraints01 t c0 c1, GenericRecordProfunctor p)          => (forall s. c0 s => p s s) -> (forall d e s. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b)-record01 = I.record01 @(D c0) @(D c1)+record01 f g = I.record01 @(D c0) @(D c1) f g {-# INLINE record01 #-}  nonEmpty :: forall c p t. (ADTNonEmpty t, Constraints t c, GenericNonEmptyProfunctor p)          => (forall s. c s => p s s) -> p t t-nonEmpty = I.nonEmpty @(D c)+nonEmpty p = I.nonEmpty @(D c) p {-# INLINE nonEmpty #-}  nonEmpty1 :: forall c p t a b. (ADTNonEmpty1 t, Constraints1 t c, GenericNonEmptyProfunctor p)           => (forall d e s. c s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b)-nonEmpty1 = I.nonEmpty1 @(D c)+nonEmpty1 f = I.nonEmpty1 @(D c) f {-# INLINE nonEmpty1 #-}  nonEmpty01 :: forall c0 c1 p t a b. (ADTNonEmpty1 t, Constraints01 t c0 c1, GenericNonEmptyProfunctor p)            => (forall s. c0 s => p s s) -> (forall d e s. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b)-nonEmpty01 = I.nonEmpty01 @(D c0) @(D c1)+nonEmpty01 f g = I.nonEmpty01 @(D c0) @(D c1) f g {-# INLINE nonEmpty01 #-}  generic :: forall c p t. (ADT t, Constraints t c, GenericProfunctor p)         => (forall s. c s => p s s) -> p t t-generic = I.generic @(D c) @p @t @t+generic p = I.generic @(D c) @p @t @t p {-# INLINE generic #-} -generic1 :: forall c p t a b. (ADT1 t, Constraints1 t c, GenericProfunctor p)+generic1 :: forall c p t a b. (ADT1 t, Constraints1 t c, Generic1Profunctor p)          => (forall d e s. c s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b)-generic1 = I.generic1 @(D c) @p @t @t+generic1 f = I.generic1 @(D c) @p @t @t f {-# INLINE generic1 #-}  generic01 :: forall c0 c1 p t a b. (ADT1 t, Constraints01 t c0 c1, GenericProfunctor p)           => (forall s. c0 s => p s s) -> (forall d e s. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b)-generic01 = I.generic01 @(D c0) @(D c1)+generic01 f g = I.generic01 @(D c0) @(D c1) f g {-# INLINE generic01 #-}  -- | Get the index in the lists returned by `create` and `createA` of the constructor of the given value.
test/unittests.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeApplications #-} -import Data.Functor.Contravariant import Data.Functor.Identity import GHC.Generics import Test.HUnit@@ -16,6 +15,7 @@ create0 :: (ADT t, Constraints t ((~) Int)) => [t] create0 = create @((~) Int) [0] +testCreate :: Test testCreate = "create" ~:   [ "Identity" ~: create0 ~?= [Identity 0]   , "()"       ~: create0 ~?= [()]@@ -28,6 +28,7 @@ createA10 :: ADT1 t => [t Int] createA10 = createA1 @AnyType (const []) [0] +testCreateA1 :: Test testCreateA1 = "createA1" ~:   [ "Identity" ~: createA10 ~?= [Identity 0]   , "(,)"      ~: createA10 ~?= ([] :: [(String, Int)])@@ -39,6 +40,7 @@ nullaryOp0 :: (ADTRecord t, Constraints t ((~) Int)) => t nullaryOp0 = nullaryOp @((~) Int) 0 +testNullaryOp :: Test testNullaryOp = "nullaryOp" ~:   [ "Identity" ~: nullaryOp0 ~?= Identity 0   , "()"       ~: nullaryOp0 ~?= ()@@ -48,13 +50,16 @@ createA1'0 :: ADTRecord1 t => [t Int] createA1'0 = createA1' @AnyType (const []) [0] +testCreateA1' :: Test testCreateA1' = "createA1'" ~:   [ "Identity" ~: createA1'0 ~?= [Identity 0]   , "Pair"     ~: createA1'0 ~?= [Pair 0 0]   ] +main :: IO Counts main = runTestTT $ test   [ testCreate   , testCreateA1+  , testCreateA1'   , testNullaryOp   ]