packages feed

wireform-proto-0.1.0.0: src/Proto/Lens.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Optional van Laarhoven lenses for protobuf message fields.
--
-- These lenses are __not__ the primary interface — plain record access
-- and 'Proto.Schema.HasField' get\/set are the default. Import this
-- module only when you want to use lens combinators.
--
-- The lenses are compatible with both @lens@ and @microlens@ since they
-- use the van Laarhoven encoding directly (no dependency on either package).
--
-- @
-- import Proto.Lens (field)
--
-- -- Get a field:
-- view (field \@\"seconds\") timestamp
--
-- -- Set a field:
-- set (field \@\"seconds\") 42 timestamp
--
-- -- Modify:
-- over (field \@\"seconds\") (+1) timestamp
--
-- -- Compose:
-- view (field \@\"inner\" . field \@\"name\") nested
-- @
--
-- The 'field' function produces a 'Lens'' that works with any lens library.
module Proto.Lens
  ( -- * Generic field lens
    field

    -- * Van Laarhoven lens type (no dependency on lens/microlens)
  , Lens'
  , Getting
  , ASetter

    -- * Operators (standalone, no lens dependency needed)
  , view
  , set
  , over
  , (^.)
  , (.~)
  , (%~)
  , (&)
  ) where

import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Proto.Schema (HasField(..))

-- | A van Laarhoven lens. Compatible with @lens@, @microlens@, @optics@
-- (via adapter), and any library that understands @Functor f => (a -> f a) -> s -> f s@.
type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s

-- | A getter (read-only lens).
type Getting r s a = (a -> Const r a) -> s -> Const r s

-- | A setter.
type ASetter s a = (a -> Identity a) -> s -> Identity s

-- | Produce a lens for a proto field, identified by its type-level name.
--
-- @
-- field \@\"seconds\" :: Lens' Timestamp Int64
-- field \@\"name\"    :: Lens' Person Text
-- @
--
-- This works for any message type that has a 'HasField' instance for the
-- given field name (i.e., all generated message types).
field :: forall name msg a f. (HasField msg name a, Functor f) => (a -> f a) -> msg -> f msg
field k msg = fmap (\a' -> setField @msg @name a' msg) (k (getField @msg @name msg))
{-# INLINE field #-}

-- | Extract the field value through a getter.
--
-- @view (field \@\"seconds\") ts == getField \@Timestamp \@\"seconds\" ts@
view :: Getting a s a -> s -> a
view l s = getConst (l Const s)
{-# INLINE view #-}

-- | Set a field to a specific value.
set :: ASetter s a -> a -> s -> s
set l a s = runIdentity (l (const (Identity a)) s)
{-# INLINE set #-}

-- | Modify a field with a function.
over :: ASetter s a -> (a -> a) -> s -> s
over l f s = runIdentity (l (Identity . f) s)
{-# INLINE over #-}

-- | Infix view.
(^.) :: s -> Getting a s a -> a
s ^. l = view l s
{-# INLINE (^.) #-}
infixl 8 ^.

-- | Infix set.
(.~) :: ASetter s a -> a -> s -> s
l .~ a = set l a
{-# INLINE (.~) #-}
infixr 4 .~

-- | Infix over (modify).
(%~) :: ASetter s a -> (a -> a) -> s -> s
l %~ f = over l f
{-# INLINE (%~) #-}
infixr 4 %~

-- | Reverse application (flip ($)), for chaining setters.
-- Re-exported for convenience; equivalent to Data.Function.(&).
(&) :: a -> (a -> b) -> b
x & f = f x
{-# INLINE (&) #-}
infixl 1 &