extensible 0.8.2 → 0.8.3

raw patch · 9 files changed

+96/−92 lines, 9 filesdep −monad-skeletondep ~aesondep ~prettyprinterdep ~th-liftPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: monad-skeleton

Dependency ranges changed: aeson, prettyprinter, th-lift

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• extensible.cabal +5/−6
• src/Data/Extensible.hs +2/−0
• src/Data/Extensible/Dictionary.hs +45/−49
• src/Data/Extensible/Field.hs +3/−2
• src/Data/Extensible/Nullable.hs +1/−5
• src/Data/Extensible/Product.hs +9/−8
• src/Data/Extensible/Tangle.hs +6/−5
• src/Data/Extensible/Wrapper.hs +18/−17

@@ -1,3 +1,10 @@+0.8.3+------------------------------------------------++* `Comp` is now a pattern synonym for `Compose`+* Added missing `liftTyped` implementations+* Supported aeson-2.0+ 0.8.1 ------------------------------------------------ * Added `DefaultOrdered` and `Incremental` instances to `:&`

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                extensible-version:             0.8.2+version:             0.8.3 synopsis:            Extensible, efficient, optics-friendly data types and effects homepage:            https://github.com/fumieval/extensible bug-reports:         http://github.com/fumieval/extensible/issues@@ -16,7 +16,7 @@ category:            Data, Records build-type:          Simple stability:           experimental-Tested-With:         GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2+Tested-With:         GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4, GHC == 9.0.1  extra-source-files:   examples/*.hs@@ -73,7 +73,7 @@     , CPP     , NoStarIsType   build-depends:       base >= 4.8 && <5-    , aeson+    , aeson ^>= 2.0     , bytestring     , comonad     , constraints@@ -82,8 +82,7 @@     , hashable     , incremental >= 0.3.1     , membership-    , monad-skeleton >= 0.1.2-    , prettyprinter >= 1.2.1 && <2+    , prettyprinter ^>= 1.7     , primitive     , profunctors     , QuickCheck@@ -91,7 +90,7 @@     , tagged     , template-haskell     , text-    , th-lift+    , th-lift >= 0.8     , transformers     , unordered-containers     , vector >= 0.12.1.2

@@ -43,8 +43,10 @@   , module Data.Extensible.Wrapper   , Proxy(..)   , KnownSymbol+  , Compose(..)   ) where +import Data.Functor.Compose import Data.Extensible.Class import Data.Extensible.Dictionary import Data.Extensible.Field

