{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{-|
Module      : Polytropos.Lens
Description : Comprehensive lens-suite integration for Polytropos open records and variants
Copyright   : (c) 2026 The Polytropos Authors
License     : EUPL-1.2 OR Apache-2.0
Maintainer  : nadia.yvette.chambers@ik.me
Stability   : experimental
Portability : non-portable (GHC extensions)

Complete integration with Edward Kmett's @lens@ library while keeping the
core @polytropos@ packages free of the heavyweight transitive dependency tree.

= Architectural Overview & Rationale

This module bridges @polytropos@ flat runtime representations to standard @lens@
abstractions:
* __Positional lenses__: 'Field1' through 'Field9' instances on product records,
  so @rec ^. _1@ and @rec ^. _2@ read the first and second slots by position in \(O(1)\).
* __Name-based lenses__: 'fieldLens' focuses on a field by label symbol with literal
  index calculation via @polytropos-plugin@.
* __Container classes__: 'Ixed' and 'At' instances keyed by field name for dynamic
  or symbol-indexed access.
* __Homogeneous traversals__: 'Each' instances over records whose fields share one
  type ('AllFieldsAre').
* __Variant prisms__: 'prismVariant' constructs first-class 'Prism'' optics for
  open variant constructors with \(O(1)\) tag matching.

= When to Use This Module

* When your codebase heavily utilizes the full @lens@ hierarchy (profunctor optics,
  indexed traversals, 'Field1'..'Field9').

= When Not to Use This Module

* If you only need lightweight lenses and want to minimize dependencies, use
  "Polytropos.Microlens" instead.
* If your codebase uses the newer @optics@ hierarchy, use "Polytropos.Optics" instead.

= Worked Example

> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE TypeApplications #-}
> {-# OPTIONS_GHC -fplugin=Polytropos.Plugin #-}
>
> import Control.Lens
> import Polytropos
> import Polytropos.Lens
>
> -- A genuinely heterogeneous record:
> type Person = Record '["name" ':= String, "age" ':= Int]
>
> person :: Person
> person = REC { name = "Bob", age = 25 }
>
> -- Positional heterogeneous access:
> firstField :: String
> firstField = person ^. _1  -- "Bob"
>
> -- Name-based heterogeneous access:
> ageVal :: Int
> ageVal = person ^. fieldLens (Field @"age")  -- 25
>
> -- Positional modification:
> olderPerson :: Person
> olderPerson = person & _2 .~ 26
>
> -- Name-based modification:
> olderPerson' :: Person
> olderPerson' = person & fieldLens (Field @"age") %~ (+ 1)
-}
module Polytropos.Lens
  ( -- * Field Lenses by Name
    fieldLens

    -- * Variant Prisms
  , prismVariant

    -- * Homogeneity Evidence and Row Introspection
  , AllFieldsAre
  , RowField
  , FieldNames (..)
  ) where

import Data.Functor.Identity (Identity (..))
import Data.Kind             (Constraint, Type)
import Data.List             (elemIndex)
import Data.Proxy            (Proxy (..))
import Data.Void             (Void)
import Control.Lens          (At (..), Each (..), Field1 (..), Field2 (..),
                              Field3 (..), Field4 (..), Field5 (..),
                              Field6 (..), Field7 (..), Field8 (..),
                              Field9 (..), Ixed (..), IxValue, Index, Lens',
                              Prism', preview, prism, set, (<&>))
import GHC.Exts              (toList)
import GHC.TypeLits          (KnownSymbol, symbolVal)
import Polytropos            (Record, Variant, Field (..), injectVariant)
import Polytropos.Core       (ConstructorIndex (..), FieldIndex (..), Pair (..),
                              Row, fieldAt, noInlineUnsafeCo, productRep,
                              projectRep, repVals, setFieldAt, RowRep (..))

{-------------------------------------------------------------------------------
  Row introspection
-------------------------------------------------------------------------------}

-- | The element type of a homogeneous row: the type of every field.
--
-- Undefined for @'[]@ (an empty record has no field type) and meaningless for
-- heterogeneous rows; both cases are ruled out where it matters by
-- 'AllFieldsAre'.
type family RowField (r :: Row) :: Type where
  RowField '[]                = Void
  RowField ((n ':= a) ': rest) = a

-- | Evidence that every field of the row @r@ has type @a@.
--
-- Closed type family, so a heterogeneous row fails to reduce and the
-- dependent instances simply do not apply.
type family AllFieldsAre (a :: Type) (r :: Row) :: Constraint where
  AllFieldsAre _  '[]                = ()
  AllFieldsAre a ((n ':= a) ': rest) = AllFieldsAre a rest

-- | The field names of a row, in row order, reified from the type level.
class FieldNames (r :: Row) where
  fieldNames :: Proxy r -> [String]

instance FieldNames '[] where
  fieldNames :: Proxy '[] -> [String]
fieldNames Proxy '[]
_ = []

instance (KnownSymbol n, FieldNames r) => FieldNames ((n ':= a) ': r) where
  fieldNames :: Proxy ((n ':= a) : r) -> [String]
fieldNames Proxy ((n ':= a) : r)
_ = Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @n) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Proxy r -> [String]
forall (r :: Row). FieldNames r => Proxy r -> [String]
fieldNames (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r)

{-------------------------------------------------------------------------------
  Slot plumbing (internal)
-------------------------------------------------------------------------------}

-- | Lens to the slot at index @i@. The caller must know that slot @i@ holds
-- a value of type @a@; every exported use site guarantees this from the row
-- type (a literal below the row's arity, a plugin-computed 'FieldIndex', or a
-- runtime name resolved against the reified row).
slotLens :: forall r a. Int -> Lens' (Record r) a
slotLens :: forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
i a -> f a
f (RowRep Rep Identity ()
rep) =
  (a -> RowRep Identity 'ProductRowT r ())
-> f a -> f (RowRep Identity 'ProductRowT r ())
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a' -> Rep Identity () -> RowRep Identity 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Int -> Identity Any -> Rep Identity () -> Rep Identity ()
forall {k} (f :: * -> *) (a :: k).
Int -> f Any -> Rep f a -> Rep f a
setFieldAt Int
i (Any -> Identity Any
forall a. a -> Identity a
Identity (a -> Any
forall a b. a -> b
noInlineUnsafeCo a
a')) Rep Identity ()
rep))
       (a -> f a
f (ZonkAny 1 -> a
forall a b. a -> b
noInlineUnsafeCo (Identity (ZonkAny 1) -> ZonkAny 1
forall a. Identity a -> a
runIdentity (Int -> Rep Identity () -> Identity (ZonkAny 1)
forall {k} (f :: * -> *) (a :: k) x. Int -> Rep f a -> f x
fieldAt Int
i Rep Identity ()
rep))))
{-# INLINE slotLens #-}

{-------------------------------------------------------------------------------
  Positional lenses: Field1 .. Field9
-------------------------------------------------------------------------------}

instance Field1 (Record ((n ':= a) ': r)) (Record ((n ':= a) ': r)) a a where
  _1 :: Lens (Record ((n ':= a) : r)) (Record ((n ':= a) : r)) a a
_1 = Int -> Lens (Record ((n ':= a) : r)) (Record ((n ':= a) : r)) a a
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
0

instance Field2 (Record ((n1 ':= a1) ': (n2 ':= a2) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': r)) a2 a2 where
  _2 :: Lens
  (Record ((n1 ':= a1) : (n2 ':= a2) : r))
  (Record ((n1 ':= a1) : (n2 ':= a2) : r))
  a2
  a2
_2 = Int
-> Lens
     (Record ((n1 ':= a1) : (n2 ':= a2) : r))
     (Record ((n1 ':= a1) : (n2 ':= a2) : r))
     a2
     a2
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
1

instance Field3 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': r)) a3 a3 where
  _3 :: Lens
  (Record ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : r))
  (Record ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : r))
  a3
  a3
_3 = Int
-> Lens
     (Record ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : r))
     (Record ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : r))
     a3
     a3
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
2

instance Field4 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': r)) a4 a4 where
  _4 :: Lens
  (Record
     ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : r))
  (Record
     ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : r))
  a4
  a4
_4 = Int
-> Lens
     (Record
        ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : r))
     (Record
        ((n1 ':= a1) : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : r))
     a4
     a4
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
3

instance Field5 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': r)) a5 a5 where
  _5 :: Lens
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5) : r))
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5) : r))
  a5
  a5
_5 = Int
-> Lens
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5) : r))
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5) : r))
     a5
     a5
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
4

