-- | Row types

{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts, TemplateHaskell #-}

module Hyper.Type.AST.Row
    ( RowConstraints(..), RowKey
    , RowExtend(..), eKey, eVal, eRest, W_RowExtend(..)
    , FlatRowExtends(..), freExtends, freRest, W_FlatRowExtends(..)
    , MorphWitness(..)
    , flattenRow, flattenRowExtend, unflattenRow
    , verifyRowExtendConstraints, rowExtendStructureMismatch
    , rowElementInfer
    ) where

import           Control.Lens (Prism', Lens', contains)
import qualified Control.Lens as Lens
import           Control.Monad (foldM)
import qualified Data.Map as Map
import           Generics.Constraints (Constraints, makeDerivings, makeInstances)
import           Hyper
import           Hyper.Unify
import           Hyper.Unify.New (newTerm, newUnbound)
import           Hyper.Unify.Term (UTerm(..), _UTerm, UTermBody(..), uBody)
import           Text.Show.Combinators ((@|), showCon)

import           Hyper.Internal.Prelude

class
    (Ord (RowConstraintsKey constraints), TypeConstraints constraints) =>
    RowConstraints constraints where

    type RowConstraintsKey constraints
    forbidden :: Lens' constraints (Set (RowConstraintsKey constraints))

type RowKey typ = RowConstraintsKey (TypeConstraintsOf typ)

-- | Row-extend primitive for use in both value-level and type-level
data RowExtend key val rest h = RowExtend
    { RowExtend key val rest h -> key
_eKey :: key
    , RowExtend key val rest h -> h :# val
_eVal :: h :# val
    , RowExtend key val rest h -> h :# rest
_eRest :: h :# rest
    } deriving (forall x.
 RowExtend key val rest h -> Rep (RowExtend key val rest h) x)
-> (forall x.
    Rep (RowExtend key val rest h) x -> RowExtend key val rest h)
-> Generic (RowExtend key val rest h)
forall x.
Rep (RowExtend key val rest h) x -> RowExtend key val rest h
forall x.
RowExtend key val rest h -> Rep (RowExtend key val rest h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
Rep (RowExtend key val rest h) x -> RowExtend key val rest h
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
RowExtend key val rest h -> Rep (RowExtend key val rest h) x
$cto :: forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
Rep (RowExtend key val rest h) x -> RowExtend key val rest h
$cfrom :: forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
RowExtend key val rest h -> Rep (RowExtend key val rest h) x
Generic

data FlatRowExtends key val rest h = FlatRowExtends
    { FlatRowExtends key val rest h -> Map key (h :# val)
_freExtends :: Map key (h :# val)
    , FlatRowExtends key val rest h -> h :# rest
_freRest :: h :# rest
    } deriving (forall x.
 FlatRowExtends key val rest h
 -> Rep (FlatRowExtends key val rest h) x)
-> (forall x.
    Rep (FlatRowExtends key val rest h) x
    -> FlatRowExtends key val rest h)
-> Generic (FlatRowExtends key val rest h)
forall x.
Rep (FlatRowExtends key val rest h) x
-> FlatRowExtends key val rest h
forall x.
FlatRowExtends key val rest h
-> Rep (FlatRowExtends key val rest h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
Rep (FlatRowExtends key val rest h) x
-> FlatRowExtends key val rest h
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
FlatRowExtends key val rest h
-> Rep (FlatRowExtends key val rest h) x
$cto :: forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
Rep (FlatRowExtends key val rest h) x
-> FlatRowExtends key val rest h
$cfrom :: forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       x.
FlatRowExtends key val rest h
-> Rep (FlatRowExtends key val rest h) x
Generic

makeLenses ''RowExtend
makeLenses ''FlatRowExtends
makeCommonInstances [''FlatRowExtends]
makeZipMatch ''RowExtend
makeHContext ''RowExtend
makeHMorph ''RowExtend
makeHTraversableApplyAndBases ''RowExtend
makeHTraversableApplyAndBases ''FlatRowExtends
makeDerivings [''Eq, ''Ord] [''RowExtend]
makeInstances [''Binary, ''NFData] [''RowExtend]

instance
    Constraints (RowExtend key val rest h) Show =>
    Show (RowExtend key val rest h) where
    showsPrec :: Int -> RowExtend key val rest h -> ShowS
showsPrec Int
p (RowExtend key
h h :# val
v h :# rest
r) = (String -> PrecShowS
showCon String
"RowExtend" PrecShowS -> key -> PrecShowS
forall a. Show a => PrecShowS -> a -> PrecShowS
@| key
h PrecShowS -> (h :# val) -> PrecShowS
forall a. Show a => PrecShowS -> a -> PrecShowS
@| h :# val
v PrecShowS -> (h :# rest) -> PrecShowS
forall a. Show a => PrecShowS -> a -> PrecShowS
@| h :# rest
r) Int
p

{-# INLINE flattenRowExtend #-}
flattenRowExtend ::
    (Ord key, Monad m) =>
    (v # rest -> m (Maybe (RowExtend key val rest # v))) ->
    RowExtend key val rest # v ->
    m (FlatRowExtends key val rest # v)
flattenRowExtend :: ((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (RowExtend key val rest # v)
-> m (FlatRowExtends key val rest # v)
flattenRowExtend (v # rest) -> m (Maybe (RowExtend key val rest # v))
nextExtend (RowExtend key
h 'AHyperType v :# val
v 'AHyperType v :# rest
rest) =
    ((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (v # rest) -> m (FlatRowExtends key val rest # v)
forall key (m :: * -> *) (v :: HyperType) (rest :: HyperType)
       (val :: HyperType).
(Ord key, Monad m) =>
((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (v # rest) -> m (FlatRowExtends key val rest # v)
flattenRow (v # rest) -> m (Maybe (RowExtend key val rest # v))
nextExtend v # rest
'AHyperType v :# rest
rest
    m (FlatRowExtends key val rest # v)
-> ((FlatRowExtends key val rest # v)
    -> FlatRowExtends key val rest # v)
-> m (FlatRowExtends key val rest # v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Map key (v ('AHyperType val))
 -> Identity (Map key (v ('AHyperType val))))
-> (FlatRowExtends key val rest # v)
-> Identity (FlatRowExtends key val rest # v)
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       key (val :: HyperType).
Lens
  (FlatRowExtends key val rest h)
  (FlatRowExtends key val rest h)
  (Map key (h :# val))
  (Map key (h :# val))
freExtends ((Map key (v ('AHyperType val))
  -> Identity (Map key (v ('AHyperType val))))
 -> (FlatRowExtends key val rest # v)
 -> Identity (FlatRowExtends key val rest # v))
-> (Map key (v ('AHyperType val)) -> Map key (v ('AHyperType val)))
-> (FlatRowExtends key val rest # v)
-> FlatRowExtends key val rest # v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (v ('AHyperType val) -> v ('AHyperType val) -> v ('AHyperType val))
-> Map key (v ('AHyperType val))
-> Map key (v ('AHyperType val))
-> Map key (v ('AHyperType val))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (String
-> v ('AHyperType val)
-> v ('AHyperType val)
-> v ('AHyperType val)
forall a. HasCallStack => String -> a
error String
"Colliding keys") (key -> v ('AHyperType val) -> Map key (v ('AHyperType val))
forall k a. k -> a -> Map k a
Map.singleton key
h v ('AHyperType val)
'AHyperType v :# val
v)

{-# INLINE flattenRow #-}
flattenRow ::
    (Ord key, Monad m) =>
    (v # rest -> m (Maybe (RowExtend key val rest # v))) ->
    v # rest ->
    m (FlatRowExtends key val rest # v)
flattenRow :: ((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (v # rest) -> m (FlatRowExtends key val rest # v)
flattenRow (v # rest) -> m (Maybe (RowExtend key val rest # v))
nextExtend v # rest
x =
    (v # rest) -> m (Maybe (RowExtend key val rest # v))
nextExtend v # rest
x
    m (Maybe (RowExtend key val rest # v))
-> (Maybe (RowExtend key val rest # v)
    -> m (FlatRowExtends key val rest # v))
-> m (FlatRowExtends key val rest # v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (FlatRowExtends key val rest # v)
-> ((RowExtend key val rest # v)
    -> m (FlatRowExtends key val rest # v))
-> Maybe (RowExtend key val rest # v)
-> m (FlatRowExtends key val rest # v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((FlatRowExtends key val rest # v)
-> m (FlatRowExtends key val rest # v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map key ('AHyperType v :# val)
-> ('AHyperType v :# rest) -> FlatRowExtends key val rest # v
forall key (val :: HyperType) (rest :: HyperType)
       (h :: AHyperType).
Map key (h :# val) -> (h :# rest) -> FlatRowExtends key val rest h
FlatRowExtends Map key ('AHyperType v :# val)
forall a. Monoid a => a
mempty v # rest
'AHyperType v :# rest
x)) (((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (RowExtend key val rest # v)
-> m (FlatRowExtends key val rest # v)
forall key (m :: * -> *) (v :: HyperType) (rest :: HyperType)
       (val :: HyperType).
(Ord key, Monad m) =>
((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (RowExtend key val rest # v)
-> m (FlatRowExtends key val rest # v)
flattenRowExtend (v # rest) -> m (Maybe (RowExtend key val rest # v))
nextExtend)

{-# INLINE unflattenRow #-}
unflattenRow ::
    Monad m =>
    (RowExtend key val rest # v -> m (v # rest)) ->
    FlatRowExtends key val rest # v -> m (v # rest)
unflattenRow :: ((RowExtend key val rest # v) -> m (v # rest))
-> (FlatRowExtends key val rest # v) -> m (v # rest)
unflattenRow (RowExtend key val rest # v) -> m (v # rest)
mkExtend (FlatRowExtends Map key ('AHyperType v :# val)
fields 'AHyperType v :# rest
rest) =
    Map key (v ('AHyperType val))
Map key ('AHyperType v :# val)
fields Map key (v ('AHyperType val))
-> IndexedGetting
     key
     (Endo [(key, v ('AHyperType val))])
     (Map key (v ('AHyperType val)))
     (v ('AHyperType val))
-> [(key, v ('AHyperType val))]
forall s i a. s -> IndexedGetting i (Endo [(i, a)]) s a -> [(i, a)]
^@.. IndexedGetting
  key
  (Endo [(key, v ('AHyperType val))])
  (Map key (v ('AHyperType val)))
  (v ('AHyperType val))
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
Lens.itraversed [(key, v ('AHyperType val))]
-> ([(key, v ('AHyperType val))] -> m (v # rest)) -> m (v # rest)
forall a b. a -> (a -> b) -> b
& ((v # rest) -> (key, v ('AHyperType val)) -> m (v # rest))
-> (v # rest) -> [(key, v ('AHyperType val))] -> m (v # rest)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (v # rest) -> (key, v ('AHyperType val)) -> m (v # rest)
f v # rest
'AHyperType v :# rest
rest
    where
        f :: (v # rest) -> (key, v ('AHyperType val)) -> m (v # rest)
f v # rest
acc (key
key, v ('AHyperType val)
val) = key
-> ('AHyperType v :# val)
-> ('AHyperType v :# rest)
-> RowExtend key val rest # v
forall key (val :: HyperType) (rest :: HyperType)
       (h :: AHyperType).
key -> (h :# val) -> (h :# rest) -> RowExtend key val rest h
RowExtend key
key v ('AHyperType val)
'AHyperType v :# val
val v # rest
'AHyperType v :# rest
acc (RowExtend key val rest # v)
-> ((RowExtend key val rest # v) -> m (v # rest)) -> m (v # rest)
forall a b. a -> (a -> b) -> b
& (RowExtend key val rest # v) -> m (v # rest)
mkExtend

-- Helpers for Unify instances of type-level RowExtends:

{-# INLINE verifyRowExtendConstraints #-}
verifyRowExtendConstraints ::
    RowConstraints (TypeConstraintsOf rowTyp) =>
    (TypeConstraintsOf rowTyp -> TypeConstraintsOf valTyp) ->
    TypeConstraintsOf rowTyp ->
    RowExtend (RowKey rowTyp) valTyp rowTyp # h ->
    Maybe (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
verifyRowExtendConstraints :: (TypeConstraintsOf rowTyp -> TypeConstraintsOf valTyp)
-> TypeConstraintsOf rowTyp
-> (RowExtend (RowKey rowTyp) valTyp rowTyp # h)
-> Maybe
     (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
verifyRowExtendConstraints TypeConstraintsOf rowTyp -> TypeConstraintsOf valTyp
toChildC TypeConstraintsOf rowTyp
c (RowExtend RowKey rowTyp
h 'AHyperType h :# valTyp
v 'AHyperType h :# rowTyp
rest)
    | TypeConstraintsOf rowTyp
c TypeConstraintsOf rowTyp
-> Getting Bool (TypeConstraintsOf rowTyp) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Set (RowKey rowTyp) -> Const Bool (Set (RowKey rowTyp)))
-> TypeConstraintsOf rowTyp
-> Const Bool (TypeConstraintsOf rowTyp)
forall constraints.
RowConstraints constraints =>
Lens' constraints (Set (RowConstraintsKey constraints))
forbidden ((Set (RowKey rowTyp) -> Const Bool (Set (RowKey rowTyp)))
 -> TypeConstraintsOf rowTyp
 -> Const Bool (TypeConstraintsOf rowTyp))
-> ((Bool -> Const Bool Bool)
    -> Set (RowKey rowTyp) -> Const Bool (Set (RowKey rowTyp)))
-> Getting Bool (TypeConstraintsOf rowTyp) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set (RowKey rowTyp)) -> Lens' (Set (RowKey rowTyp)) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index (Set (RowKey rowTyp))
RowKey rowTyp
h = Maybe (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        RowKey rowTyp
-> ('AHyperType (WithConstraint h) :# valTyp)
-> ('AHyperType (WithConstraint h) :# rowTyp)
-> RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h
forall key (val :: HyperType) (rest :: HyperType)
       (h :: AHyperType).
key -> (h :# val) -> (h :# rest) -> RowExtend key val rest h
RowExtend RowKey rowTyp
h
        (TypeConstraintsOf (GetHyperType ('AHyperType valTyp))
-> h ('AHyperType valTyp) -> WithConstraint h ('AHyperType valTyp)
forall (h :: HyperType) (ast :: AHyperType).
TypeConstraintsOf (GetHyperType ast)
-> h ast -> WithConstraint h ast
WithConstraint (TypeConstraintsOf rowTyp
c TypeConstraintsOf rowTyp
-> (TypeConstraintsOf rowTyp -> TypeConstraintsOf rowTyp)
-> TypeConstraintsOf rowTyp
forall a b. a -> (a -> b) -> b
& (Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
-> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp)
forall constraints.
RowConstraints constraints =>
Lens' constraints (Set (RowConstraintsKey constraints))
forbidden ((Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
 -> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp))
-> Set (RowKey rowTyp)
-> TypeConstraintsOf rowTyp
-> TypeConstraintsOf rowTyp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (RowKey rowTyp)
forall a. Monoid a => a
mempty TypeConstraintsOf rowTyp
-> (TypeConstraintsOf rowTyp -> TypeConstraintsOf valTyp)
-> TypeConstraintsOf valTyp
forall a b. a -> (a -> b) -> b
& TypeConstraintsOf rowTyp -> TypeConstraintsOf valTyp
toChildC) h ('AHyperType valTyp)
'AHyperType h :# valTyp
v)
        (TypeConstraintsOf (GetHyperType ('AHyperType rowTyp))
-> h ('AHyperType rowTyp) -> WithConstraint h ('AHyperType rowTyp)
forall (h :: HyperType) (ast :: AHyperType).
TypeConstraintsOf (GetHyperType ast)
-> h ast -> WithConstraint h ast
WithConstraint (TypeConstraintsOf rowTyp
c TypeConstraintsOf rowTyp
-> (TypeConstraintsOf rowTyp -> TypeConstraintsOf rowTyp)
-> TypeConstraintsOf rowTyp
forall a b. a -> (a -> b) -> b
& (Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
-> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp)
forall constraints.
RowConstraints constraints =>
Lens' constraints (Set (RowConstraintsKey constraints))
forbidden ((Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
 -> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp))
-> ((Bool -> Identity Bool)
    -> Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
-> (Bool -> Identity Bool)
-> TypeConstraintsOf rowTyp
-> Identity (TypeConstraintsOf rowTyp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set (RowKey rowTyp)) -> Lens' (Set (RowKey rowTyp)) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index (Set (RowKey rowTyp))
RowKey rowTyp
h ((Bool -> Identity Bool)
 -> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp))
-> Bool -> TypeConstraintsOf rowTyp -> TypeConstraintsOf rowTyp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) h ('AHyperType rowTyp)
'AHyperType h :# rowTyp
rest)
        (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
-> ((RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
    -> Maybe
         (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h))
-> Maybe
     (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
forall a b. a -> (a -> b) -> b
& (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
-> Maybe
     (RowExtend (RowKey rowTyp) valTyp rowTyp # WithConstraint h)
forall a. a -> Maybe a
Just

{-# INLINE rowExtendStructureMismatch #-}
rowExtendStructureMismatch ::
    Ord key =>
    ( Unify m rowTyp
    , Unify m valTyp
    ) =>
    (forall c. Unify m c => UVarOf m # c -> UVarOf m # c -> m (UVarOf m # c)) ->
    Prism' (rowTyp # UVarOf m) (RowExtend key valTyp rowTyp # UVarOf m) ->
    RowExtend key valTyp rowTyp # UVarOf m ->
    RowExtend key valTyp rowTyp # UVarOf m ->
    m ()
rowExtendStructureMismatch :: (forall (c :: HyperType).
 Unify m c =>
 (UVarOf m # c) -> (UVarOf m # c) -> m (UVarOf m # c))
-> Prism'
     (rowTyp # UVarOf m) (RowExtend key valTyp rowTyp # UVarOf m)
-> (RowExtend key valTyp rowTyp # UVarOf m)
-> (RowExtend key valTyp rowTyp # UVarOf m)
-> m ()
rowExtendStructureMismatch forall (c :: HyperType).
Unify m c =>
(UVarOf m # c) -> (UVarOf m # c) -> m (UVarOf m # c)
match Prism' (rowTyp # UVarOf m) (RowExtend key valTyp rowTyp # UVarOf m)
extend RowExtend key valTyp rowTyp # UVarOf m
r0 RowExtend key valTyp rowTyp # UVarOf m
r1 =
    do
        FlatRowExtends key valTyp rowTyp # UVarOf m
flat0 <- ((UVarOf m # rowTyp)
 -> m (Maybe (RowExtend key valTyp rowTyp # UVarOf m)))
-> (RowExtend key valTyp rowTyp # UVarOf m)
-> m (FlatRowExtends key valTyp rowTyp # UVarOf m)
forall key (m :: * -> *) (v :: HyperType) (rest :: HyperType)
       (val :: HyperType).
(Ord key, Monad m) =>
((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (RowExtend key val rest # v)
-> m (FlatRowExtends key val rest # v)
flattenRowExtend (UVarOf m # rowTyp)
-> m (Maybe (RowExtend key valTyp rowTyp # UVarOf m))
nextExtend RowExtend key valTyp rowTyp # UVarOf m
r0
        FlatRowExtends key valTyp rowTyp # UVarOf m
flat1 <- ((UVarOf m # rowTyp)
 -> m (Maybe (RowExtend key valTyp rowTyp # UVarOf m)))
-> (RowExtend key valTyp rowTyp # UVarOf m)
-> m (FlatRowExtends key valTyp rowTyp # UVarOf m)
forall key (m :: * -> *) (v :: HyperType) (rest :: HyperType)
       (val :: HyperType).
(Ord key, Monad m) =>
((v # rest) -> m (Maybe (RowExtend key val rest # v)))
-> (RowExtend key val rest # v)
-> m (FlatRowExtends key val rest # v)
flattenRowExtend (UVarOf m # rowTyp)
-> m (Maybe (RowExtend key valTyp rowTyp # UVarOf m))
nextExtend RowExtend key valTyp rowTyp # UVarOf m
r1
        ((UVarOf m # valTyp)
 -> (UVarOf m # valTyp) -> m (UVarOf m # valTyp))
-> Map key (UVarOf m # valTyp)
-> Map key (UVarOf m # valTyp)
-> Map key (m (UVarOf m # valTyp))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (UVarOf m # valTyp) -> (UVarOf m # valTyp) -> m (UVarOf m # valTyp)
forall (c :: HyperType).
Unify m c =>
(UVarOf m # c) -> (UVarOf m # c) -> m (UVarOf m # c)
match (FlatRowExtends key valTyp rowTyp # UVarOf m
flat0 (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> Getting
     (Map key (UVarOf m # valTyp))
     (FlatRowExtends key valTyp rowTyp # UVarOf m)
     (Map key (UVarOf m # valTyp))
-> Map key (UVarOf m # valTyp)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map key (UVarOf m # valTyp))
  (FlatRowExtends key valTyp rowTyp # UVarOf m)
  (Map key (UVarOf m # valTyp))
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       key (val :: HyperType).
Lens
  (FlatRowExtends key val rest h)
  (FlatRowExtends key val rest h)
  (Map key (h :# val))
  (Map key (h :# val))
freExtends) (FlatRowExtends key valTyp rowTyp # UVarOf m
flat1 (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> Getting
     (Map key (UVarOf m # valTyp))
     (FlatRowExtends key valTyp rowTyp # UVarOf m)
     (Map key (UVarOf m # valTyp))
-> Map key (UVarOf m # valTyp)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map key (UVarOf m # valTyp))
  (FlatRowExtends key valTyp rowTyp # UVarOf m)
  (Map key (UVarOf m # valTyp))
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       key (val :: HyperType).
Lens
  (FlatRowExtends key val rest h)
  (FlatRowExtends key val rest h)
  (Map key (h :# val))
  (Map key (h :# val))
freExtends)
            Map key (m (UVarOf m # valTyp))
-> (Map key (m (UVarOf m # valTyp)) -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& Map key (m (UVarOf m # valTyp)) -> m ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_
        UVarOf m # rowTyp
restVar <- TypeConstraintsOf (GetHyperType ('AHyperType rowTyp))
-> UTerm (UVarOf m) ('AHyperType rowTyp)
forall (v :: HyperType) (ast :: AHyperType).
TypeConstraintsOf (GetHyperType ast) -> UTerm v ast
UUnbound TypeConstraintsOf (GetHyperType ('AHyperType rowTyp))
forall a. Monoid a => a
mempty UTerm (UVarOf m) ('AHyperType rowTyp)
-> (UTerm (UVarOf m) ('AHyperType rowTyp) -> m (UVarOf m # rowTyp))
-> m (UVarOf m # rowTyp)
forall a b. a -> (a -> b) -> b
& BindingDict (UVarOf m) m rowTyp
-> UTerm (UVarOf m) ('AHyperType rowTyp) -> m (UVarOf m # rowTyp)
forall (v :: HyperType) (m :: * -> *) (t :: HyperType).
BindingDict v m t -> (UTerm v # t) -> m (v # t)
newVar BindingDict (UVarOf m) m rowTyp
forall (m :: * -> *) (t :: HyperType).
Unify m t =>
BindingDict (UVarOf m) m t
binding
        let side :: (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> m (UVarOf m # rowTyp)
side FlatRowExtends key valTyp rowTyp # UVarOf m
x FlatRowExtends key valTyp rowTyp # UVarOf m
y =
                ((RowExtend key valTyp rowTyp # UVarOf m) -> m (UVarOf m # rowTyp))
-> (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> m (UVarOf m # rowTyp)
forall (m :: * -> *) key (val :: HyperType) (rest :: HyperType)
       (v :: HyperType).
Monad m =>
((RowExtend key val rest # v) -> m (v # rest))
-> (FlatRowExtends key val rest # v) -> m (v # rest)
unflattenRow (RowExtend key valTyp rowTyp # UVarOf m) -> m (UVarOf m # rowTyp)
mkExtend FlatRowExtends :: forall key (val :: HyperType) (rest :: HyperType)
       (h :: AHyperType).
Map key (h :# val) -> (h :# rest) -> FlatRowExtends key val rest h
FlatRowExtends
                { _freExtends :: Map key ('AHyperType (UVarOf m) :# valTyp)
_freExtends =
                  (FlatRowExtends key valTyp rowTyp # UVarOf m
x (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> Getting
     (Map key (UVarOf m # valTyp))
     (FlatRowExtends key valTyp rowTyp # UVarOf m)
     (Map key (UVarOf m # valTyp))
-> Map key (UVarOf m # valTyp)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map key (UVarOf m # valTyp))
  (FlatRowExtends key valTyp rowTyp # UVarOf m)
  (Map key (UVarOf m # valTyp))
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       key (val :: HyperType).
Lens
  (FlatRowExtends key val rest h)
  (FlatRowExtends key val rest h)
  (Map key (h :# val))
  (Map key (h :# val))
freExtends) Map key (UVarOf m # valTyp)
-> Map key (UVarOf m # valTyp) -> Map key (UVarOf m # valTyp)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` (FlatRowExtends key valTyp rowTyp # UVarOf m
y (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> Getting
     (Map key (UVarOf m # valTyp))
     (FlatRowExtends key valTyp rowTyp # UVarOf m)
     (Map key (UVarOf m # valTyp))
-> Map key (UVarOf m # valTyp)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map key (UVarOf m # valTyp))
  (FlatRowExtends key valTyp rowTyp # UVarOf m)
  (Map key (UVarOf m # valTyp))
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       key (val :: HyperType).
Lens
  (FlatRowExtends key val rest h)
  (FlatRowExtends key val rest h)
  (Map key (h :# val))
  (Map key (h :# val))
freExtends)
                , _freRest :: 'AHyperType (UVarOf m) :# rowTyp
_freRest = 'AHyperType (UVarOf m) :# rowTyp
UVarOf m # rowTyp
restVar
                } m (UVarOf m # rowTyp)
-> ((UVarOf m # rowTyp) -> m (UVarOf m # rowTyp))
-> m (UVarOf m # rowTyp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UVarOf m # rowTyp) -> (UVarOf m # rowTyp) -> m (UVarOf m # rowTyp)
forall (c :: HyperType).
Unify m c =>
(UVarOf m # c) -> (UVarOf m # c) -> m (UVarOf m # c)
match (FlatRowExtends key valTyp rowTyp # UVarOf m
y (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> Getting
     (UVarOf m # rowTyp)
     (FlatRowExtends key valTyp rowTyp # UVarOf m)
     (UVarOf m # rowTyp)
-> UVarOf m # rowTyp
forall s a. s -> Getting a s a -> a
^. Getting
  (UVarOf m # rowTyp)
  (FlatRowExtends key valTyp rowTyp # UVarOf m)
  (UVarOf m # rowTyp)
forall key (val :: HyperType) (rest :: HyperType) (h :: AHyperType)
       (rest :: HyperType).
Lens
  (FlatRowExtends key val rest h)
  (FlatRowExtends key val rest h)
  (h :# rest)
  (h :# rest)
freRest)
        UVarOf m # rowTyp
_ <- (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> m (UVarOf m # rowTyp)
side FlatRowExtends key valTyp rowTyp # UVarOf m
flat0 FlatRowExtends key valTyp rowTyp # UVarOf m
flat1
        UVarOf m # rowTyp
_ <- (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> (FlatRowExtends key valTyp rowTyp # UVarOf m)
-> m (UVarOf m # rowTyp)
side FlatRowExtends key valTyp rowTyp # UVarOf m
flat1 FlatRowExtends key valTyp rowTyp # UVarOf m
flat0
        () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    where
        mkExtend :: (RowExtend key valTyp rowTyp # UVarOf m) -> m (UVarOf m # rowTyp)
mkExtend RowExtend key valTyp rowTyp # UVarOf m
ext = TypeConstraintsOf (GetHyperType ('AHyperType rowTyp))
-> ('AHyperType rowTyp :# UVarOf m)
-> UTermBody (UVarOf m) ('AHyperType rowTyp)
forall (v1 :: HyperType) (ast :: AHyperType).
TypeConstraintsOf (GetHyperType ast)
-> (ast :# v1) -> UTermBody v1 ast
UTermBody TypeConstraintsOf (GetHyperType ('AHyperType rowTyp))
forall a. Monoid a => a
mempty (Tagged
  (RowExtend key valTyp rowTyp # UVarOf m)
  (Identity (RowExtend key valTyp rowTyp # UVarOf m))
-> Tagged (rowTyp # UVarOf m) (Identity (rowTyp # UVarOf m))
Prism' (rowTyp # UVarOf m) (RowExtend key valTyp rowTyp # UVarOf m)
extend (Tagged
   (RowExtend key valTyp rowTyp # UVarOf m)
   (Identity (RowExtend key valTyp rowTyp # UVarOf m))
 -> Tagged (rowTyp # UVarOf m) (Identity (rowTyp # UVarOf m)))
-> (RowExtend key valTyp rowTyp # UVarOf m) -> rowTyp # UVarOf m
forall t b. AReview t b -> b -> t
# RowExtend key valTyp rowTyp # UVarOf m
ext) UTermBody (UVarOf m) ('AHyperType rowTyp)
-> (UTermBody (UVarOf m) ('AHyperType rowTyp)
    -> UTerm (UVarOf m) ('AHyperType rowTyp))
-> UTerm (UVarOf m) ('AHyperType rowTyp)
forall a b. a -> (a -> b) -> b
& UTermBody (UVarOf m) ('AHyperType rowTyp)
-> UTerm (UVarOf m) ('AHyperType rowTyp)
forall (v :: HyperType) (ast :: AHyperType).
UTermBody v ast -> UTerm v ast
UTerm UTerm (UVarOf m) ('AHyperType rowTyp)
-> (UTerm (UVarOf m) ('AHyperType rowTyp) -> m (UVarOf m # rowTyp))
-> m (UVarOf m # rowTyp)
forall a b. a -> (a -> b) -> b
& BindingDict (UVarOf m) m rowTyp
-> UTerm (UVarOf m) ('AHyperType rowTyp) -> m (UVarOf m # rowTyp)
forall (v :: HyperType) (m :: * -> *) (t :: HyperType).
BindingDict v m t -> (UTerm v # t) -> m (v # t)
newVar BindingDict (UVarOf m) m rowTyp
forall (m :: * -> *) (t :: HyperType).
Unify m t =>
BindingDict (UVarOf m) m t
binding
        nextExtend :: (UVarOf m # rowTyp)
-> m (Maybe (RowExtend key valTyp rowTyp # UVarOf m))
nextExtend UVarOf m # rowTyp
v = (UVarOf m # rowTyp)
-> m (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
forall (m :: * -> *) (t :: HyperType).
Unify m t =>
(UVarOf m # t) -> m (UVarOf m # t, UTerm (UVarOf m) # t)
semiPruneLookup UVarOf m # rowTyp
v m (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
-> ((UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
    -> Maybe (RowExtend key valTyp rowTyp # UVarOf m))
-> m (Maybe (RowExtend key valTyp rowTyp # UVarOf m))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
-> Getting
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
     (RowExtend key valTyp rowTyp # UVarOf m)
-> Maybe (RowExtend key valTyp rowTyp # UVarOf m)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (UTerm (UVarOf m) ('AHyperType rowTyp)
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (UTerm (UVarOf m) ('AHyperType rowTyp)))
-> (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
-> Const
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
forall s t a b. Field2 s t a b => Lens s t a b
Lens._2 ((UTerm (UVarOf m) ('AHyperType rowTyp)
  -> Const
       (First (RowExtend key valTyp rowTyp # UVarOf m))
       (UTerm (UVarOf m) ('AHyperType rowTyp)))
 -> (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp)))
-> (((RowExtend key valTyp rowTyp # UVarOf m)
     -> Const
          (First (RowExtend key valTyp rowTyp # UVarOf m))
          (RowExtend key valTyp rowTyp # UVarOf m))
    -> UTerm (UVarOf m) ('AHyperType rowTyp)
    -> Const
         (First (RowExtend key valTyp rowTyp # UVarOf m))
         (UTerm (UVarOf m) ('AHyperType rowTyp)))
-> Getting
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UVarOf m # rowTyp, UTerm (UVarOf m) ('AHyperType rowTyp))
     (RowExtend key valTyp rowTyp # UVarOf m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTermBody (UVarOf m) ('AHyperType rowTyp)
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (UTermBody (UVarOf m) ('AHyperType rowTyp)))
-> UTerm (UVarOf m) ('AHyperType rowTyp)
-> Const
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UTerm (UVarOf m) ('AHyperType rowTyp))
forall (v :: HyperType) (ast :: AHyperType).
Prism' (UTerm v ast) (UTermBody v ast)
_UTerm ((UTermBody (UVarOf m) ('AHyperType rowTyp)
  -> Const
       (First (RowExtend key valTyp rowTyp # UVarOf m))
       (UTermBody (UVarOf m) ('AHyperType rowTyp)))
 -> UTerm (UVarOf m) ('AHyperType rowTyp)
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (UTerm (UVarOf m) ('AHyperType rowTyp)))
-> (((RowExtend key valTyp rowTyp # UVarOf m)
     -> Const
          (First (RowExtend key valTyp rowTyp # UVarOf m))
          (RowExtend key valTyp rowTyp # UVarOf m))
    -> UTermBody (UVarOf m) ('AHyperType rowTyp)
    -> Const
         (First (RowExtend key valTyp rowTyp # UVarOf m))
         (UTermBody (UVarOf m) ('AHyperType rowTyp)))
-> ((RowExtend key valTyp rowTyp # UVarOf m)
    -> Const
         (First (RowExtend key valTyp rowTyp # UVarOf m))
         (RowExtend key valTyp rowTyp # UVarOf m))
-> UTerm (UVarOf m) ('AHyperType rowTyp)
-> Const
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UTerm (UVarOf m) ('AHyperType rowTyp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((rowTyp # UVarOf m)
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (rowTyp # UVarOf m))
-> UTermBody (UVarOf m) ('AHyperType rowTyp)
-> Const
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UTermBody (UVarOf m) ('AHyperType rowTyp))
forall (v1 :: HyperType) (ast :: AHyperType) (v2 :: HyperType).
Lens (UTermBody v1 ast) (UTermBody v2 ast) (ast :# v1) (ast :# v2)
uBody (((rowTyp # UVarOf m)
  -> Const
       (First (RowExtend key valTyp rowTyp # UVarOf m))
       (rowTyp # UVarOf m))
 -> UTermBody (UVarOf m) ('AHyperType rowTyp)
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (UTermBody (UVarOf m) ('AHyperType rowTyp)))
-> (((RowExtend key valTyp rowTyp # UVarOf m)
     -> Const
          (First (RowExtend key valTyp rowTyp # UVarOf m))
          (RowExtend key valTyp rowTyp # UVarOf m))
    -> (rowTyp # UVarOf m)
    -> Const
         (First (RowExtend key valTyp rowTyp # UVarOf m))
         (rowTyp # UVarOf m))
-> ((RowExtend key valTyp rowTyp # UVarOf m)
    -> Const
         (First (RowExtend key valTyp rowTyp # UVarOf m))
         (RowExtend key valTyp rowTyp # UVarOf m))
-> UTermBody (UVarOf m) ('AHyperType rowTyp)
-> Const
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (UTermBody (UVarOf m) ('AHyperType rowTyp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RowExtend key valTyp rowTyp # UVarOf m)
 -> Const
      (First (RowExtend key valTyp rowTyp # UVarOf m))
      (RowExtend key valTyp rowTyp # UVarOf m))
-> (rowTyp # UVarOf m)
-> Const
     (First (RowExtend key valTyp rowTyp # UVarOf m))
     (rowTyp # UVarOf m)
Prism' (rowTyp # UVarOf m) (RowExtend key valTyp rowTyp # UVarOf m)
extend)

-- Helper for infering row usages of a row element,
-- such as getting a field from a record or injecting into a sum type.
-- Returns a unification variable for the element and for the whole row.
{-# INLINE rowElementInfer #-}
rowElementInfer ::
    forall m valTyp rowTyp.
    ( UnifyGen m valTyp
    , UnifyGen m rowTyp
    , RowConstraints (TypeConstraintsOf rowTyp)
    ) =>
    (RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m -> rowTyp # UVarOf m) ->
    RowKey rowTyp ->
    m (UVarOf m # valTyp, UVarOf m # rowTyp)
rowElementInfer :: ((RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m)
 -> rowTyp # UVarOf m)
-> RowKey rowTyp -> m (UVarOf m # valTyp, UVarOf m # rowTyp)
rowElementInfer (RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m)
-> rowTyp # UVarOf m
extendToRow RowKey rowTyp
h =
    do
        UVarOf m # rowTyp
restVar <-
            Proxy rowTyp -> m (TypeConstraintsOf rowTyp)
forall (m :: * -> *) (t :: HyperType).
UnifyGen m t =>
Proxy t -> m (TypeConstraintsOf t)
scopeConstraints (Proxy rowTyp
forall k (t :: k). Proxy t
Proxy @rowTyp)
            m (TypeConstraintsOf rowTyp)
-> (TypeConstraintsOf rowTyp -> m (UVarOf m # rowTyp))
-> m (UVarOf m # rowTyp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BindingDict (UVarOf m) m rowTyp
-> (UTerm (UVarOf m) # rowTyp) -> m (UVarOf m # rowTyp)
forall (v :: HyperType) (m :: * -> *) (t :: HyperType).
BindingDict v m t -> (UTerm v # t) -> m (v # t)
newVar BindingDict (UVarOf m) m rowTyp
forall (m :: * -> *) (t :: HyperType).
Unify m t =>
BindingDict (UVarOf m) m t
binding ((UTerm (UVarOf m) # rowTyp) -> m (UVarOf m # rowTyp))
-> (TypeConstraintsOf rowTyp -> UTerm (UVarOf m) # rowTyp)
-> TypeConstraintsOf rowTyp
-> m (UVarOf m # rowTyp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeConstraintsOf rowTyp -> UTerm (UVarOf m) # rowTyp
forall (v :: HyperType) (ast :: AHyperType).
TypeConstraintsOf (GetHyperType ast) -> UTerm v ast
UUnbound (TypeConstraintsOf rowTyp -> UTerm (UVarOf m) # rowTyp)
-> (TypeConstraintsOf rowTyp -> TypeConstraintsOf rowTyp)
-> TypeConstraintsOf rowTyp
-> UTerm (UVarOf m) # rowTyp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
-> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp)
forall constraints.
RowConstraints constraints =>
Lens' constraints (Set (RowConstraintsKey constraints))
forbidden ((Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
 -> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp))
-> ((Bool -> Identity Bool)
    -> Set (RowKey rowTyp) -> Identity (Set (RowKey rowTyp)))
-> (Bool -> Identity Bool)
-> TypeConstraintsOf rowTyp
-> Identity (TypeConstraintsOf rowTyp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set (RowKey rowTyp)) -> Lens' (Set (RowKey rowTyp)) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index (Set (RowKey rowTyp))
RowKey rowTyp
h ((Bool -> Identity Bool)
 -> TypeConstraintsOf rowTyp -> Identity (TypeConstraintsOf rowTyp))
-> Bool -> TypeConstraintsOf rowTyp -> TypeConstraintsOf rowTyp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
        UVarOf m # valTyp
part <- m (UVarOf m # valTyp)
forall (m :: * -> *) (t :: HyperType).
UnifyGen m t =>
m (UVarOf m # t)
newUnbound
        UVarOf m # rowTyp
whole <- RowKey rowTyp
-> ('AHyperType (UVarOf m) :# valTyp)
-> ('AHyperType (UVarOf m) :# rowTyp)
-> RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m
forall key (val :: HyperType) (rest :: HyperType)
       (h :: AHyperType).
key -> (h :# val) -> (h :# rest) -> RowExtend key val rest h
RowExtend RowKey rowTyp
h 'AHyperType (UVarOf m) :# valTyp
UVarOf m # valTyp
part 'AHyperType (UVarOf m) :# rowTyp
UVarOf m # rowTyp
restVar (RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m)
-> ((RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m)
    -> rowTyp # UVarOf m)
-> rowTyp # UVarOf m
forall a b. a -> (a -> b) -> b
& (RowExtend (RowKey rowTyp) valTyp rowTyp # UVarOf m)
-> rowTyp # UVarOf m
extendToRow (rowTyp # UVarOf m)
-> ((rowTyp # UVarOf m) -> m (UVarOf m # rowTyp))
-> m (UVarOf m # rowTyp)
forall a b. a -> (a -> b) -> b
& (rowTyp # UVarOf m) -> m (UVarOf m # rowTyp)
forall (m :: * -> *) (t :: HyperType).
UnifyGen m t =>
(t # UVarOf m) -> m (UVarOf m # t)
newTerm
        (UVarOf m # valTyp, UVarOf m # rowTyp)
-> m (UVarOf m # valTyp, UVarOf m # rowTyp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UVarOf m # valTyp
part, UVarOf m # rowTyp
whole)