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.
--
-- 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
-- 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.