{-# LANGUAGE TemplateHaskell #-}
module Data.Setters
  (declareSetters,
   declareSetters'
  )
  where

import Data.Char
import Language.Haskell.TH

-- | Declare setters for all fields of given `data' type.
-- For example, for 
--
-- > data Record = Record {
-- >       ...
-- >       someField :: Integer,
-- >       ... }
--
-- one will automatically get
--
-- > someField :: Record -> Integer.
--
-- After calling
--
-- > $(declareSetters ''Record)
--
-- one will get
--
-- > setSomeField :: Integer -> Record -> Record.
declareSetters :: Name -> Q [Dec]
declareSetters name = do
  (TyConI (DataD _ _ _ cons _)) <- reify name
  return $ concatMap (conSetters "") cons

-- | Similar to 'declareSetters', but add data type name to all setters' names.
-- For example, one will get `setRecordSomeField' instead of `setSomeField'.
declareSetters' :: Name -> Q [Dec]
declareSetters' name = do
  (TyConI (DataD _ _ _ cons _)) <- reify name
  return $ concatMap (conSetters $ nameBase name) cons

conSetters :: String -> Con -> [Dec]
conSetters prefix (RecC _ fields) = map (fieldSetter prefix) fields
conSetters prefix _               = []

capitalize :: String -> String
capitalize [] = []
capitalize (x:xs) = toUpper x: xs

fieldSetter :: String -> (Name, Strict, Type) -> Dec
fieldSetter prefix (name, _, _) =
  let name'  = mkName $ "set" ++ capitalize prefix ++ (capitalize $ nameBase name)
      record = mkName "record"
      value  = mkName "value"
      body   = RecUpdE (VarE record) [(name, VarE value)]
      clause = Clause [VarP value, VarP record] (NormalB body) []
  in  FunD name' [clause]