Generating Lenses from Variants

Help
#1

What I’m trying to do is a little more specific than the title here, but the general idea is there.

Here’s some sample code to demonstrate the problem:

type FieldRow = (email :: String, p1 :: String, p2 :: String)

setValue :: ∀ sym r0 a t0 row
   . IsSymbol sym
  => RowCons sym { value :: a | r0 } t0 row
  => SProxy sym
  -> a
  -> Record row
  -> Record row
setValue sym = set $ prop sym <<< prop (SProxy :: SProxy "value")

updateValue :: Variant FieldRow -> (Record FieldRow -> Record FieldRow)
updateValue = match
  { p1:    setValue (SProxy :: SProxy "p1")
  , p2:    setValue (SProxy :: SProxy "p2")
  , email: setValue (SProxy :: SProxy "email")
  }

setValue is a helper function that given a SProxy and a value, will produce a record update function for this particular structure. updateValue will also produce a record update function, just given a Variant. However we can see that for any given Variant passed to updateValue, all it does is call setValue passing in the SProxy corresponding to the label of the variant, and then it’s value. It seems like this could be accomplished without needing to explicitly write out every case of the Variant.

After looking into the internals of purescript-variant, I attempted this:

updateValue_ :: ∀ a row => Variant row -> Record row -> Record row
updateValue_ v =
  case coerceV v of
    VariantRep r -> set (reifySymbol r.type prop) r.value
  where
    coerceV :: Variant row -> VariantRep a
    coerceV = unsafeCoerce

Which is failing to build with the error:

Could not match contrained type

  Strong t4 => t4 t5 t6 -> t4 { | t7 } { | t8 }

with type

  (t0 -> t1) -> t2 -> t3

I’m guessing I’m missing something with the way to use reifySymbol, because it apparently is correctly seeing that the type of the expression reifySymbol r.type prop is Lens t7 t8 t4 t5, but it’s not seeing it as a valid argument to pass to set. Can anyone shed some light on what’s going on here, or if there are any glaring issues with this approach in general?

1 Like
Turning a map of data constructors into a row type
#2

A shorter statement of the problem:

Given a variant from our row (Variant fields) and a record containing those fields (Record fields) we want to produce a new record with the field given by the variant set to a new value.

Variant fields -> Record fields -> Record fields

This is particularly interesting, because the Strong class only appears to have one instance – Function. So these ought to be equivalent, right?

Could not match contrained type

  Strong t4 => t4 t5 t6 -> t4 { | t7 } { | t8 }

with type

  (t0 -> t1) -> t2 -> t3

If we fill in the same type variable names, they’d look something like this:

Strong arrow => arrow a b -> arrow (Record c) (Record d)
                 (a -> b) ->  (Record c) -> (Record d)

I found this from @paf31 on StackOverflow, which indicates that the problem may not be that these two can’t be unified, but that the compiler simply won’t make the attempt.

#3

Right, I imagine there’s some sort of coercion that can be done to make them unify, but I haven’t been able to figure it out yet.

1 Like
#4

Either way, your call to set should probably be inside reifySymbol, or you’re going to get an escaped skolem variable.

You’re also going to have problems once you solve that type error, since you won’t be able to convince the compiler that RowCons sym _ _ row holds for your new existential type sym.

You might want to just use Data.Record.Unsafe.unsafeSet instead:

updateValue_ :: forall row. Variant row -> Record row -> Record row
updateValue_ v | VariantRep r <- unsafeCoerce v = unsafeSet r.type r.value
1 Like
#5

Constraints aside, you could very likely generate this function safely with RowToList given the rows you want to handle.

1 Like
#6

@natefaubion That’s an interesting point. I’ve taken a stab at it here, which doesn’t quite work (it creates a record of functions, rather than updating a particular value when a variant is received). I don’t have more time to work on it tonight so I wanted to drop it here; perhaps someone else will see where I’ve gone wrong and can suggest a fix!

type FieldRow = ( email :: String, p1 :: String, p2 :: String )

