1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
module Models where
import Data.Monoid
import Language.Haskell.TH
import qualified Data.Text as Text
import Database.Persist.Quasi
import Database.Persist.Quasi.Internal
import Database.Persist.TH
import Database.Persist.Sql
-- TODO: we use lookupName and reify etc which breaks in IO. somehow need to
-- test this out elsewise
mkPersist' :: [UnboundEntityDef] -> IO [Dec]
mkPersist' = runQ . mkPersist sqlSettings
parseReferences' :: String -> IO Exp
parseReferences' = runQ . parseReferencesQ
parseReferencesQ :: String -> Q Exp
parseReferencesQ = parseReferences lowerCaseSettings . Text.pack
-- | # of models, # of fields
mkModels :: Int -> Int -> String
mkModels = mkModelsWithFieldModifier id
mkNullableModels :: Int -> Int -> String
mkNullableModels = mkModelsWithFieldModifier maybeFields
mkModelsWithFieldModifier :: (String -> String) -> Int -> Int -> String
mkModelsWithFieldModifier k i f =
unlines . fmap unlines . take i . map mkModel . zip [0..] . cycle $
[ "Model"
, "Foobar"
, "User"
, "King"
, "Queen"
, "Dog"
, "Cat"
]
where
mkModel :: (Int, String) -> [String]
mkModel (i', m) =
(m <> show i') : indent 4 (map k (mkFields f))
indent :: Int -> [String] -> [String]
indent i = map (replicate i ' ' ++)
mkFields :: Int -> [String]
mkFields i = take i $ map mkField $ zip [0..] $ cycle
[ "Bool"
, "Int"
, "String"
, "Double"
, "Text"
]
where
mkField :: (Int, String) -> String
mkField (i', typ) = "field" <> show i' <> "\t\t" <> typ
maybeFields :: String -> String
maybeFields = (++ " Maybe")
|
