+-- | Modifications to the code generation used in Groundhog.
+--
module TSN.Codegen (
- tsn_codegen_config )
+ tsn_codegen_config,
+ tsn_db_field_namer -- Used in a TSN.XML.News test.
+ )
where
+import Data.Char ( toUpper )
import Data.List.Utils ( join, split )
import Database.Groundhog.TH (
CodegenConfig ( namingStyle ),
- NamingStyle ( mkDbFieldName ),
- defaultCodegenConfig )
+ NamingStyle ( mkDbFieldName, mkExprFieldName ),
+ defaultCodegenConfig,
+ lowerCaseSuffixNamingStyle )
+
+
+-- | The lowercase naming style for database entities, provided by
+-- Groundhog. Makes a better starting point than the default.
+--
+lowercase_ns :: NamingStyle
+lowercase_ns = lowerCaseSuffixNamingStyle
-default_ns :: NamingStyle
-default_ns = namingStyle defaultCodegenConfig
-- | A database field name creator. It takes the field name (from a
-- record type) and drops the first component determined by
-- underscores. So, foo_bar_baz would get mapped to bar_baz in the
-- database.
+--
+-- Examples:
+--
+-- >>> tsn_db_field_namer "herp" "derp" 0 "xml_player_name" 0
+-- "player_name"
+--
tsn_db_field_namer :: String -> String -> Int -> String -> Int -> String
tsn_db_field_namer _ _ _ fieldname _ =
(join "_") . tail . (split "_") $ fieldname
+
+-- | An expression field name creator. \"Expression\" in the context
+-- of Groundhog means a constructor/type that you can use in queries
+-- and update statement. We take the field name (from a record type)
+-- as an argument and capitalize the first letter of each word.
+--
+-- Examples:
+--
+-- >>> 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
+ where
+ capitalize [] = []
+ capitalize (c:cs) = (toUpper c : cs)
+
+
+-- | Combine the modifications above into a new naming style based on
+-- the 'lowecase_ns'.
+--
tsn_naming_style :: NamingStyle
-tsn_naming_style = default_ns { mkDbFieldName = tsn_db_field_namer }
+tsn_naming_style = lowercase_ns { mkDbFieldName = tsn_db_field_namer,
+ mkExprFieldName = tsn_expr_field_namer }
+-- | Create a 'CodegenConfig' by replacing the default 'namingStyle'
+-- with our modified version.
+--
tsn_codegen_config :: CodegenConfig
tsn_codegen_config =
defaultCodegenConfig { namingStyle = tsn_naming_style }