class Construct (rl :: RowList) (r :: # Type) (o :: # Type) | rl -> o where
  constructImpl :: RLProxy rl -> Variant r -> Record r -> Record o

instance nilConstruct :: Construct Nil r () where
  constructImpl _ _ _ = {}
 
instance consConstruct
  :: ( IsSymbol name
     , RowCons name (a -> Record r -> Record r) tail' o
     , RowCons name a t0 r
     , RowLacks name tail'
     , Construct tail r tail'
     )
  => Construct (Cons name a tail) r o
  where
    constructImpl _ v r =
      let tail' = constructImpl (RLProxy :: RLProxy tail) v r
       in insert (SProxy :: SProxy name) (setValue (SProxy :: SProxy name)) tail'

setValue :: ∀ sym a t0 row
   . IsSymbol sym
  => RowCons sym a t0 row
  => SProxy sym
  -> a
  -> Record row
  -> Record row
setValue sym = set $ prop sym

updateValue
  :: ∀ r rl o
   . Construct rl r o
  => RowToList r rl
  => Variant r
  -> (Record r -> Record o)
updateValue v = constructImpl (RLProxy :: RLProxy rl) v

If I run this code with a test like this:

test = do
  let emailV :: forall v. Variant (email :: String | v)
      emailV = inj (SProxy :: SProxy "email") mempty

      emailR :: { email :: String }
      emailR = { email: mempty }

      updater = updateValue emailV emailR

  traceAnyA $ updateValue emailV emailR

I get output like this:

{ email: [Function] }

…which is not quite right. Certainly not the same behavior as this original:

_updateValue :: Variant FieldRow -> Record FieldRow -> Record FieldRow
_updateValue = match
  { p1:    setValue (SProxy :: SProxy "p1")
  , p2:    setValue (SProxy :: SProxy "p2")
  , email: setValue (SProxy :: SProxy "email")
  }
#7

I was hoping to be able to write a block like this:

updateValue v = match <<< constructImpl (RLProxy :: RLProxy rl) v

but haven’t been able to work out the types.

#8 
module RecordVariantUpdate where

import Data.Variant
import Data.Record (set)
import Data.Symbol (class IsSymbol)
import Type.Row (class RowToList, Cons, Nil, RLProxy(..))

class RecordVariantUpdate r where
  rvUpdate :: Variant r -> Record r -> Record r

instance recordVariantUpdate ::
  ( RowToList r rl
  , RecordVariantUpdateRL rl r r
  ) => RecordVariantUpdate r where
    rvUpdate = rvUpdateRL (RLProxy :: RLProxy rl)

class RecordVariantUpdateRL rl v r | rl -> v where
  rvUpdateRL :: RLProxy rl -> Variant v -> Record r -> Record r

instance rvUpdateNil :: RecordVariantUpdateRL Nil () r where
  rvUpdateRL _ = case_

instance rvUpdateCons ::
  ( IsSymbol s
  , RecordVariantUpdateRL rl v r
  , RowCons s t r' r
  , RowCons s t v v'
  ) => RecordVariantUpdateRL (Cons s t rl) v' r where
    rvUpdateRL _ =
      let s = SProxy :: SProxy s
      in on s (set s) (rvUpdateRL (RLProxy :: RLProxy rl))
3 Likes
#9

Here is a variation that keeps all the rows open, thus not requiring a closed variant or record.

module Main where

import Prelude

import Data.Record as Record
import Data.Symbol (class IsSymbol)
import Data.Variant (SProxy(..), Variant, case_, on)
import Type.Row (class RowToList, RLProxy(..), RProxy(..))
import Type.Row as RL

class BuildVariantSetters rl rin fin rout fout | rl rin fin -> rout fout where
  buildVariantSetters
    :: RLProxy rl
    -> RProxy fin
    -> (Variant rin -> Record fout -> Record fout)
    -> Variant rout
    -> Record fout
    -> Record fout

instance buildNil :: BuildVariantSetters RL.Nil r fin r fout where
  buildVariantSetters _ _ = id

instance buildCons ::
  ( IsSymbol sym
  , RowCons sym { value :: a | r } fin fout
  , RowCons sym a rout' rout
  , BuildVariantSetters tail rin fin' rout' fout
  ) => BuildVariantSetters (RL.Cons sym a tail) rin fin rout fout
  where
  buildVariantSetters _ _ =
    let
      sym  = SProxy  :: SProxy sym
      tail = RLProxy :: RLProxy tail
      fin  = RProxy  :: RProxy fin'
    in
      on sym (\a -> Record.modify sym _ { value = a })
        <<< buildVariantSetters tail fin

variantSetter
  :: forall rl vals head tail rin fin rout fout
   . RowToList vals rl
  => BuildVariantSetters rl rin fin rout fout
  => RProxy vals
  -> (Variant rin -> Record fout -> Record fout)
  -> Variant rout
  -> Record fout
  -> Record fout
variantSetter k =
  buildVariantSetters (RLProxy :: RLProxy rl) (RProxy :: RProxy fin)

type Values =
  ( foo :: String
  , bar :: Int
  )

test :: Variant Values -> _ -> _
test = case_ # variantSetter (RProxy :: RProxy Values)

  Wildcard type definition has the inferred type

    { bar :: { value :: Int
             | t0
             }
    , foo :: { value :: String
             | t1
             }
    | t2
    }


in value declaration test

where t0 is an unknown type
      t1 is an unknown type
      t2 is an unknown type
3 Likes
#10

Thank you guys so much for writing out these implementations @natefaubion and @monoidmusician, this thread has been super helpful!

I do have one final question whenever you get a chance: is there a way to make this polymorphic? Currently it will set the value key, but would there be a way to pass in a lens or something similar to specify an arbitrary key to set?

#11

I think it depends on how polymorphic. You could definitely provide a Lens and have it determine types from that, but your record would probably have to be relatively homogeneous. In the version I posted, it instantiates a new tail for each sub record, but I don’t think you could do that by providing a Lens up front. I think it would end up instantiating the tail once, requiring all fields to unify aside from the value itself. I don’t think you could do this without constraint kinds or some wild impredicativity, but I’d really like to be proven wrong.

1 Like