{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableSuperClasses, TypeInType #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Field
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
-- Flexible records and variants
------------------------------------------------------------------------
module Data.Extensible.Field (
  Field(..)
  , (@=)
  , (<@=>)
  , (@:>)
  , (@==)
  , FieldOptic
  , xlb
  , liftField
  , liftField2
  -- * Records and variants
  , RecordOf
  , Record
  , emptyRecord
  , VariantOf
  , Variant
  -- * Matching
  , matchWithField
  , matchField
  -- * Key / value
  , KeyOf
  , proxyKeyOf
  , stringKeyOf
  , TargetOf
  , proxyTargetOf
  , KeyIs
  , TargetIs
  , KeyTargetAre
  ) 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.Compose
import Data.Functor.Identity
import Data.Hashable
import Data.Incremental (Incremental)
import Data.String
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 Foreign.Storable (Storable)
import GHC.OverloadedLabels
import GHC.Generics (Generic)
import GHC.TypeLits hiding (Nat)
import Language.Haskell.TH.Lift
import Test.QuickCheck.Arbitrary
import Type.Membership

-- | A @'Field' h (k ':> v)@ is @h v@ annotated with the field name @k@.
--
-- @'Field' :: (v -> Type) -> Assoc k v -> Type@
--
newtype Field (h :: v -> Type) (kv :: Assoc k v)
  = Field { forall v k (h :: v -> Type) (kv :: Assoc k v).
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
$cfrom :: forall v (h :: v -> Type) k (kv :: Assoc k v) x.
Field h kv -> Rep (Field h kv) x
from :: forall 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
to :: forall x. Rep (Field h kv) x -> Field h kv
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 :: forall s. MVector s (Field h x) -> Int
basicLength (MV_Field MVector s (h (TargetOf x))
v) = MVector s (h (TargetOf x)) -> Int
forall s. 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 :: forall s.
Int -> Int -> MVector s (Field h x) -> MVector s (Field h x)
basicUnsafeSlice Int
i Int
n (MV_Field MVector s (h (TargetOf x))
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 s.
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 :: forall s. MVector s (Field h x) -> MVector s (Field h x) -> Bool
basicOverlaps (MV_Field MVector s (h (TargetOf x))
v1) (MV_Field MVector s (h (TargetOf x))
v2) = MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x)) -> Bool
forall s.
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 :: forall s. Int -> ST s (MVector s (Field h x))
basicUnsafeNew Int
n = 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))
-> ST s (MVector s (h (TargetOf x)))
-> ST s (MVector s (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s (h (TargetOf x)))
forall s. Int -> ST s (MVector s (h (TargetOf x)))
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
Int -> ST s (v s a)
M.basicUnsafeNew Int
n
#if MIN_VERSION_vector(0,11,0)
  basicInitialize :: forall s. MVector s (Field h x) -> ST s ()
basicInitialize (MV_Field MVector s (h (TargetOf x))
v) = MVector s (h (TargetOf x)) -> ST s ()
forall s. MVector s (h (TargetOf x)) -> ST s ()
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> ST s ()
M.basicInitialize MVector s (h (TargetOf x))
v
  {-# INLINE basicInitialize #-}
#endif
  basicUnsafeReplicate :: forall s. Int -> Field h x -> ST s (MVector s (Field h x))
basicUnsafeReplicate Int
n (Field h (TargetOf x)
x) = 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))
-> ST s (MVector s (h (TargetOf x)))
-> ST s (MVector s (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> h (TargetOf x) -> ST s (MVector s (h (TargetOf x)))
forall s.
Int -> h (TargetOf x) -> ST s (MVector s (h (TargetOf x)))
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
Int -> a -> ST s (v s a)
M.basicUnsafeReplicate Int
n h (TargetOf x)
x
  basicUnsafeRead :: forall s. MVector s (Field h x) -> Int -> ST s (Field h x)
basicUnsafeRead (MV_Field MVector s (h (TargetOf x))
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)
-> ST s (h (TargetOf x)) -> ST s (Field h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s (h (TargetOf x)) -> Int -> ST s (h (TargetOf x))
forall s.
MVector s (h (TargetOf x)) -> Int -> ST s (h (TargetOf x))
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> Int -> ST s a
M.basicUnsafeRead MVector s (h (TargetOf x))
v Int
i
  basicUnsafeWrite :: forall s. MVector s (Field h x) -> Int -> Field h x -> ST s ()
basicUnsafeWrite (MV_Field MVector s (h (TargetOf x))
v) Int
i (Field h (TargetOf x)
x) = MVector s (h (TargetOf x)) -> Int -> h (TargetOf x) -> ST s ()
forall s.
MVector s (h (TargetOf x)) -> Int -> h (TargetOf x) -> ST s ()
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
M.basicUnsafeWrite MVector s (h (TargetOf x))
v Int
i h (TargetOf x)
x
  basicClear :: forall s. MVector s (Field h x) -> ST s ()
basicClear (MV_Field MVector s (h (TargetOf x))
v) = MVector s (h (TargetOf x)) -> ST s ()
forall s. MVector s (h (TargetOf x)) -> ST s ()
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> ST s ()
M.basicClear MVector s (h (TargetOf x))
v
  basicSet :: forall s. MVector s (Field h x) -> Field h x -> ST s ()
basicSet (MV_Field MVector s (h (TargetOf x))
v) (Field h (TargetOf x)
x) = MVector s (h (TargetOf x)) -> h (TargetOf x) -> ST s ()
forall s. MVector s (h (TargetOf x)) -> h (TargetOf x) -> ST s ()
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> a -> ST s ()
M.basicSet MVector s (h (TargetOf x))
v h (TargetOf x)
x
  basicUnsafeCopy :: forall s. MVector s (Field h x) -> MVector s (Field h x) -> ST s ()
basicUnsafeCopy (MV_Field MVector s (h (TargetOf x))
v1) (MV_Field MVector s (h (TargetOf x))
v2) = MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x)) -> ST s ()
forall s.
MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x)) -> ST s ()
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> v s a -> ST s ()
M.basicUnsafeCopy MVector s (h (TargetOf x))
v1 MVector s (h (TargetOf x))
v2
  basicUnsafeMove :: forall s. MVector s (Field h x) -> MVector s (Field h x) -> ST s ()
