Strip leading underscores in our Groundhog codegen.

[dead/htsn-import.git] / src / TSN / Codegen.hs

diff --git a/src/TSN/Codegen.hs b/src/TSN/Codegen.hs
index 38aede40cae87a672ff862143ff950a34b899abd..cd8e20936648fa7db46c00c982f02a923990b4f3 100644 (file)
--- a/src/TSN/Codegen.hs
+++ b/src/TSN/Codegen.hs
@@ -1,43 +1,90 @@
+-- | 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 ),
-  defaultCodegenConfig )
+  NamingStyle ( mkDbFieldName, mkExprFieldName ),
+  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.
+--
+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.
+--
+--   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
 
-tsn_db_constr_namer :: String -> String -> Int -> String
-tsn_db_constr_namer _ constrname _ =
-  map toLower constrname
 
+-- | 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.
+--
+--   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)
 
+
+-- | Combine the modifications above into a new naming style based on
+--   the 'lowecase_ns'.
+--
 tsn_naming_style :: NamingStyle
-tsn_naming_style = default_ns { mkDbConstrName = tsn_db_constr_namer,
-                                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 }
 
+-- | Create a 'CodegenConfig' by replacing the default 'namingStyle'
+--   with our modified version.
+--
 tsn_codegen_config :: CodegenConfig
 tsn_codegen_config =
   defaultCodegenConfig { namingStyle = tsn_naming_style }