module Extended.Lens.TH
( fieldsVerboseLensRules
) where
import Universum
import Data.Char (toUpper)
import Data.List (stripPrefix)
import Language.Haskell.TH.Syntax (Name, mkName, nameBase)
import Lens.Micro.Platform (DefName (MethodName), LensRules,
camelCaseFields, lensField, makeLensesWith)
verboseFieldsNamer :: Name -> [Name] -> Name -> [DefName]
verboseFieldsNamer _ _ fieldName = maybeToList $ do
fieldUnprefixed@(x:xs) <- stripPrefix "_" (nameBase fieldName)
let className = "HasPoly" ++ toUpper x : xs
let methodName = fieldUnprefixed
pure (MethodName (mkName className) (mkName methodName))
fieldsVerboseLensRules :: LensRules
fieldsVerboseLensRules = camelCaseFields & lensField .~ verboseFieldsNamer