X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=blobdiff_plain;f=src%2FTSN%2FCodegen.hs;h=d002823b24d33ea00a22bcebd21faec30add48d5;hp=0e8026d53eb068bc45128aa26c86e84ffc4aaea0;hb=b6954f1cbea42591c7b34504d21543e37bd83f27;hpb=e3272460a03b4bdded1902467310a4190feb333f

diff --git a/src/TSN/Codegen.hs b/src/TSN/Codegen.hs
index 0e8026d..d002823 100644
--- a/src/TSN/Codegen.hs
+++ b/src/TSN/Codegen.hs
@@ -10,11 +10,15 @@ 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 )
 
 
+strip_leading_underscore :: String -> String
+strip_leading_underscore ('_' : rest) = rest
+strip_leading_underscore s = s
+
 -- | The lowercase naming style for database entities, provided by
 --   Groundhog. Makes a better starting point than the default.
 --
@@ -27,14 +31,23 @@ lowercase_ns = lowerCaseSuffixNamingStyle
 --   underscores. So, foo_bar_baz would get mapped to bar_baz in the
 --   database.
 --
---   Examples:
+--   Leading underscores are ignored, as those are used to hide unused
+--   field warnings.
+--
+--   ==== __Examples__
 --
 --   >>> tsn_db_field_namer "herp" "derp" 0 "xml_player_name" 0
 --   "player_name"
 --
+--   >>> tsn_db_field_namer "herp" "derp" 0 "db_player_name" 0
+--   "player_name"
+--
+--   >>> tsn_db_field_namer "herp" "derp" 0 "_db_player_name" 0
+--   "player_name"
+--
 tsn_db_field_namer :: String -> String -> Int -> String -> Int -> String
 tsn_db_field_namer _ _ _ fieldname _ =
-  (join "_") . tail . (split "_") $ fieldname
+  (join "_") . tail . (split "_") $ strip_leading_underscore fieldname
 
 
 -- | An expression field name creator. \"Expression\" in the context
@@ -42,25 +55,50 @@ tsn_db_field_namer _ _ _ fieldname _ =
 --   and update statement. We take the field name (from a record type)
 --   as an argument and capitalize the first letter of each word.
 --
---   Examples:
+--   Leading underscores are ignored, as those are used to hide unused
+--   field warnings.
+--
+--   ==== __Examples__
 --
 --   >>> tsn_expr_field_namer "herp" "derp" 0 "foo_bar" 0
 --   "Foo_Bar"
 --
+--   >>> tsn_expr_field_namer "herp" "derp" 0 "_foo_bar" 0
+--   "Foo_Bar"
+--
 tsn_expr_field_namer :: String -> String -> Int -> String -> Int -> String
 tsn_expr_field_namer _ _ _ fieldname _ =
-  (join "_") . (map capitalize) . (split "_") $ fieldname
+  (join "_") . (map capitalize) . (split "_") $
+    strip_leading_underscore fieldname
   where
     capitalize [] = []
     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.