-- | Rules for lens generation

{-# OPTIONS_HADDOCK hide #-}

module Blockfrost.Util.LensRules
  where

import Control.Lens
import Language.Haskell.TH (mkName, nameBase)

-- Bit of an overkill, since we only alter
-- one field name which would end up called `type`
blockfrostFieldRules :: LensRules
blockfrostFieldRules :: LensRules
blockfrostFieldRules = LensRules
defaultFieldRules
  forall a b. a -> (a -> b) -> b
& Lens' LensRules FieldNamer
lensField forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {t} {t}.
(Name -> t -> t -> [DefName]) -> Name -> t -> t -> [DefName]
modNamer
  where
    modNamer :: (Name -> t -> t -> [DefName]) -> Name -> t -> t -> [DefName]
modNamer Name -> t -> t -> [DefName]
namer Name
dname t
fnames t
fname =
      forall a b. (a -> b) -> [a] -> [b]
map DefName -> DefName
fixDefName (Name -> t -> t -> [DefName]
namer (Name -> Name
fixTypeName Name
dname) t
fnames t
fname)

    fixDefName :: DefName -> DefName
fixDefName (MethodName Name
cname Name
mname)=Name -> Name -> DefName
MethodName Name
cname (Name -> Name
fixName Name
mname)
    fixDefName (TopName Name
name)           = Name -> DefName
TopName (Name -> Name
fixName Name
name)

    fixTypeName :: Name -> Name
fixTypeName = String -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => a -> a
fixTypeName' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase
    -- we coerce IPFS (and similar) to Ipfs so
    -- camelCase namer is happy
    -- and we don't have to rename our type or fields
    fixTypeName' :: a -> a
fixTypeName' a
"IPFSAdd"       = a
"IpfsAdd"
    fixTypeName' a
"IPFSPinChange" = a
"IpfsPinChange"
    fixTypeName' a
"IPFSPin"       = a
"IpfsPin"
    fixTypeName' a
"URLVersion"    = a
"UrlVersion"
    fixTypeName' a
x               = a
x

    fixName :: Name -> Name
fixName = String -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => a -> a
fixName' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase
    fixName' :: a -> a
fixName' a
"type" = a
"type_"
    fixName' a
n      = a
n