]> gitweb.michael.orlitzky.com - dead/htsn-import.git/commitdiff
Add a selector namer (that handles leading underscores) to our codegen.
authorMichael Orlitzky <michael@orlitzky.com>
Fri, 2 Jan 2015 21:54:20 +0000 (16:54 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Fri, 2 Jan 2015 21:54:20 +0000 (16:54 -0500)
src/TSN/Codegen.hs

index cd8e20936648fa7db46c00c982f02a923990b4f3..d002823b24d33ea00a22bcebd21faec30add48d5 100644 (file)
@@ -10,7 +10,7 @@ import Data.Char ( toUpper )
 import Data.List.Utils ( join, split )
 import Database.Groundhog.TH (
   CodegenConfig ( namingStyle ),
-  NamingStyle ( mkDbFieldName, mkExprFieldName ),
+  NamingStyle ( mkDbFieldName, mkExprFieldName, mkExprSelectorName ),
   defaultCodegenConfig,
   lowerCaseSuffixNamingStyle )
 
@@ -75,12 +75,30 @@ tsn_expr_field_namer _ _ _ fieldname _ =
     capitalize (c:cs) = (toUpper c : cs)
 
 
+-- | An expression selector creator. This is needed for embedded
+--   types, when Groundhog generates the stuff for it. The default is
+--   almost OK, but if a field name has leading underscores, they're
+--   left intact. The result is invalid. So, this strips them before
+--   doing whatever the default implementation would do.
+--
+--   >>> tsn_expr_selector_namer "MyFoo" "MyBar" "_db_derp" 0
+--   "Db_derpSelector"
+--
+tsn_expr_selector_namer :: String -> String -> String -> Int -> String
+tsn_expr_selector_namer dn cn fn fp =
+  the_default dn cn (strip_leading_underscore fn) fp
+  where
+    the_default = mkExprSelectorName lowercase_ns
+
+
 -- | Combine the modifications above into a new naming style based on
 --   the 'lowecase_ns'.
 --
 tsn_naming_style :: NamingStyle
-tsn_naming_style = lowercase_ns { mkDbFieldName = tsn_db_field_namer,
-                                  mkExprFieldName = tsn_expr_field_namer }
+tsn_naming_style =
+  lowercase_ns { mkDbFieldName = tsn_db_field_namer,
+                 mkExprFieldName = tsn_expr_field_namer,
+                 mkExprSelectorName = tsn_expr_selector_namer }
 
 -- | Create a 'CodegenConfig' by replacing the default 'namingStyle'
 --   with our modified version.