[Haskelldb-users] Using template haskell to create pseudo columns

[Justin B. <jgb...@gm...>]

Adding pseudo columns to a projection is cumbersome, to say the list.
For example, to add a field named "hidden" to a query I have to write:

  data Hide = Hide
  instance FieldTag Hide where
    fieldName _ = "hide"

  hideField = mkAttr Hide

I wrote a little Template haskell that reduces this to:

  $(mkField "hide")

If you want to customize the name of the column in the generated SQL,
another function is used:

  $(mkFieldWithName "NumPullingParts" "num_pulling_parts")

The code is below. Some questions:

  * Does the code look reasonable and useful?
  * Would the haskelldb maintainers want to introduce a dependency on
template haskell to haskelldb for this kind of code?
  * Otherwise, would an "extensions" package make sense?

If the reaction is positive, I'll work on extending this for a patch.
My heartfelt thanks to Bulat for his excellent template haskell
tutorials. I really wish that library had better documentation!

Justin

mkField :: String -> Q [Dec]
mkField [] = error "Can't generate field from an empty string."
mkField f =
  let fieldType = if isUpper (head f) then f else (toUpper (head f)) : tail f
      colName = if isLower (head f) then f else (toLower (head f)) : tail f
  in mkFieldWithName fieldType colName

-- ^ Creates a compile time field declaration using the given
-- arguments for the type and column name of the field. The fieldType argument
-- is used to produce the "<field name>Field" function which can be used to
-- add the field to a projection.
--
-- Note that an error will occur if fieldType is not a proper
type/constructor name.
mkFieldWithName :: String -> String -> Q [Dec]
mkFieldWithName [] _ = error "Can't create a field with an empty type."
mkFieldWithName _ [] = error "Can't create a field with an empty column name."
mkFieldWithName fieldType colName =
  let ty = mkName fieldType
      fieldName = toLower (head fieldType) : tail fieldType
      fieldD = [DataD [] ty [] [NormalC ty []] []]
      fieldI = [InstanceD [] (AppT (ConT (mkName
"Database.HaskellDB.HDBRec.FieldTag"))
                                   (ConT ty)) [FunD (mkName
"fieldName") [Clause [WildP]
                                                      (NormalB (LitE
(StringL colName))) []]]]
      fieldF = [ValD (VarP (mkName (fieldName ++ "Field"))) (NormalB
(AppE (VarE (mkName "Database.HaskellDB.DBLayout.mkAttr"))
                                                              (ConE ty))) []]
  in return (fieldD ++ fieldI ++ fieldF)