{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableSuperClasses, TypeInType #-}
module Data.Extensible.Field (
Field(..)
, (@=)
, (<@=>)
, (@:>)
, (@==)
, FieldOptic
, FieldName
, liftField
, liftField2
, RecordOf
, Record
, emptyRecord
, VariantOf
, Variant
, matchWithField
, matchField
, KeyOf
, proxyKeyOf
, stringKeyOf
, TargetOf
, proxyTargetOf
, KeyIs
, TargetIs
, KeyTargetAre
, LabelPhantom
, Labelling
, Inextensible
) where
import Control.DeepSeq (NFData)
import qualified Data.Aeson as J
import Data.Coerce
#ifdef CASSAVA
import qualified Data.Csv as Csv
#endif
import Data.Extensible.Class
import Data.Extensible.Sum
import Data.Extensible.Match
import Data.Extensible.Product
import Data.Extensible.Internal.Rig
import Data.Kind
import Data.Profunctor.Unsafe
import Data.Extensible.Wrapper
import Data.Functor.Identity
import Data.Hashable
import Data.Incremental (Incremental)
import Data.String
import Data.Text.Prettyprint.Doc
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Unboxed as U
import Foreign.Storable (Storable)
import GHC.Generics (Generic)
import GHC.TypeLits hiding (Nat)
import Language.Haskell.TH.Lift
import Test.QuickCheck.Arbitrary
import Type.Membership
newtype Field (h :: v -> Type) (kv :: Assoc k v)
= Field { Field h kv -> h (TargetOf kv)
getField :: h (TargetOf kv) }
deriving ((forall x. Field h kv -> Rep (Field h kv) x)
-> (forall x. Rep (Field h kv) x -> Field h kv)
-> Generic (Field h kv)
forall x. Rep (Field h kv) x -> Field h kv
forall x. Field h kv -> Rep (Field h kv) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v (h :: v -> Type) k (kv :: Assoc k v) x.
Rep (Field h kv) x -> Field h kv
forall v (h :: v -> Type) k (kv :: Assoc k v) x.
Field h kv -> Rep (Field h kv) x
$cto :: forall v (h :: v -> Type) k (kv :: Assoc k v) x.
Rep (Field h kv) x -> Field h kv
$cfrom :: forall v (h :: v -> Type) k (kv :: Assoc k v) x.
Field h kv -> Rep (Field h kv) x
Generic)
#define ND_Field(c) deriving instance c (h (TargetOf kv)) => c (Field h kv)
ND_Field(Eq)
ND_Field(Ord)
ND_Field(Num)
ND_Field(Integral)
ND_Field(Fractional)
ND_Field(Floating)
ND_Field(Real)
ND_Field(RealFloat)
ND_Field(RealFrac)
ND_Field(Semigroup)
ND_Field(Storable)
ND_Field(Monoid)
ND_Field(Enum)
ND_Field(Bounded)
ND_Field(NFData)
ND_Field(Arbitrary)
ND_Field(Hashable)
ND_Field(J.FromJSON)
ND_Field(J.ToJSON)
#ifdef CASSAVA
ND_Field(Csv.FromField)
ND_Field(Csv.ToField)
#endif
ND_Field(Incremental)
ND_Field(Lift)
newtype instance U.MVector s (Field h x) = MV_Field (U.MVector s (h (TargetOf x)))
newtype instance U.Vector (Field h x) = V_Field (U.Vector (h (TargetOf x)))
instance (U.Unbox (h (TargetOf x))) => M.MVector U.MVector (Field h x) where
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicOverlaps #-}
{-# INLINE basicUnsafeNew #-}
{-# INLINE basicUnsafeReplicate #-}
{-# INLINE basicUnsafeRead #-}
{-# INLINE basicUnsafeWrite #-}
{-# INLINE basicClear #-}
{-# INLINE basicSet #-}
{-# INLINE basicUnsafeCopy #-}
{-# INLINE basicUnsafeGrow #-}
basicLength :: MVector s (Field h x) -> Int
basicLength (MV_Field v) = MVector s (h (TargetOf x)) -> Int
forall (v :: Type -> Type -> Type) a s. MVector v a => v s a -> Int
M.basicLength MVector s (h (TargetOf x))
v
basicUnsafeSlice :: Int -> Int -> MVector s (Field h x) -> MVector s (Field h x)
basicUnsafeSlice Int
i Int
n (MV_Field v) = MVector s (h (TargetOf x)) -> MVector s (Field h x)
forall v k s (h :: v -> Type) (x :: Assoc k v).
MVector s (h (TargetOf x)) -> MVector s (Field h x)
MV_Field (MVector s (h (TargetOf x)) -> MVector s (Field h x))
-> MVector s (h (TargetOf x)) -> MVector s (Field h x)
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x))
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n MVector s (h (TargetOf x))
v
basicOverlaps :: MVector s (Field h x) -> MVector s (Field h x) -> Bool
basicOverlaps (MV_Field v1) (MV_Field v2) = MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x)) -> Bool
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s (h (TargetOf x))
v1 MVector s (h (TargetOf x))
v2
basicUnsafeNew :: Int -> m (MVector (PrimState m) (Field h x))
basicUnsafeNew Int
n = MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x)
forall v k s (h :: v -> Type) (x :: Assoc k v).
MVector s (h (TargetOf x)) -> MVector s (Field h x)
MV_Field (MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x))
-> m (MVector (PrimState m) (h (TargetOf x)))
-> m (MVector (PrimState m) (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) (h (TargetOf x)))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n
#if MIN_VERSION_vector(0,11,0)
basicInitialize :: MVector (PrimState m) (Field h x) -> m ()
basicInitialize (MV_Field v) = MVector (PrimState m) (h (TargetOf x)) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) (h (TargetOf x))
v
{-# INLINE basicInitialize #-}
#endif
basicUnsafeReplicate :: Int -> Field h x -> m (MVector (PrimState m) (Field h x))
basicUnsafeReplicate Int
n (Field h (TargetOf x)
x) = MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x)
forall v k s (h :: v -> Type) (x :: Assoc k v).
MVector s (h (TargetOf x)) -> MVector s (Field h x)
MV_Field (MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x))
-> m (MVector (PrimState m) (h (TargetOf x)))
-> m (MVector (PrimState m) (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> h (TargetOf x) -> m (MVector (PrimState m) (h (TargetOf x)))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n h (TargetOf x)
x
basicUnsafeRead :: MVector (PrimState m) (Field h x) -> Int -> m (Field h x)
basicUnsafeRead (MV_Field v) Int
i = h (TargetOf x) -> Field h x
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field (h (TargetOf x) -> Field h x)
-> m (h (TargetOf x)) -> m (Field h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (h (TargetOf x)) -> Int -> m (h (TargetOf x))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) (h (TargetOf x))
v Int
i
basicUnsafeWrite :: MVector (PrimState m) (Field h x) -> Int -> Field h x -> m ()
basicUnsafeWrite (MV_Field v) Int
i (Field h (TargetOf x)
x) = MVector (PrimState m) (h (TargetOf x))
-> Int -> h (TargetOf x) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) (h (TargetOf x))
v Int
i h (TargetOf x)
x
basicClear :: MVector (PrimState m) (Field h x) -> m ()
basicClear (MV_Field v) = MVector (PrimState m) (h (TargetOf x)) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) (h (TargetOf x))
v
basicSet :: MVector (PrimState m) (Field h x) -> Field h x -> m ()
basicSet (MV_Field v) (Field h (TargetOf x)
x) = MVector (PrimState m) (h (TargetOf x)) -> h (TargetOf x) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) (h (TargetOf x))
v h (TargetOf x)
x
basicUnsafeCopy :: MVector (PrimState m) (Field h x)
-> MVector (PrimState m) (Field h x) -> m ()
basicUnsafeCopy (MV_Field v1) (MV_Field v2) = MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (h (TargetOf x)) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) (h (TargetOf x))
v1 MVector (PrimState m) (h (TargetOf x))
v2
basicUnsafeMove :: MVector (PrimState m) (Field h x)
-> MVector (PrimState m) (Field h x) -> m ()
basicUnsafeMove (MV_Field v1) (MV_Field v2) = MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (h (TargetOf x)) -> m ()
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) (h (TargetOf x))
v1 MVector (PrimState m) (h (TargetOf x))
v2
basicUnsafeGrow :: MVector (PrimState m) (Field h x)
-> Int -> m (MVector (PrimState m) (Field h x))
basicUnsafeGrow (MV_Field v) Int
n = MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x)
forall v k s (h :: v -> Type) (x :: Assoc k v).
MVector s (h (TargetOf x)) -> MVector s (Field h x)
MV_Field (MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x))
-> m (MVector (PrimState m) (h (TargetOf x)))
-> m (MVector (PrimState m) (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (h (TargetOf x))
-> Int -> m (MVector (PrimState m) (h (TargetOf x)))
forall (v :: Type -> Type -> Type) a (m :: Type -> Type).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) (h (TargetOf x))
v Int
n
instance (U.Unbox (h (TargetOf x))) => G.Vector U.Vector (Field h x) where
{-# INLINE basicUnsafeFreeze #-}
{-# INLINE basicUnsafeThaw #-}
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicUnsafeIndexM #-}
basicUnsafeFreeze :: Mutable Vector (PrimState m) (Field h x) -> m (Vector (Field h x))
basicUnsafeFreeze (MV_Field v) = Vector (h (TargetOf x)) -> Vector (Field h x)
forall v k (h :: v -> Type) (x :: Assoc k v).
Vector (h (TargetOf x)) -> Vector (Field h x)
V_Field (Vector (h (TargetOf x)) -> Vector (Field h x))
-> m (Vector (h (TargetOf x))) -> m (Vector (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) (h (TargetOf x))
-> m (Vector (h (TargetOf x)))
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) (h (TargetOf x))
Mutable Vector (PrimState m) (h (TargetOf x))
v
basicUnsafeThaw :: Vector (Field h x) -> m (Mutable Vector (PrimState m) (Field h x))
basicUnsafeThaw (V_Field v) = MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x)
forall v k s (h :: v -> Type) (x :: Assoc k v).
MVector s (h (TargetOf x)) -> MVector s (Field h x)
MV_Field (MVector (PrimState m) (h (TargetOf x))
-> MVector (PrimState m) (Field h x))
-> m (MVector (PrimState m) (h (TargetOf x)))
-> m (MVector (PrimState m) (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (h (TargetOf x))
-> m (Mutable Vector (PrimState m) (h (TargetOf x)))
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector (h (TargetOf x))
v
basicLength :: Vector (Field h x) -> Int
basicLength (V_Field v) = Vector (h (TargetOf x)) -> Int
forall (v :: Type -> Type) a. Vector v a => v a -> Int
G.basicLength Vector (h (TargetOf x))
v
basicUnsafeSlice :: Int -> Int -> Vector (Field h x) -> Vector (Field h x)
basicUnsafeSlice Int
i Int
n (V_Field v) = Vector (h (TargetOf x)) -> Vector (Field h x)
forall v k (h :: v -> Type) (x :: Assoc k v).
Vector (h (TargetOf x)) -> Vector (Field h x)
V_Field (Vector (h (TargetOf x)) -> Vector (Field h x))
-> Vector (h (TargetOf x)) -> Vector (Field h x)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (h (TargetOf x)) -> Vector (h (TargetOf x))
forall (v :: Type -> Type) a.
Vector v a =>
Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n Vector (h (TargetOf x))
v
basicUnsafeIndexM :: Vector (Field h x) -> Int -> m (Field h x)
basicUnsafeIndexM (V_Field v) Int
i = h (TargetOf x) -> Field h x
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field (h (TargetOf x) -> Field h x)
-> m (h (TargetOf x)) -> m (Field h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (h (TargetOf x)) -> Int -> m (h (TargetOf x))
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector (h (TargetOf x))
v Int
i
basicUnsafeCopy :: Mutable Vector (PrimState m) (Field h x)
-> Vector (Field h x) -> m ()
basicUnsafeCopy (MV_Field mv) (V_Field v) = Mutable Vector (PrimState m) (h (TargetOf x))
-> Vector (h (TargetOf x)) -> m ()
forall (v :: Type -> Type) a (m :: Type -> Type).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) (h (TargetOf x))
Mutable Vector (PrimState m) (h (TargetOf x))
mv Vector (h (TargetOf x))
v
instance (U.Unbox (h (TargetOf x))) => U.Unbox (Field h x)
liftField :: (g (TargetOf kv) -> h (TargetOf kv)) -> Field g kv -> Field h kv
liftField :: (g (TargetOf kv) -> h (TargetOf kv)) -> Field g kv -> Field h kv
liftField = (g (TargetOf kv) -> h (TargetOf kv)) -> Field g kv -> Field h kv
coerce
{-# INLINE liftField #-}
liftField2 :: (f (TargetOf kv) -> g (TargetOf kv) -> h (TargetOf kv))
-> Field f kv -> Field g kv -> Field h kv
liftField2 :: (f (TargetOf kv) -> g (TargetOf kv) -> h (TargetOf kv))
-> Field f kv -> Field g kv -> Field h kv
liftField2 = (f (TargetOf kv) -> g (TargetOf kv) -> h (TargetOf kv))
-> Field f kv -> Field g kv -> Field h kv
coerce
{-# INLINE liftField2 #-}
instance Wrapper h => Wrapper (Field h) where
type Repr (Field h) kv = Repr h (TargetOf kv)
_Wrapper :: Optic' p f (Field h v) (Repr (Field h) v)
_Wrapper = (Field h v -> h (TargetOf v))
-> (f (h (TargetOf v)) -> f (Field h v))
-> p (h (TargetOf v)) (f (h (TargetOf v)))
-> p (Field h v) (f (Field h v))
forall (p :: Type -> Type -> Type) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Field h v -> h (TargetOf v)
forall v (h :: v -> Type) k (kv :: Assoc k v).
Field h kv -> h (TargetOf kv)
getField ((h (TargetOf v) -> Field h v)
-> f (h (TargetOf v)) -> f (Field h v)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap h (TargetOf v) -> Field h v
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field) (p (h (TargetOf v)) (f (h (TargetOf v)))
-> p (Field h v) (f (Field h v)))
-> (p (Repr h (TargetOf v)) (f (Repr h (TargetOf v)))
-> p (h (TargetOf v)) (f (h (TargetOf v))))
-> p (Repr h (TargetOf v)) (f (Repr h (TargetOf v)))
-> p (Field h v) (f (Field h v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Repr h (TargetOf v)) (f (Repr h (TargetOf v)))
-> p (h (TargetOf v)) (f (h (TargetOf v)))
forall k (h :: k -> Type) (f :: Type -> Type)
(p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper
{-# INLINE _Wrapper #-}
instance (KnownSymbol k, Wrapper h, Show (Repr h v)) => Show (Field h (k ':> v)) where
showsPrec :: Int -> Field h (k ':> v) -> ShowS
showsPrec Int
d (Field h (TargetOf (k ':> v))
a) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy k
forall k (t :: k). Proxy t
Proxy :: Proxy k))
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" @= "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Repr h v -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 (Optic' (->) (Const (Repr h v)) (h v) (Repr h v) -> h v -> Repr h v
forall a s. Optic' (->) (Const a) s a -> s -> a
view Optic' (->) (Const (Repr h v)) (h v) (Repr h v)
forall k (h :: k -> Type) (f :: Type -> Type)
(p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper h v
h (TargetOf (k ':> v))
a)
instance (KnownSymbol k, Pretty (h v)) => Pretty (Field h (k ':> v)) where
pretty :: Field h (k ':> v) -> Doc ann
pretty (Field h (TargetOf (k ':> v))
a) = String -> Doc ann
forall a. IsString a => String -> a
fromString (Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy k
forall k (t :: k). Proxy t
Proxy :: Proxy k))
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": "
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> h v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty h v
h (TargetOf (k ':> v))
a
type RecordOf h xs = xs :& Field h
type VariantOf h xs = xs :/ Field h
type Record xs = RecordOf Identity xs
type Variant xs = VariantOf Identity xs
emptyRecord :: Record '[]
emptyRecord :: Record '[]
emptyRecord = Record '[]
forall k (h :: k -> Type). '[] :& h
nil
{-# INLINE emptyRecord #-}
matchWithField :: (forall x. f x -> g x -> r) -> RecordOf f xs -> VariantOf g xs -> r
matchWithField :: (forall (x :: v). f x -> g x -> r)
-> RecordOf f xs -> VariantOf g xs -> r
matchWithField forall (x :: v). f x -> g x -> r
h = (forall (x :: Assoc k v). Field f x -> Field g x -> r)
-> RecordOf f xs -> VariantOf g xs -> r
forall k (f :: k -> Type) (g :: k -> Type) r (xs :: [k]).
(forall (x :: k). f x -> g x -> r) -> (xs :& f) -> (xs :/ g) -> r
matchWith (\(Field x) (Field y) -> f (TargetOf x) -> g (TargetOf x) -> r
forall (x :: v). f x -> g x -> r
h f (TargetOf x)
x g (TargetOf x)
y)
{-# INLINE matchWithField #-}
matchField :: RecordOf (Match h r) xs -> VariantOf h xs -> r
matchField :: RecordOf (Match h r) xs -> VariantOf h xs -> r
matchField = (forall (x :: v). Match h r x -> h x -> r)
-> RecordOf (Match h r) xs -> VariantOf h xs -> r
forall v k (f :: v -> Type) (g :: v -> Type) r (xs :: [Assoc k v]).
(forall (x :: v). f x -> g x -> r)
-> RecordOf f xs -> VariantOf g xs -> r
matchWithField forall (x :: v). Match h r x -> h x -> r
forall k (h :: k -> Type) r (x :: k). Match h r x -> h x -> r
runMatch
{-# INLINE matchField #-}
type FieldOptic k = forall kind. forall f p t xs (h :: kind -> Type) (v :: kind).
(Extensible f p t
, ExtensibleConstr t xs (Field h) (k ':> v)
, Lookup xs k v
, Labelling k p
, Wrapper h)
=> Optic' p f (t xs (Field h)) (Repr h v)
data Inextensible (xs :: [k]) (h :: k -> Type)
instance (Functor f, Profunctor p) => Extensible f p Inextensible where
pieceAt :: Membership xs x -> Optic' p f (Inextensible xs h) (h x)
pieceAt Membership xs x
_ p (h x) (f (h x))
_ = String -> p (Inextensible xs h) (f (Inextensible xs h))
forall a. HasCallStack => String -> a
error String
"Impossible"
type FieldName k = Optic' (LabelPhantom k) Proxy (Inextensible '[k ':> ()] (Field Proxy)) ()
type family Labelling s p :: Constraint where
Labelling s (LabelPhantom t) = s ~ t
Labelling s p = ()
data LabelPhantom s a b
instance Profunctor (LabelPhantom s) where
dimap :: (a -> b) -> (c -> d) -> LabelPhantom s b c -> LabelPhantom s a d
dimap a -> b
_ c -> d
_ LabelPhantom s b c
_ = String -> LabelPhantom s a d
forall a. HasCallStack => String -> a
error String
"Impossible"
(@=) :: Wrapper h => FieldName k -> Repr h v -> Field h (k ':> v)
@= :: FieldName k -> Repr h v -> Field h (k ':> v)
(@=) FieldName k
_ = h v -> Field h (k ':> v)
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field (h v -> Field h (k ':> v))
-> (Repr h v -> h v) -> Repr h v -> Field h (k ':> v)
forall (p :: Type -> Type -> Type) a b c
(q :: Type -> Type -> Type).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Optic' Tagged Identity (h v) (Repr h v) -> Repr h v -> h v
forall s a. Optic' Tagged Identity s a -> a -> s
review Optic' Tagged Identity (h v) (Repr h v)
forall k (h :: k -> Type) (f :: Type -> Type)
(p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper
{-# INLINE (@=) #-}
infix 1 @=
(<@=>) :: (Functor f, Wrapper h) => FieldName k -> f (Repr h v) -> Comp f (Field h) (k ':> v)
<@=> :: FieldName k -> f (Repr h v) -> Comp f (Field h) (k ':> v)
(<@=>) FieldName k
k = (Repr h v -> Field h (k ':> v))
-> f (Repr h v) -> Comp f (Field h) (k ':> v)
forall i (f :: Type -> Type) a (g :: i -> Type) (b :: i).
Functor f =>
(a -> g b) -> f a -> Comp f g b
comp (FieldName k
k FieldName k -> Repr h v -> Field h (k ':> v)
forall v k (h :: v -> Type) (k :: k) (v :: v).
Wrapper h =>
FieldName k -> Repr h v -> Field h (k ':> v)
@=)
{-# INLINE (<@=>) #-}
infix 1 <@=>
(@:>) :: FieldName k -> h v -> Field h (k ':> v)
@:> :: FieldName k -> h v -> Field h (k ':> v)
(@:>) FieldName k
_ = h v -> Field h (k ':> v)
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field
infix 1 @:>
(@==) :: FieldName (k :: Symbol) -> v -> Field Identity (k ':> v)
@== :: FieldName k -> v -> Field Identity (k ':> v)
(@==) = FieldName k -> v -> Field Identity (k ':> v)
forall v k (h :: v -> Type) (k :: k) (v :: v).
Wrapper h =>
FieldName k -> Repr h v -> Field h (k ':> v)
(@=)
{-# INLINE (@==) #-}
infix 1 @==