-- | 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
  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 -> FieldNamer) -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FieldNamer -> FieldNamer
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 =
      (DefName -> DefName) -> [DefName] -> [DefName]
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 (String -> Name) -> (Name -> String) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall p. (Eq p, IsString p) => p -> p
fixTypeName' (String -> String) -> (Name -> String) -> Name -> String
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' :: p -> p
fixTypeName' p
"IPFSAdd"       = p
"IpfsAdd"
    fixTypeName' p
"IPFSPinChange" = p
"IpfsPinChange"
    fixTypeName' p
"IPFSPin"       = p
"IpfsPin"
    fixTypeName' p
"URLVersion"    = p
"UrlVersion"
    fixTypeName' p
x               = p
x

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