module Brick.Types.TH
  ( suffixLenses
  , suffixLensesWith
  )
where

import qualified Language.Haskell.TH.Syntax as TH
import qualified Language.Haskell.TH.Lib as TH

import Lens.Micro ((&), (.~))
import Lens.Micro.TH (DefName(..), LensRules, makeLensesWith, lensRules, lensField)

-- | A template haskell function to build lenses for a record type. This
-- function differs from the 'Lens.Micro.TH.makeLenses' function in that
-- it does not require the record fields to be prefixed with underscores
-- and it adds an "L" suffix to lens names to make it clear that they
-- are lenses.
suffixLenses :: TH.Name -> TH.DecsQ
suffixLenses :: Name -> DecsQ
suffixLenses = String -> LensRules -> Name -> DecsQ
suffixLensesWith String
"L" LensRules
lensRules

-- | A more general version of 'suffixLenses' that allows customization
-- of the lens-building rules and allows customization of the suffix.
suffixLensesWith :: String -> LensRules -> TH.Name -> TH.DecsQ
suffixLensesWith :: String -> LensRules -> Name -> DecsQ
suffixLensesWith String
suffix LensRules
rs = LensRules -> Name -> DecsQ
makeLensesWith forall a b. (a -> b) -> a -> b
$
    LensRules
rs forall a b. a -> (a -> b) -> b
& Lens' LensRules (Name -> [Name] -> Name -> [DefName])
lensField forall s t a b. ASetter s t a b -> b -> s -> t
.~ (\Name
_ [Name]
_ Name
name -> [Name -> DefName
TopName forall a b. (a -> b) -> a -> b
$ String -> Name
TH.mkName forall a b. (a -> b) -> a -> b
$ Name -> String
TH.nameBase Name
name forall a. [a] -> [a] -> [a]
++ String
suffix])