basicUnsafeMove (MV_Field MVector s (h (TargetOf x))
v1) (MV_Field MVector s (h (TargetOf x))
v2) = MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x)) -> ST s ()
forall s.
MVector s (h (TargetOf x)) -> MVector s (h (TargetOf x)) -> ST s ()
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> v s a -> ST s ()
M.basicUnsafeMove MVector s (h (TargetOf x))
v1 MVector s (h (TargetOf x))
v2
  basicUnsafeGrow :: forall s.
MVector s (Field h x) -> Int -> ST s (MVector s (Field h x))
basicUnsafeGrow (MV_Field MVector s (h (TargetOf x))
v) Int
n = 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))
-> ST s (MVector s (h (TargetOf x)))
-> ST s (MVector s (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s (h (TargetOf x))
-> Int -> ST s (MVector s (h (TargetOf x)))
forall s.
MVector s (h (TargetOf x))
-> Int -> ST s (MVector s (h (TargetOf x)))
forall (v :: Type -> Type -> Type) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
M.basicUnsafeGrow MVector s (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 :: forall s. Mutable Vector s (Field h x) -> ST s (Vector (Field h x))
basicUnsafeFreeze (MV_Field MVector s (h (TargetOf x))
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))
-> ST s (Vector (h (TargetOf x))) -> ST s (Vector (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s (h (TargetOf x)) -> ST s (Vector (h (TargetOf x)))
forall s.
Mutable Vector s (h (TargetOf x)) -> ST s (Vector (h (TargetOf x)))
forall (v :: Type -> Type) a s.
Vector v a =>
Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze Mutable Vector s (h (TargetOf x))
MVector s (h (TargetOf x))
v
  basicUnsafeThaw :: forall s. Vector (Field h x) -> ST s (Mutable Vector s (Field h x))
basicUnsafeThaw (V_Field Vector (h (TargetOf x))
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))
-> ST s (MVector s (h (TargetOf x)))
-> ST s (MVector s (Field h x))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (h (TargetOf x)) -> ST s (Mutable Vector s (h (TargetOf x)))
forall s.
Vector (h (TargetOf x)) -> ST s (Mutable Vector s (h (TargetOf x)))
forall (v :: Type -> Type) a s.
Vector v a =>
v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector (h (TargetOf x))
v
  basicLength :: Vector (Field h x) -> Int
basicLength (V_Field Vector (h (TargetOf x))
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 Vector (h (TargetOf x))
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 -> Box (Field h x)
basicUnsafeIndexM (V_Field Vector (h (TargetOf x))
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)
-> Box (h (TargetOf x)) -> Box (Field h x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (h (TargetOf x)) -> Int -> Box (h (TargetOf x))
forall (v :: Type -> Type) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector (h (TargetOf x))
v Int
i
  basicUnsafeCopy :: forall s.
Mutable Vector s (Field h x) -> Vector (Field h x) -> ST s ()
basicUnsafeCopy (MV_Field MVector s (h (TargetOf x))
mv) (V_Field Vector (h (TargetOf x))
v) = Mutable Vector s (h (TargetOf x))
-> Vector (h (TargetOf x)) -> ST s ()
forall s.
Mutable Vector s (h (TargetOf x))
-> Vector (h (TargetOf x)) -> ST s ()
forall (v :: Type -> Type) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy Mutable Vector s (h (TargetOf x))
MVector s (h (TargetOf x))
mv Vector (h (TargetOf x))
v

instance (U.Unbox (h (TargetOf x))) => U.Unbox (Field h x)

-- | Lift a function for the content.
liftField :: (g (TargetOf kv) -> h (TargetOf kv)) -> Field g kv -> Field h kv
liftField :: forall {v} {k} (g :: v -> Type) (kv :: Assoc k v) (h :: v -> Type).
(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
forall a b. Coercible a b => a -> b
coerce
{-# INLINE liftField #-}

-- | Lift a function for the content.
liftField2 :: (f (TargetOf kv) -> g (TargetOf kv) -> h (TargetOf kv))
    -> Field f kv -> Field g kv -> Field h kv
liftField2 :: forall {v} {k} (f :: v -> Type) (kv :: Assoc k v) (g :: v -> Type)
       (h :: v -> Type).
(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
forall a b. Coercible a b => a -> b
coerce
{-# INLINE liftField2 #-}

instance Wrapper h => Wrapper (Field h) where
  type Repr (Field h) kv = Repr h (TargetOf kv)
  _Wrapper :: forall (f :: Type -> Type) (p :: Type -> Type -> Type)
       (v :: Assoc k v).
(Functor f, Profunctor p) =>
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 a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
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 k (h :: v -> Type) (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 a b. (a -> b) -> f a -> f b
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)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: v).
(Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper
  {-# INLINE _Wrapper #-}

-- | Shows in @field \@= value@ style instead of the derived one.
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)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: v).
(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 :: forall ann. 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 ann. h v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty h v
h (TargetOf (k ':> v))
a

-- | The type of records which contain several fields.
--
-- @RecordOf :: (v -> Type) -> [Assoc k v] -> Type@
--
type RecordOf h xs = xs :& Field h

-- | The dual of 'RecordOf'
--
-- @VariantOf :: (v -> Type) -> [Assoc k v] -> Type@
--
type VariantOf h xs = xs :/ Field h

-- | Simple record
type Record xs = RecordOf Identity xs

-- | Simple variant
type Variant xs = VariantOf Identity xs

-- | An empty 'Record'.
emptyRecord :: Record '[]
emptyRecord :: forall {k}. Record '[]
emptyRecord = '[] :& Field Identity
forall {k} (h :: k -> Type). '[] :& h
nil
{-# INLINE emptyRecord #-}

-- | Select a corresponding field of a variant.
matchWithField :: (forall x. f x -> g x -> r) -> RecordOf f xs -> VariantOf g xs -> r
matchWithField :: 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). f x -> g x -> r
h = (forall (x :: Assoc k v). Field f x -> Field g x -> r)
-> (xs :& Field f) -> (xs :/ Field g) -> 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 f (TargetOf x)
x) (Field g (TargetOf x)
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 #-}

-- | Pattern matching on a 'Variant'
matchField :: RecordOf (Match h r) xs -> VariantOf h xs -> r
matchField :: forall {v} {k} (h :: v -> Type) r (xs :: [Assoc k v]).
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 Match h r x -> h x -> r
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 #-}

-- | @FieldOptic s@ is a type of optics that points a field/constructor named @s@.
--
-- The yielding fields can be
-- <http://hackage.haskell.org/package/lens/docs/Control-Lens-Lens.html#t:Lens Lens>es
-- for 'Record's and
-- <http://hackage.haskell.org/package/lens/docs/Control-Lens-Lens.html#t:Prism Prism>s
-- for 'Variant's.
--
-- @
-- 'FieldOptic' "foo" = Lookup xs "foo" a => Lens' ('Record' xs) a
-- 'FieldOptic' "foo" = Lookup xs "foo" a => Prism' ('Variant' xs) a
-- @
--
-- 'FieldOptic's can be generated using 'mkField' defined in the "Data.Extensible.TH" module.
--
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
  , Wrapper h)
  => Optic' p f (t xs (Field h)) (Repr h v)

instance k ~ l => IsLabel k (Proxy l) where
  fromLabel :: Proxy l
fromLabel = Proxy l
forall {k} (t :: k). Proxy t
Proxy

-- | Specialised version of 'itemAssoc'. Stands for "eXtensible LaBel"
xlb :: Proxy k -> FieldOptic k
xlb :: forall {k} (k :: k). Proxy k -> FieldOptic k
xlb Proxy k
t = Proxy k -> Optic' p f (t xs (Field h)) (Repr (Field h) (k ':> v))
forall {k1} {v1} (h :: Assoc k1 v1 -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type)
       (t :: [Assoc k1 v1] -> (Assoc k1 v1 -> Type) -> Type)
       (xs :: [Assoc k1 v1]) (k2 :: k1) (v2 :: v1) (proxy :: k1 -> Type).
(Wrapper h, Extensible f p t, Lookup xs k2 v2,
 ExtensibleConstr t xs h (k2 ':> v2)) =>
proxy k2 -> Optic' p f (t xs h) (Repr h (k2 ':> v2))
itemAssoc Proxy k
t

-- | Annotate a value by the field name.
--
-- @
-- foo :: 'Record' '["num" >: Int, "str" >: String]
-- foo = #num \@= 42
--   <: #str \@= "foo"
--   <: nil
-- @
(@=) :: Wrapper h => Proxy k -> Repr h v -> Field h (k ':> v)
@= :: forall {v} {k} (h :: v -> Type) (k :: k) (v :: v).
Wrapper h =>
Proxy k -> Repr h v -> Field h (k ':> v)
(@=) Proxy k
_ = h v -> Field h (k ':> v)
h (TargetOf (k ':> 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 a b c (q :: Type -> Type -> Type).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: v).
(Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper
{-# INLINE (@=) #-}
infix 1 @=

-- | Lifted ('@=')
--
-- @
-- foo :: IO ('Record' '["num" >: Int, "str" >: String])
-- foo = hsequence
--   $ #num \<\@=\> readLn
--   <: #str \<\@=\> getLine
--   <: nil
-- @
(<@=>) :: (Functor f, Wrapper h) => Proxy k -> f (Repr h v) -> Compose f (Field h) (k ':> v)
<@=> :: forall {v} {k} (f :: Type -> Type) (h :: v -> Type) (k :: k)
       (v :: v).
(Functor f, Wrapper h) =>
Proxy k -> f (Repr h v) -> Compose f (Field h) (k ':> v)
(<@=>) Proxy k
k = (Repr h v -> Field h (k ':> v))
-> f (Repr h v) -> Compose f (Field h) (k ':> v)
forall {k1} (f :: Type -> Type) a (g :: k1 -> Type) (b :: k1).
Functor f =>
(a -> g b) -> f a -> Compose f g b
comp (Proxy k
k Proxy k -> Repr h v -> Field h (k ':> v)
forall {v} {k} (h :: v -> Type) (k :: k) (v :: v).
Wrapper h =>
Proxy k -> Repr h v -> Field h (k ':> v)
@=)
{-# INLINE (<@=>) #-}
infix 1 <@=>

-- | Annotate a value by the field name without 'Wrapper'.
(@:>) :: Proxy k -> h v -> Field h (k ':> v)
@:> :: forall {k} {v} (k :: k) (h :: v -> Type) (v :: v).
Proxy k -> h v -> Field h (k ':> v)
(@:>) Proxy k
_ = h v -> Field h (k ':> v)
h (TargetOf (k ':> v)) -> Field h (k ':> v)
forall v k (h :: v -> Type) (kv :: Assoc k v).
h (TargetOf kv) -> Field h kv
Field
infix 1 @:>

-- | Kind-monomorphic, unwrapped version of '@='
(@==) :: Proxy (k :: Symbol) -> v -> Field Identity (k ':> v)
@== :: forall (k :: Symbol) v. Proxy k -> v -> Field Identity (k ':> v)
(@==) = Proxy k -> v -> Field Identity (k ':> v)
Proxy k -> Repr Identity v -> Field Identity (k ':> v)
forall {v} {k} (h :: v -> Type) (k :: k) (v :: v).
Wrapper h =>
Proxy k -> Repr h v -> Field h (k ':> v)
(@=)
{-# INLINE (@==) #-}
infix 1 @==