@@ -35,20 +35,20 @@ import Data.Extensible.Nullable import Data.Constraint import Data.Extensible.Struct-import Data.Extensible.Wrapper import Data.Hashable+import qualified Data.Aeson.KeyMap as KM+import Data.Functor.Compose import qualified Data.HashMap.Strict as HM import Data.Incremental import Data.Maybe (isJust) import Data.Monoid (Any(..))-import Data.Text.Prettyprint.Doc+import Prettyprinter import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Unboxed as U-import qualified Data.Text as T import Data.Type.Equality import qualified Language.Haskell.TH.Lift as TH-#if MIN_VERSION_template_haskell(2,17,0)+#if MIN_VERSION_template_haskell(2,16,0) import qualified Language.Haskell.TH.Syntax as TH #endif import Language.Haskell.TH hiding (Type)@@ -63,8 +63,8 @@ #endif  -- | Reify a collection of dictionaries, as you wish.-library :: forall c xs. Forall c xs => xs :& Comp Dict c-library = hrepeatFor (Proxy :: Proxy c) $ Comp Dict+library :: forall c xs. Forall c xs => xs :& Compose Dict c+library = hrepeatFor (Proxy :: Proxy c) $ Compose Dict {-# INLINE library #-}  class (f x, g x) => And f g x@@ -95,8 +95,8 @@   {-# INLINE compare #-}  instance WrapForall Semigroup h xs => Semigroup (xs :& h) where-  (<>) = hzipWith3 (\(Comp Dict) -> (<>))-    (library :: xs :& Comp Dict (Instance1 Semigroup h))+  (<>) = hzipWith3 (\(Compose Dict) -> (<>))+    (library :: xs :& Compose Dict (Instance1 Semigroup h))   {-# INLINE (<>) #-}  instance (WrapForall Semigroup h xs, WrapForall Monoid h xs) => Monoid (xs :& h) where@@ -114,59 +114,53 @@   minBound = hrepeatFor (Proxy :: Proxy (Instance1 Bounded h)) minBound   maxBound = hrepeatFor (Proxy :: Proxy (Instance1 Bounded h)) maxBound -#if !MIN_VERSION_th_lift(0,7,9)-instance TH.Lift a => TH.Lift (Identity a) where-  lift = appE (conE 'Identity) . TH.lift . runIdentity--instance TH.Lift a => TH.Lift (Const a b) where-  lift = appE (conE 'Const) . TH.lift . getConst-#endif- instance WrapForall TH.Lift h xs => TH.Lift (xs :& h) where   lift = hfoldrWithIndexFor (Proxy :: Proxy (Instance1 TH.Lift h))     (\_ x xs -> infixE (Just $ TH.lift x) (varE '(<:)) (Just xs)) (varE 'nil) #if MIN_VERSION_template_haskell(2,17,0)    liftTyped e = TH.Code $ TH.TExp <$> TH.lift e+#elif MIN_VERSION_template_haskell(2,16,0)+  liftTyped e = TH.TExp <$> TH.lift e #endif -newtype instance U.MVector s (xs :& h) = MV_Product (xs :& Comp (U.MVector s) h)-newtype instance U.Vector (xs :& h) = V_Product (xs :& Comp U.Vector h)+newtype instance U.MVector s (xs :& h) = MV_Product (xs :& Compose (U.MVector s) h)+newtype instance U.Vector (xs :& h) = V_Product (xs :& Compose U.Vector h) -hlookupC :: Membership xs a -> xs :& Comp f g -> f (g a)-hlookupC i = getComp . hlookup i+hlookupC :: Membership xs a -> xs :& Compose f g -> f (g a)+hlookupC i = getCompose . hlookup i  instance WrapForall U.Unbox h (x ': xs) => G.Vector U.Vector ((x ': xs) :& h) where   basicUnsafeFreeze (MV_Product v) = fmap V_Product     $ hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    $ \m -> Comp <$> G.basicUnsafeFreeze (hlookupC m v)+    $ \m -> Compose <$> G.basicUnsafeFreeze (hlookupC m v)   basicUnsafeThaw (V_Product v) = fmap MV_Product     $ hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    $ \m -> Comp <$> G.basicUnsafeThaw (hlookupC m v)-  basicLength (V_Product v) = G.basicLength $ getComp $ hindex v leadership+    $ \m -> Compose <$> G.basicUnsafeThaw (hlookupC m v)+  basicLength (V_Product v) = G.basicLength $ getCompose $ hindex v leadership   basicUnsafeSlice i n (V_Product v) = V_Product     $ htabulateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    $ \m -> Comp $ G.basicUnsafeSlice i n (hlookupC m v)+    $ \m -> Compose $ G.basicUnsafeSlice i n (hlookupC m v)   basicUnsafeIndexM (V_Product v) i = hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))     $ \m -> G.basicUnsafeIndexM (hlookupC m v) i   basicUnsafeCopy (MV_Product v) (V_Product w)     = henumerateFor (Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy :: Proxy (x ': xs)) ((>>) . \i -> G.basicUnsafeCopy (hlookupC i v) (hlookupC i w)) (return ())  instance WrapForall U.Unbox h (x ': xs) => M.MVector U.MVector ((x ': xs) :& h) where-  basicLength (MV_Product v) = M.basicLength $ getComp $ hindex v leadership+  basicLength (MV_Product v) = M.basicLength $ getCompose $ hindex v leadership   basicUnsafeSlice i n (MV_Product v) = MV_Product     $ htabulateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    $ \m -> Comp $ M.basicUnsafeSlice i n (hlookupC m v)+    $ \m -> Compose $ M.basicUnsafeSlice i n (hlookupC m v)   basicOverlaps (MV_Product v1) (MV_Product v2) = henumerateFor     (Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy :: Proxy (x ': xs))     (\i -> (||) $ M.basicOverlaps (hlookupC i v1) (hlookupC i v2))     False   basicUnsafeNew n = fmap MV_Product     $ hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    (const $ Comp <$> M.basicUnsafeNew n)+    (const $ Compose <$> M.basicUnsafeNew n)   basicInitialize (MV_Product v) = henumerateFor (Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy :: Proxy (x ': xs)) ((>>) . \i -> M.basicInitialize $ hlookupC i v) (return ())   basicUnsafeReplicate n x = fmap MV_Product     $ hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    $ \m -> fmap Comp $ M.basicUnsafeReplicate n $ hlookup m x+    $ \m -> fmap Compose $ M.basicUnsafeReplicate n $ hlookup m x   basicUnsafeRead (MV_Product v) i = hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))     (\m -> M.basicUnsafeRead (hlookupC m v) i)   basicUnsafeWrite (MV_Product v) i x = henumerateFor (Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy :: Proxy (x ': xs)) ((>>) . \m -> M.basicUnsafeWrite (hlookupC m v) i (hlookup m x)) (return ())@@ -178,7 +172,7 @@     = henumerateFor (Proxy :: Proxy (Instance1 U.Unbox h)) (Proxy :: Proxy (x ': xs)) ((>>) . \i -> M.basicUnsafeMove (hlookupC i v1) (hlookupC i v2)) (return ())   basicUnsafeGrow (MV_Product v) n = fmap MV_Product     $ hgenerateFor (Proxy :: Proxy (Instance1 U.Unbox h))-    $ \i -> Comp <$> M.basicUnsafeGrow (hlookupC i v) n+    $ \i -> Compose <$> M.basicUnsafeGrow (hlookupC i v) n  instance WrapForall U.Unbox h (x ': xs) => U.Unbox ((x ': xs) :& h) @@ -224,61 +218,63 @@ instance Forall (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)) xs => J.FromJSON (xs :& Field h) where   parseJSON = J.withObject "Object" $ \v -> hgenerateFor     (Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)))-    $ \m -> let k = symbolVal (proxyKeyOf m)-      in fmap Field $ J.prependFailure ("parsing #" ++ k ++ ": ") $ J.parseJSON $ maybe J.Null id $ HM.lookup (T.pack k) v+    $ \m -> let k = stringKeyOf m+      in fmap Field $ J.prependFailure ("parsing " ++ show k ++ ": ") $ J.parseJSON $ maybe J.Null id $ KM.lookup k v  instance Forall (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)) xs => J.ToJSON (xs :& Field h) where   toJSON = J.Object . hfoldlWithIndexFor     (Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)))-    (\k m v -> HM.insert (T.pack (symbolVal (proxyKeyOf k))) (J.toJSON v) m)-    HM.empty+    (\k m v -> KM.insert (stringKeyOf k) (J.toJSON v) m)+    KM.empty  instance Forall (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)) xs => J.FromJSON (xs :& Nullable (Field h)) where   parseJSON = J.withObject "Object" $ \v -> hgenerateFor     (Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.FromJSON h)))-    $ \m -> let k = symbolVal (proxyKeyOf m)-      in fmap Nullable $ traverse J.parseJSON $ HM.lookup (T.pack k) v+    $ \m -> let k = stringKeyOf m+      in fmap Nullable $ traverse J.parseJSON $ KM.lookup k v  instance Forall (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)) xs => J.ToJSON (xs :& Nullable (Field h)) where   toJSON = J.Object . hfoldlWithIndexFor     (Proxy :: Proxy (KeyTargetAre KnownSymbol (Instance1 J.ToJSON h)))-    (\k m (Nullable v) -> maybe id (HM.insert (T.pack $ symbolVal $ proxyKeyOf k) . J.toJSON) v m)-    HM.empty+    (\k m (Nullable v) -> maybe id (KM.insert (stringKeyOf k) . J.toJSON) v m)+    KM.empty  instance WrapForall Show h xs => Show (xs :/ h) where   showsPrec d (EmbedAt i h) = showParen (d > 10) $ showString "EmbedAt "     . showsPrec 11 i     . showString " "-    . views (pieceAt i) (\(Comp Dict) -> showsPrec 11 h) (library :: xs :& Comp Dict (Instance1 Show h))+    . views (pieceAt i) (\(Compose Dict) -> showsPrec 11 h) (library :: xs :& Compose Dict (Instance1 Show h))  instance WrapForall Eq h xs => Eq (xs :/ h) where   EmbedAt p g == EmbedAt q h = case compareMembership p q of     Left _ -> False-    Right Refl -> views (pieceAt p) (\(Comp Dict) -> g == h) (library :: xs :& Comp Dict (Instance1 Eq h))+    Right Refl -> views (pieceAt p) (\(Compose Dict) -> g == h) (library :: xs :& Compose Dict (Instance1 Eq h))   {-# INLINE (==) #-}  instance (Eq (xs :/ h), WrapForall Ord h xs) => Ord (xs :/ h) where   EmbedAt p g `compare` EmbedAt q h = case compareMembership p q of     Left x -> x-    Right Refl -> views (pieceAt p) (\(Comp Dict) -> compare g h) (library :: xs :& Comp Dict (Instance1 Ord h))+    Right Refl -> views (pieceAt p) (\(Compose Dict) -> compare g h) (library :: xs :& Compose Dict (Instance1 Ord h))   {-# INLINE compare #-}  instance WrapForall NFData h xs => NFData (xs :/ h) where-  rnf (EmbedAt i h) = views (pieceAt i) (\(Comp Dict) -> rnf h) (library :: xs :& Comp Dict (Instance1 NFData h))+  rnf (EmbedAt i h) = views (pieceAt i) (\(Compose Dict) -> rnf h) (library :: xs :& Compose Dict (Instance1 NFData h))   {-# INLINE rnf #-}  instance WrapForall Hashable h xs => Hashable (xs :/ h) where   hashWithSalt s (EmbedAt i h) = views (pieceAt i)-    (\(Comp Dict) -> s `hashWithSalt` i `hashWithSalt` h)-    (library :: xs :& Comp Dict (Instance1 Hashable h))+    (\(Compose Dict) -> s `hashWithSalt` i `hashWithSalt` h)+    (library :: xs :& Compose Dict (Instance1 Hashable h))   {-# INLINE hashWithSalt #-}  instance WrapForall TH.Lift h xs => TH.Lift (xs :/ h) where   lift (EmbedAt i h) = views (pieceAt i)-    (\(Comp Dict) -> conE 'EmbedAt `appE` TH.lift i `appE` TH.lift h)-    (library :: xs :& Comp Dict (Instance1 TH.Lift h))+    (\(Compose Dict) -> conE 'EmbedAt `appE` TH.lift i `appE` TH.lift h)+    (library :: xs :& Compose Dict (Instance1 TH.Lift h)) #if MIN_VERSION_template_haskell(2,17,0)   liftTyped e = TH.Code $ TH.TExp <$> TH.lift e+#elif MIN_VERSION_template_haskell(2,16,0)+  liftTyped e = TH.TExp <$> TH.lift e #endif  instance WrapForall Arbitrary h xs => Arbitrary (xs :/ h) where@@ -290,15 +286,15 @@         else r (i - 1))         (error "Impossible")   shrink (EmbedAt i h) = views (pieceAt i)-    (\(Comp Dict) -> EmbedAt i <$> shrink h)-    (library :: xs :& Comp Dict (Instance1 Arbitrary h))+    (\(Compose Dict) -> EmbedAt i <$> shrink h)+    (library :: xs :& Compose Dict (Instance1 Arbitrary h))  instance WrapForall Pretty h xs => Pretty (xs :/ h) where   pretty (EmbedAt i h) = "EmbedAt "     <> pretty i     <> " "-    <> views (pieceAt i) (\(Comp Dict) -> pretty h)-    (library :: xs :& Comp Dict (Instance1 Pretty h))+    <> views (pieceAt i) (\(Compose Dict) -> pretty h)+    (library :: xs :& Compose Dict (Instance1 Pretty h))  -- | Forall upon a wrapper type WrapForall c h = Forall (Instance1 c h)