instance Field6 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': r)) a6 a6 where
  _6 :: Lens
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : r))
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : r))
  a6
  a6
_6 = Int
-> Lens
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : r))
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : r))
     a6
     a6
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
5

instance Field7 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': (n7 ':= a7) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': (n7 ':= a7) ': r)) a7 a7 where
  _7 :: Lens
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : (n7 ':= a7) : r))
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : (n7 ':= a7) : r))
  a7
  a7
_7 = Int
-> Lens
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : (n7 ':= a7) : r))
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : (n7 ':= a7) : r))
     a7
     a7
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
6

instance Field8 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': (n7 ':= a7) ': (n8 ':= a8) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': (n7 ':= a7) ': (n8 ':= a8) ': r)) a8 a8 where
  _8 :: Lens
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : r))
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : r))
  a8
  a8
_8 = Int
-> Lens
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : r))
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : r))
     a8
     a8
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
7

instance Field9 (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': (n7 ':= a7) ': (n8 ':= a8) ': (n9 ':= a9) ': r))
                (Record ((n1 ':= a1) ': (n2 ':= a2) ': (n3 ':= a3) ': (n4 ':= a4) ': (n5 ':= a5) ': (n6 ':= a6) ': (n7 ':= a7) ': (n8 ':= a8) ': (n9 ':= a9) ': r)) a9 a9 where
  _9 :: Lens
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : (n9 ':= a9) : r))
  (Record
     ((n1 ':= a1)
        : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
        : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : (n9 ':= a9) : r))
  a9
  a9
_9 = Int
-> Lens
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : (n9 ':= a9) : r))
     (Record
        ((n1 ':= a1)
           : (n2 ':= a2) : (n3 ':= a3) : (n4 ':= a4) : (n5 ':= a5)
           : (n6 ':= a6) : (n7 ':= a7) : (n8 ':= a8) : (n9 ':= a9) : r))
     a9
     a9
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
8

{-------------------------------------------------------------------------------
  Homogeneous traversal: Each
-------------------------------------------------------------------------------}

-- | @each :: AllFieldsAre a r => Traversal (Record ((n ':= a) ': r)) ('Record' ((n ':= a) ': r)) a a@
--
-- The instance head fixes the element type to the row's field type, which is
-- what the @Each@ functional dependencies require: for a row-typed record the
-- row determines the field types, so a type-changing traversal is impossible
-- anyway. An empty record has no element type to traverse and deliberately
-- gets no instance.
instance AllFieldsAre a r
      => Each (Record ((n ':= a) ': r)) (Record ((n ':= a) ': r)) a a where
  each :: Traversal (Record ((n ':= a) : r)) (Record ((n ':= a) : r)) a a
each a -> f a
f (RowRep Rep Identity ()
rep) =
    Rep Identity () -> Record ((n ':= a) : r)
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Rep Identity () -> Record ((n ':= a) : r))
-> ([Identity a] -> Rep Identity ())
-> [Identity a]
-> Record ((n ':= a) : r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identity Any] -> Rep Identity ()
forall {k} (f :: * -> *) (a :: k). [f Any] -> Rep f a
productRep ([Identity Any] -> Rep Identity ())
-> ([Identity a] -> [Identity Any])
-> [Identity a]
-> Rep Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identity a] -> [Identity Any]
forall a b. a -> b
noInlineUnsafeCo
      ([Identity a] -> Record ((n ':= a) : r))
-> f [Identity a] -> f (Record ((n ':= a) : r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Identity Any -> f (Identity a))
-> [Identity Any] -> f [Identity a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Identity Any
x) -> a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> f a -> f (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f (Any -> a
forall a b. a -> b
noInlineUnsafeCo Any
x))
                   (SmallArray (Identity Any) -> [Item (SmallArray (Identity Any))]
forall l. IsList l => l -> [Item l]
toList (Rep Identity () -> SmallArray (Identity Any)
forall {k} (f :: * -> *) (a :: k). Rep f a -> SmallArray (f Any)
repVals Rep Identity ()
rep))
  {-# INLINE each #-}

{-------------------------------------------------------------------------------
  Container classes: Ixed and At, keyed by field name
-------------------------------------------------------------------------------}

-- | @ix :: String -> Traversal' (Record r) (RowField r)@
--
-- Field access by symbol name for /homogeneous/ records: the name is resolved
-- at runtime against the reified 'fieldNames' of the row, an @O(N)@ scan, and
-- a name that is not in the row gives the empty traversal. @'Index'
-- ('Record' r)@ is 'String' and @'IxValue' ('Record' r)@ is 'RowField' r.
--
-- Setting through 'ix' can only update existing fields: a record's shape is
-- fixed by its row, so addressing a name not in the row is a no-op.
type instance Index (Record r)   = String
type instance IxValue (Record r) = RowField r

instance (FieldNames r, AllFieldsAre (RowField r) r) => Ixed (Record r) where
  ix :: Index (Record r) -> Traversal' (Record r) (IxValue (Record r))
ix Index (Record r)
k IxValue (Record r) -> f (IxValue (Record r))
f Record r
rec = case String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
Index (Record r)
k (Proxy r -> [String]
forall (r :: Row). FieldNames r => Proxy r -> [String]
fieldNames (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r)) of
    Just Int
i  -> Int -> Lens' (Record r) (RowField r)
forall (r :: Row) a. Int -> Lens' (Record r) a
slotLens Int
i IxValue (Record r) -> f (IxValue (Record r))
RowField r -> f (RowField r)
f Record r
rec
    Maybe Int
Nothing -> Record r -> f (Record r)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Record r
rec

-- | @'at' :: 'String' -> 'Lens'' ('Record' r) ('Maybe' ('RowField' r))@
--
-- Map-style lookup and update by field name, defined in terms of 'ix'.
-- Viewing yields 'Just' exactly for names in the row. Setting @'Just' v@
-- updates the field when present; setting @'Nothing'@ (deletion) and
-- insertion of names not in the row are no-ops, because a record's shape is
-- fixed by its row — the same caveat @lens@ documents for fixed-size
-- containers, and the reason 'ix' (which cannot insert anyway) is the
-- preferred interface.
instance Ixed (Record r) => At (Record r) where
  at :: Index (Record r) -> Lens' (Record r) (Maybe (IxValue (Record r)))
at Index (Record r)
k Maybe (IxValue (Record r)) -> f (Maybe (IxValue (Record r)))
f Record r
rec = Maybe (IxValue (Record r)) -> f (Maybe (IxValue (Record r)))
f (Getting (First (RowField r)) (Record r) (RowField r)
-> Record r -> Maybe (RowField r)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Record r) -> Traversal' (Record r) (IxValue (Record r))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Record r)
k) Record r
rec) f (Maybe (RowField r))
-> (Maybe (RowField r) -> Record r) -> f (Record r)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe (RowField r)
mv -> case Maybe (RowField r)
mv of
    Just RowField r
v  -> ASetter (Record r) (Record r) (RowField r) (RowField r)
-> RowField r -> Record r -> Record r
forall s t a b. ASetter s t a b -> b -> s -> t
set (Index (Record r) -> Traversal' (Record r) (IxValue (Record r))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Record r)
k) RowField r
v Record r
rec
    Maybe (RowField r)
Nothing -> Record r
rec

{-------------------------------------------------------------------------------
  Name-based lens and variant prisms
-------------------------------------------------------------------------------}

-- | Lens on a record field by name.
--
-- @
-- 'fieldLens' #foo :: 'FieldIndex' "foo" r a => 'Lens'' ('Record' r) a
-- @
--
-- The 'FieldIndex' dictionary carries the slot index as a literal, computed
-- by the TcPlugin; there is no runtime name lookup and no type-level search.
fieldLens :: forall n r a. FieldIndex n r a => Field n -> Lens' (Record r) a
fieldLens :: forall (n :: Symbol) (r :: Row) a.
FieldIndex n r a =>
Field n -> Lens' (Record r) a
fieldLens Field n
_ a -> f a
f (RowRep Rep Identity ()
rep) =
  (a -> RowRep Identity 'ProductRowT r ())
-> f a -> f (RowRep Identity 'ProductRowT r ())
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a' -> Rep Identity () -> RowRep Identity 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Int -> Identity Any -> Rep Identity () -> Rep Identity ()
forall {k} (f :: * -> *) (a :: k).
Int -> f Any -> Rep f a -> Rep f a
setFieldAt (forall {kn} k {ka} (n :: kn) (row :: k) (a :: ka).
FieldIndex n row a =>
Int
forall k {ka} (n :: Symbol) (row :: k) (a :: ka).
FieldIndex n row a =>
Int
fieldIndex @_ @n @r @a)
                                  (Any -> Identity Any
forall a. a -> Identity a
Identity (a -> Any
forall a b. a -> b
noInlineUnsafeCo a
a'))
                                  Rep Identity ()
rep))
       (a -> f a
f (ZonkAny 0 -> a
forall a b. a -> b
noInlineUnsafeCo (Identity (ZonkAny 0) -> ZonkAny 0
forall a. Identity a -> a
runIdentity (Int -> Rep Identity () -> Identity (ZonkAny 0)
forall {k} (f :: * -> *) (a :: k) x. Int -> Rep f a -> f x
fieldAt (forall {kn} k {ka} (n :: kn) (row :: k) (a :: ka).
FieldIndex n row a =>
Int
forall k {ka} (n :: Symbol) (row :: k) (a :: ka).
FieldIndex n row a =>
Int
fieldIndex @_ @n @r @a) Rep Identity ()
rep))))
{-# INLINE fieldLens #-}

-- | Prism from a sum variant to the field record of one constructor.
--
-- @
-- 'prismVariant' (Field \@\"Some\") :: 'ConstructorIndex' \"Some\" s
--                                => 'Prism'' (t'Variant' s) ('Record' fs)
-- @
--
-- Built from 'Polytropos.injectVariant' and 'Polytropos.Core.projectRep': the
-- 'ConstructorIndex' dictionary carries the constructor's tag as a literal,
-- so matching is a single runtime tag comparison.
prismVariant :: forall c s fs. ConstructorIndex c s
             => Field c -> Prism' (Variant s) (Record fs)
prismVariant :: forall (c :: Symbol) (s :: SumRow) (fs :: Row).
ConstructorIndex c s =>
Field c -> Prism' (Variant s) (Record fs)
prismVariant Field c
f = (Record fs -> Variant s)
-> (Variant s -> Either (Variant s) (Record fs))
-> Prism (Variant s) (Variant s) (Record fs) (Record fs)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Field c -> Record fs -> Variant s
forall (n :: Symbol) (s :: SumRow) (fs :: Row).
ConstructorIndex n s =>
Field n -> Record fs -> Variant s
injectVariant Field c
f) Variant s -> Either (Variant s) (Record fs)
project
  where
    project :: Variant s -> Either (Variant s) (Record fs)
    project :: Variant s -> Either (Variant s) (Record fs)
project (RowRep Rep Identity ()
rep) =
      case Word -> Rep Identity () -> Maybe [Identity Any]
forall {k} (f :: * -> *) (a :: k). Word -> Rep f a -> Maybe [f Any]
projectRep (forall {kn} k (n :: kn) (row :: k). ConstructorIndex n row => Word
forall k (n :: Symbol) (row :: k). ConstructorIndex n row => Word
constructorIndex @_ @c @s) Rep Identity ()
rep of
        Just [Identity Any]
vals -> Record fs -> Either (Variant s) (Record fs)
forall a b. b -> Either a b
Right (Rep Identity () -> Record fs
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep ([Identity Any] -> Rep Identity ()
forall {k} (f :: * -> *) (a :: k). [f Any] -> Rep f a
productRep [Identity Any]
vals))
        Maybe [Identity Any]
Nothing   -> Variant s -> Either (Variant s) (Record fs)
forall a b. a -> Either a b
Left (Rep Identity () -> Variant s
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep Rep Identity ()
rep)