{-# LANGUAGE TemplateHaskell #-}
module Data.Has.TH (field) where

import Control.Arrow       ((&&&))
import Data.Char           (toUpper)
import Data.Has            hiding (field)
import Language.Haskell.TH
    
-- | Define a Has field.
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