@@ -62,11 +62,12 @@ import Data.Kind import Data.Profunctor.Unsafe import Data.Extensible.Wrapper+import Data.Functor.Compose import Data.Functor.Identity import Data.Hashable import Data.Incremental (Incremental) import Data.String-import Data.Text.Prettyprint.Doc+import Prettyprinter import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Unboxed as U@@ -287,7 +288,7 @@ --   <: #str \<\@=\> getLine --   <: nil -- @-(<@=>) :: (Functor f, Wrapper h) => FieldName k -> f (Repr h v) -> Comp f (Field h) (k ':> v)+(<@=>) :: (Functor f, Wrapper h) => FieldName k -> f (Repr h v) -> Compose f (Field h) (k ':> v) (<@=>) k = comp (k @=) {-# INLINE (<@=>) #-} infix 1 <@=>

@@ -31,12 +31,11 @@ import Data.Maybe (fromMaybe) import GHC.Generics (Generic) import Language.Haskell.TH.Lift-import Language.Haskell.TH (appE, conE) import Test.QuickCheck.Arbitrary  -- | Wrapped Maybe newtype Nullable h x = Nullable { getNullable :: Maybe (h x) }-  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Arbitrary, Hashable)+  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Arbitrary, Hashable, Lift)  instance Wrapper h => Wrapper (Nullable h) where   type Repr (Nullable h) x = Maybe (Repr h x)@@ -50,9 +49,6 @@ instance Semigroup (h x) => Monoid (Nullable h x) where   mempty = Nullable Nothing   mappend = (<>)--instance Lift (h a) => Lift (Nullable h a) where-  lift = appE (conE 'Nullable) . lift . getNullable  -- | Apply a function to its content. mapNullable :: (g x -> h y) -> Nullable g x -> Nullable h y

@@ -77,6 +77,7 @@ import Data.Extensible.Sum import Data.Extensible.Class import Data.Extensible.Wrapper+import Data.Functor.Compose import Data.Proxy import qualified Type.Membership.HList as HList @@ -221,24 +222,24 @@ -- @ -- htraverse (fmap f . g) ≡ fmap (hmap f) . htraverse g -- htraverse pure ≡ pure--- htraverse (Comp . fmap g . f) ≡ Comp . fmap (htraverse g) . htraverse f+-- htraverse (Compose . fmap g . f) ≡ Compose . fmap (htraverse g) . htraverse f -- @ htraverse :: Applicative f => (forall x. g x -> f (h x)) -> xs :& g -> f (xs :& h) htraverse f = fmap fromHList . HList.htraverse f . toHList {-# INLINE htraverse #-}  -- | 'sequence' analog for extensible products-hsequence :: Applicative f => xs :& Comp f h -> f (xs :& h)-hsequence = htraverse getComp+hsequence :: Applicative f => xs :& Compose f h -> f (xs :& h)+hsequence = htraverse getCompose {-# INLINE hsequence #-}  -- | The dual of 'htraverse'-hcollect :: (Functor f, Generate xs) => (a -> xs :& h) -> f a -> xs :& Comp f h-hcollect f m = htabulate $ \i -> Comp $ fmap (hlookup i . f) m+hcollect :: (Functor f, Generate xs) => (a -> xs :& h) -> f a -> xs :& Compose f h+hcollect f m = htabulate $ \i -> Compose $ fmap (hlookup i . f) m {-# INLINABLE hcollect #-}  -- | The dual of 'hsequence'-hdistribute :: (Functor f, Generate xs) => f (xs :& h) -> xs :& Comp f h+hdistribute :: (Functor f, Generate xs) => f (xs :& h) -> xs :& Compose f h hdistribute = hcollect id {-# INLINE hdistribute #-} @@ -320,8 +321,8 @@ {-# INLINE haccum #-}  -- | Group sums by type.-hpartition :: (Foldable f, Generate xs) => (a -> xs :/ h) -> f a -> xs :& Comp [] h-hpartition f = haccumMap f (\_ x (Comp xs) -> Comp (x:xs)) $ hrepeat $ Comp []+hpartition :: (Foldable f, Generate xs) => (a -> xs :/ h) -> f a -> xs :& Compose [] h+hpartition f = haccumMap f (\_ x (Compose xs) -> Compose (x:xs)) $ hrepeat $ Compose [] {-# INLINE hpartition #-}  -- | Evaluate every element in a product.

@@ -21,6 +21,7 @@ import Control.Applicative import Control.Monad.Trans.RWS.Strict import Control.Monad.Trans.Class+import Data.Functor.Compose import Data.Extensible.Class import Data.Extensible.Field import Data.Extensible.Product@@ -30,7 +31,7 @@  -- | @'TangleT' h xs m@ is the monad of computations that may depend on the elements in 'xs'. newtype TangleT xs h m a = TangleT-  { unTangleT :: RWST (xs :& Comp (TangleT xs h m) h) () (xs :& Nullable h) m a }+  { unTangleT :: RWST (xs :& Compose (TangleT xs h m) h) () (xs :& Nullable h) m a }   deriving (Functor, Applicative, Monad)  instance MonadTrans (TangleT xs h) where@@ -57,13 +58,13 @@     Just a -> return a     Nothing -> do       tangles <- ask-      a <- unTangleT $ getComp $ hlookup k tangles+      a <- unTangleT $ getCompose $ hlookup k tangles       modify $ over (pieceAt k) $ const $ Nullable $ Just a       return a  -- | Run a 'TangleT' action and return the result and the calculated values. runTangleT :: Monad m-  => xs :& Comp (TangleT xs h m) h+  => xs :& Compose (TangleT xs h m) h   -> xs :& Nullable h   -> TangleT xs h m a   -> m (a, xs :& Nullable h)@@ -73,7 +74,7 @@  -- | Run a 'TangleT' action. evalTangleT :: Monad m-  => xs :& Comp (TangleT xs h m) h+  => xs :& Compose (TangleT xs h m) h   -> xs :& Nullable h   -> TangleT xs h m a   -> m a@@ -82,7 +83,7 @@  -- | Run tangles and collect all the results as a 'Record'. runTangles :: Monad m-  => xs :& Comp (TangleT xs h m) h+  => xs :& Compose (TangleT xs h m) h   -> xs :& Nullable h   -> m (xs :& h) runTangles ts vs = evalTangleT ts vs $ htraverseWithIndex (const . hitchAt) vs

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveTraversable, StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Wrapper@@ -13,7 +14,9 @@ module Data.Extensible.Wrapper (   Wrapper(..)   , _WrapperAs-  , Comp(..)+  , type Comp+  , pattern Comp+  , getComp   , comp   , Prod(..)   ) where@@ -23,14 +26,12 @@ import Data.Typeable (Typeable) import Data.Proxy (Proxy(..)) import Data.Profunctor.Unsafe (Profunctor(..))+import Data.Functor.Compose import Data.Functor.Identity (Identity(..)) import Data.Extensible.Internal.Rig import Data.Hashable import Data.Kind (Type)-import Data.Text.Prettyprint.Doc import GHC.Generics (Generic)-import Language.Haskell.TH.Lift-import Language.Haskell.TH (conE, appE) import Test.QuickCheck.Arbitrary  @@ -83,25 +84,25 @@   type Repr [] a = [a]   _Wrapper = id --- | Poly-kinded composition-newtype Comp (f :: j -> Type) (g :: i -> j) (a :: i) = Comp { getComp :: f (g a) }-  deriving (Show, Eq, Ord, Typeable, NFData, Generic, Semigroup, Monoid, Arbitrary, Hashable, Pretty)+type Comp = Compose -deriving instance (Functor f, Functor g) => Functor (Comp f g)-deriving instance (Foldable f, Foldable g) => Foldable (Comp f g)-deriving instance (Traversable f, Traversable g) => Traversable (Comp f g)+pattern Comp :: f (g a) -> Compose f g a+pattern Comp a = Compose a+{-# DEPRECATED Comp "Use Compose instead" #-} -instance Lift (f (g a)) => Lift (Comp f g a) where-  lift = appE (conE 'Comp) . lift . getComp +getComp :: Compose f g a -> f (g a)+getComp = getCompose+{-# DEPRECATED getComp "Use getCompose instead" #-}+ -- | Wrap a result of 'fmap'-comp :: Functor f => (a -> g b) -> f a -> Comp f g b-comp f = Comp #. fmap f+comp :: Functor f => (a -> g b) -> f a -> Compose f g b+comp f = Compose #. fmap f {-# INLINE comp #-} -instance (Functor f, Wrapper g) => Wrapper (Comp f g) where-  type Repr (Comp f g) x = f (Repr g x)-  _Wrapper = withIso _Wrapper $ \f g -> dimap (fmap f .# getComp) (fmap (comp g))+instance (Functor f, Wrapper g) => Wrapper (Compose f g) where+  type Repr (Compose f g) x = f (Repr g x)+  _Wrapper = withIso _Wrapper $ \f g -> dimap (fmap f .# getCompose) (fmap (comp g))   {-# INLINE _Wrapper #-}  instance Wrapper (Const a) where