module Data.Has.TH (field) where
import Control.Arrow ((&&&))
import Data.Char (toUpper)
import Data.Has hiding (field)
import Language.Haskell.TH
field :: String
-> TypeQ
-> Q [Dec]
field typeStr colTypeQ = do
colType <- colTypeQ
return [dataDef,instanceDef colType,valSig,valDef]
where
dataDef = DataD [] typeName [] [NormalC typeName []] []
instanceDef ct = TySynInstD ''TypeOf [ConT typeName] ct
valSig = SigD valName $ ConT typeName
valDef = VarP valName `ValD` NormalB (ConE typeName) $ []
valName = mkName $ typeStr
typeName = mkName $ uncurry (:) $ (toUpper . head &&& tail) $ typeStr