purescript-contrib / purescript-profunctor-lenses

Pure profunctor lenses
MIT License
144 stars 52 forks source link

affineStore function #130

Open kim366 opened 3 years ago

kim366 commented 3 years ago

I was looking for a function similar to lensStore but where some constructors of the ADT did not contain the inner value. After a day of learning lenses I came up with the following:

affineStore
  :: forall s t t' a b
   . (t' -> t)
  -> ALens s t' a b
  -> s
  -> Tuple (b -> t) (Either t a)
affineStore f l = withLens l go
  where
  go get set value =
    Tuple
      (f <<< set value)
      (Right $ get value)

ignoredAffineStore :: forall t a b. t -> Tuple (b -> t) (Either t a)
ignoredAffineStore wrapper = Tuple (const wrapper) (Left wrapper)

data Adt
  = X { x :: Int, y :: String }
  | Y { a :: Int, b :: Number }
  | Z { e :: Char }

_x :: forall s r. Lens' { x :: s | r } s
_x = prop (Proxy :: _ "x")

_a :: forall s r. Lens' { a :: s | r } s
_a = prop (Proxy :: _ "a")

_valueInAdt :: AffineTraversal' Adt Int
_valueInAdt = affineTraversal' case _ of
    X value   -> affineStore X _x value
    Y value   -> affineStore Y _a value
    adt@(Z _) -> ignoredAffineStore adt

Here the functions affineStore and ignoredAffineStore can be used in a similar way to lensStore. I have checked that it all follows affine traversal laws, I can send over the tests.

My question is whether these are useful functions to have in the lenses package. It is very useful for what I'm building and it seems there is no other way of doing it this comfortably.

kim366 commented 3 years ago

After developing a affineStore' function accepting prisms/affine traversals, I found out that an affine traversal is a superset of a lens. So here is the more general version:

affineStore
  :: forall s t a b
   . (s -> t)
  -> (AnAffineTraversal s s a b)
  -> s
  -> Tuple (b -> t) (Either t a)
affineStore f l = withAffineTraversal l go
  where
  go setl previewl value =
    Tuple
      (f <<< setl value)
      (lmap f $ previewl value)

data Adt
  = X { x :: Int, y :: String }
  | Y { a :: Maybe Int, b :: Number }
  | Z { e :: Char }
  | W (Maybe Int)

derive instance genericAdt :: Generic Adt _
derive instance eqAdt :: Eq Adt
instance showAdt :: Show Adt where show = genericShow

_x :: forall s r. Lens' { x :: s | r } s
_x = prop (Proxy :: _ "x")

_a :: forall s r. AffineTraversal' { a :: Maybe s | r } s
_a = prop (Proxy :: _ "a") <<< _Just

_valueInAdt :: AffineTraversal' Adt Int
_valueInAdt = affineTraversal' case _ of
    X value   -> affineStore X _x value
    Y value   -> affineStore Y _a value
    W value   -> affineStore W _Just value
    adt@(Z _) -> ignoredAffineStore adt