1 -- | Modifications to the code generation used in Groundhog.
5 tsn_db_field_namer -- Used in a TSN.XML.News test.
9 import Data.Char ( toUpper )
10 import Data.List.Utils ( join, split )
11 import Database.Groundhog.TH (
12 CodegenConfig ( namingStyle ),
13 NamingStyle ( mkDbFieldName, mkExprFieldName, mkExprSelectorName ),
15 lowerCaseSuffixNamingStyle )
18 strip_leading_underscore :: String -> String
19 strip_leading_underscore ('_' : rest) = rest
20 strip_leading_underscore s = s
22 -- | The lowercase naming style for database entities, provided by
23 -- Groundhog. Makes a better starting point than the default.
25 lowercase_ns :: NamingStyle
26 lowercase_ns = lowerCaseSuffixNamingStyle
29 -- | A database field name creator. It takes the field name (from a
30 -- record type) and drops the first component determined by
31 -- underscores. So, foo_bar_baz would get mapped to bar_baz in the
34 -- Leading underscores are ignored, as those are used to hide unused
39 -- >>> tsn_db_field_namer "herp" "derp" 0 "xml_player_name" 0
42 -- >>> tsn_db_field_namer "herp" "derp" 0 "db_player_name" 0
45 -- >>> tsn_db_field_namer "herp" "derp" 0 "_db_player_name" 0
48 tsn_db_field_namer :: String -> String -> Int -> String -> Int -> String
49 tsn_db_field_namer _ _ _ fieldname _ =
50 (join "_") . tail . (split "_") $ strip_leading_underscore fieldname
53 -- | An expression field name creator. \"Expression\" in the context
54 -- of Groundhog means a constructor/type that you can use in queries
55 -- and update statement. We take the field name (from a record type)
56 -- as an argument and capitalize the first letter of each word.
58 -- Leading underscores are ignored, as those are used to hide unused
63 -- >>> tsn_expr_field_namer "herp" "derp" 0 "foo_bar" 0
66 -- >>> tsn_expr_field_namer "herp" "derp" 0 "_foo_bar" 0
69 tsn_expr_field_namer :: String -> String -> Int -> String -> Int -> String
70 tsn_expr_field_namer _ _ _ fieldname _ =
71 (join "_") . (map capitalize) . (split "_") $
72 strip_leading_underscore fieldname
75 capitalize (c:cs) = (toUpper c : cs)
78 -- | An expression selector creator. This is needed for embedded
79 -- types, when Groundhog generates the stuff for it. The default is
80 -- almost OK, but if a field name has leading underscores, they're
81 -- left intact. The result is invalid. So, this strips them before
82 -- doing whatever the default implementation would do.
84 -- >>> tsn_expr_selector_namer "MyFoo" "MyBar" "_db_derp" 0
87 tsn_expr_selector_namer :: String -> String -> String -> Int -> String
88 tsn_expr_selector_namer dn cn fn =
89 the_default dn cn (strip_leading_underscore fn)
91 the_default = mkExprSelectorName lowercase_ns
94 -- | Combine the modifications above into a new naming style based on
97 tsn_naming_style :: NamingStyle
99 lowercase_ns { mkDbFieldName = tsn_db_field_namer,
100 mkExprFieldName = tsn_expr_field_namer,
101 mkExprSelectorName = tsn_expr_selector_namer }
103 -- | Create a 'CodegenConfig' by replacing the default 'namingStyle'
104 -- with our modified version.
106 tsn_codegen_config :: CodegenConfig
108 defaultCodegenConfig { namingStyle = tsn_naming_style }