-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Util.Lens
  ( postfixLFields
  , makeLensesWith
  ) where

import Control.Lens (LensRules, lensField, lensRules, makeLensesWith, mappingNamer)

-- | For datatype with "myNyan" field it will create "myNyanL" lens.
postfixLFields :: LensRules
postfixLFields :: LensRules
postfixLFields = LensRules
lensRules LensRules -> (LensRules -> LensRules) -> LensRules
forall a b. a -> (a -> b) -> b
& (FieldNamer -> Identity FieldNamer)
-> LensRules -> Identity LensRules
Lens' LensRules FieldNamer
lensField ((FieldNamer -> Identity FieldNamer)
 -> LensRules -> Identity LensRules)
-> FieldNamer -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> [String]) -> FieldNamer
mappingNamer (\s :: String
s -> [String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++"L"])