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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase 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 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
.~ (String -> String) -> Name -> [Name] -> Name -> [DefName]
fieldName forall a. a -> a
id)

toCamelCase :: String -> String
toCamelCase :: String -> String
toCamelCase (Char
x0:String
x0s)  = Char
x0 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 forall a. a -> [a] -> [a]
: String -> String
go String
xs
        go (Char
x:String
xs)     = Char
x forall a. a -> [a] -> [a]
: String -> String
go String
xs
        go []         = []
toCamelCase []        = []