module Network.Wreq.Lens.Machinery
    (
      makeLenses
    , fieldName
    , toCamelCase
    ) where

import Control.Lens ((&), (.~))
import Control.Lens.TH hiding (makeLenses)
import Data.Char (toUpper)
import Language.Haskell.TH.Syntax (Dec, Name, Q, mkName, nameBase)

defaultRules :: LensRules
defaultRules :: LensRules
defaultRules = LensRules
lensRules

fieldName :: (String -> String) -> Name -> [Name] -> Name -> [DefName]
fieldName :: (String -> String) -> Name -> [Name] -> Name -> [DefName]
fieldName String -> String
f Name
_ [Name]
_ Name
name = [Name -> DefName
TopName (Name -> DefName) -> (Name -> Name) -> Name -> DefName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Name) -> (Name -> String) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase (Name -> DefName) -> Name -> DefName
forall a b. (a -> b) -> a -> b
$ Name
name]

makeLenses :: Name -> Q [Dec]
makeLenses :: Name -> Q [Dec]
makeLenses = LensRules -> Name -> Q [Dec]
makeLensesWith (LensRules
defaultRules LensRules -> (LensRules -> LensRules) -> LensRules
forall a b. a -> (a -> b) -> b
& ((Name -> [Name] -> Name -> [DefName])
 -> Identity (Name -> [Name] -> Name -> [DefName]))
-> LensRules -> Identity LensRules
Lens' LensRules (Name -> [Name] -> Name -> [DefName])
lensField (((Name -> [Name] -> Name -> [DefName])
  -> Identity (Name -> [Name] -> Name -> [DefName]))
 -> LensRules -> Identity LensRules)
-> (Name -> [Name] -> Name -> [DefName]) -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> String) -> Name -> [Name] -> Name -> [DefName]
fieldName String -> String
forall a. a -> a
id)

toCamelCase :: String -> String
toCamelCase :: String -> String
toCamelCase (Char
x0:String
x0s)  = Char
x0 Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
x0s
  where go :: String -> String
go (Char
'_':Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
        go (Char
x:String
xs)     = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
        go []         = []
toCamelCase []        = []