X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FCodegen.hs;fp=src%2FTSN%2FCodegen.hs;h=9095cefe6860ff5f8837ec1a1fa42fa6a47cceaf;hb=88b80555c3df3649799c8caa4de8d9c87c50be45;hp=467f86b7ef3fd64526063208ba9d219d6c24f8fe;hpb=4ab5b57dc58b2b1d75c89c3e7e8bf0e7269ec29e;p=dead%2Fhtsn-import.git diff --git a/src/TSN/Codegen.hs b/src/TSN/Codegen.hs index 467f86b..9095cef 100644 --- a/src/TSN/Codegen.hs +++ b/src/TSN/Codegen.hs @@ -1,31 +1,51 @@ +-- | Modifications to the code generation used in Groundhog. +-- module TSN.Codegen ( tsn_codegen_config, tsn_db_field_namer -- Used in a TSN.XML.News test. ) where -import Data.Char ( toLower, toUpper ) +import Data.Char ( toUpper ) import Data.List.Utils ( join, split ) import Database.Groundhog.TH ( CodegenConfig ( namingStyle ), - NamingStyle ( mkDbConstrName, mkDbFieldName, mkExprFieldName ), + 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 + -- | 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 @@ -33,10 +53,17 @@ tsn_expr_field_namer _ _ _ fieldname _ = 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 = 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 }