Several ways to modify records with parameters using lenses

Main.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DeriveFunctor #-}

module Main where

import Control.Lens

testRec :: Rec (Int, String)
testRec = Rec { val = (5, "apples"), foo = 2, bar = True }

testF :: Rec Int -> Rec Int
testF Rec{val, foo, bar} = Rec{val=val + foo, foo=foo - val, bar=not bar}

test :: IO ()
test = do
  putStrLn "modifyRec _1 testF testRec"
  print $ modifyRec _1 testF testRec
  putStrLn "modifyRecF _1 testF testRec"
  print $ modifyRecF _1 testF testRec
  putStrLn "modifyRecF1 _1 testF testRec"
  print $ modifyRecF1 _1 testF testRec
  putStrLn "modifyRecL _1 testF testRec"
  print $ modifyRecL _1 testF testRec
  putStrLn "modifyRecG _1 testF testRec"
  print $ modifyRecG _1 testF testRec
  putStrLn "modifyRecC _1 testF testRec"
  print $ modifyRecC _1 testF testRec
  putStrLn "modifyRecA _1 testF testRec"
  print $ modifyRecA _1 testF testRec

data Rec s = Rec { val :: s, foo :: Int, bar :: Bool }
  deriving (Show, Functor)

modifyRec :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRec l h Rec{val, foo, bar} = Rec{val=set l val' val, foo=foo', bar=bar'}
  where
    Rec{val=val', foo=foo', bar=bar'} = h Rec{val=view (getting l) val, foo, bar}

-- Via functor

modifyRecF :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRecF l h r0@Rec{val} = (\b -> set l b val) <$> r1
  where
    r1 = h $ view (getting l) <$> r0

-- Via functor one line

modifyRecF1 :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRecF1 l h r0@Rec{val} = (\b -> set l b val) <$> h (view (getting l) <$> r0)

-- Via lens

lensVal :: Lens (Rec s) (Rec t) s t
lensVal = lens (\Rec{val} -> val) (\Rec{foo, bar} val -> Rec{val, foo, bar})

modifyRecL :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRecL l h r0 = over lensVal (\b -> set l b (view lensVal r0)) r1
  where
    r1 = h $ over lensVal (view (getting l)) r0

-- Via general modification function

modifyG :: (forall x y. Lens (r x) (r y) x y) -> Lens s t a b -> (r a -> r b) -> r s -> r t
modifyG l0 l h r0 = over l0 (\b -> set l b (view l0 r0)) r1
  where
    r1 = h $ over l0 (view (getting l)) r0

modifyRecG :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRecG = modifyG lensVal

-- Via combinator

setG :: (forall x y. Lens (r x) (r y) x y) -> Lens s t a b -> r s -> r b -> r t
setG l0 l r0 = over l0 (\b -> set l b (view l0 r0))

viewG :: (forall x y. Lens (r x) (r y) x y) -> Lens s t a b -> r s -> r a
viewG l0 l = over l0 (view $ getting l)

liftLens :: (forall x y. Lens (r x) (r y) x y) -> Lens s t a b -> Lens (r s) (r t) (r a) (r b)
liftLens l0 l = lens (viewG l0 l) (setG l0 l)

modifyRecC :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRecC l = over $ liftLens lensVal l

-- Via alongside

data Rec' = Rec' { foo' :: Int, bar' :: Bool }

isoRec :: Iso (Rec s) (Rec t) (Rec', s) (Rec', t)
isoRec = iso toPair fromPair
  where
    toPair Rec{val, foo, bar} = (Rec'{foo'=foo, bar'=bar}, val)
    fromPair (Rec'{foo', bar'}, val) = Rec{val, foo=foo', bar=bar'}

modifyRecA :: Lens s t a b -> (Rec a -> Rec b) -> Rec s -> Rec t
modifyRecA l = over $ isoRec . alongside id l . from isoRec