]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blob - src/TSN/Codegen.hs
Add a minor TODO note.
[dead/htsn-import.git] / src / TSN / Codegen.hs
1 -- | Modifications to the code generation used in Groundhog.
2 --
3 module TSN.Codegen (
4 tsn_codegen_config,
5 tsn_db_field_namer -- Used in a TSN.XML.News test.
6 )
7 where
8
9 import Data.Char ( toUpper )
10 import Data.List.Utils ( join, split )
11 import Database.Groundhog.TH (
12 CodegenConfig ( namingStyle ),
13 NamingStyle ( mkDbFieldName, mkExprFieldName ),
14 defaultCodegenConfig,
15 lowerCaseSuffixNamingStyle )
16
17
18 -- | The lowercase naming style for database entities, provided by
19 -- Groundhog. Makes a better starting point than the default.
20 --
21 lowercase_ns :: NamingStyle
22 lowercase_ns = lowerCaseSuffixNamingStyle
23
24
25 -- | A database field name creator. It takes the field name (from a
26 -- record type) and drops the first component determined by
27 -- underscores. So, foo_bar_baz would get mapped to bar_baz in the
28 -- database.
29 --
30 -- Examples:
31 --
32 -- >>> tsn_db_field_namer "herp" "derp" 0 "xml_player_name" 0
33 -- "player_name"
34 --
35 tsn_db_field_namer :: String -> String -> Int -> String -> Int -> String
36 tsn_db_field_namer _ _ _ fieldname _ =
37 (join "_") . tail . (split "_") $ fieldname
38
39
40 -- | An expression field name creator. \"Expression\" in the context
41 -- of Groundhog means a constructor/type that you can use in queries
42 -- and update statement. We take the field name (from a record type)
43 -- as an argument and capitalize the first letter of each word.
44 --
45 -- Examples:
46 --
47 -- >>> tsn_expr_field_namer "herp" "derp" 0 "foo_bar" 0
48 -- "Foo_Bar"
49 --
50 tsn_expr_field_namer :: String -> String -> Int -> String -> Int -> String
51 tsn_expr_field_namer _ _ _ fieldname _ =
52 (join "_") . (map capitalize) . (split "_") $ fieldname
53 where
54 capitalize [] = []
55 capitalize (c:cs) = (toUpper c : cs)
56
57
58 -- | Combine the modifications above into a new naming style based on
59 -- the 'lowecase_ns'.
60 --
61 tsn_naming_style :: NamingStyle
62 tsn_naming_style = lowercase_ns { mkDbFieldName = tsn_db_field_namer,
63 mkExprFieldName = tsn_expr_field_namer }
64
65 -- | Create a 'CodegenConfig' by replacing the default 'namingStyle'
66 -- with our modified version.
67 --
68 tsn_codegen_config :: CodegenConfig
69 tsn_codegen_config =
70 defaultCodegenConfig { namingStyle = tsn_naming_style }