-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Lens generation utilities.
module Swarm.Util.Lens (
  makeLensesNoSigs,
  makeLensesExcluding,
) where

import Control.Lens (
  generateSignatures,
  lensField,
  lensRules,
  makeLensesWith,
  mapped,
  (%~),
  (&),
  (.~),
 )
import Language.Haskell.TH (DecsQ)
import Language.Haskell.TH.Syntax (Name)

-- | Generate lenses but with no type signatures, so we can explicitly
--   give type signatures and attach custom Haddock documentation to
--   them.
makeLensesNoSigs :: Name -> DecsQ
makeLensesNoSigs :: Name -> DecsQ
makeLensesNoSigs = LensRules -> Name -> DecsQ
makeLensesWith (LensRules
lensRules forall a b. a -> (a -> b) -> b
& Lens' LensRules Bool
generateSignatures forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False)

-- | Generate lenses for the fields of a record type (with no type
--   signatures), except for a given list of excluded fields.
--
--   Especially useful in conjunction with the design pattern
--   described in
--   https://byorgey.wordpress.com/2021/09/17/automatically-updated-cached-views-with-lens/
makeLensesExcluding :: [Name] -> Name -> DecsQ
makeLensesExcluding :: [Name] -> Name -> DecsQ
makeLensesExcluding [Name]
exclude =
  LensRules -> Name -> DecsQ
makeLensesWith
    ( LensRules
lensRules
        forall a b. a -> (a -> b) -> b
& Lens' LensRules Bool
generateSignatures forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
        forall a b. a -> (a -> b) -> b
& Lens' LensRules FieldNamer
lensField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Name -> [DefName]
fn Name
n ->
          if Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
exclude then [] else Name -> [DefName]
fn Name
n
    )