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
63
|
module Database.Persist.EntityDef
( -- * Helper types
HaskellName (..)
, DBName (..)
, Attr
-- * Defs
, EntityDef (..)
, FieldDef (..)
, FieldType (..)
, UniqueDef (..)
, ExtraLine
-- * Utils
, stripId
) where
import Data.Text (Text, stripSuffix, pack)
import Data.Map (Map)
data EntityDef = EntityDef
{ entityHaskell :: HaskellName
, entityDB :: DBName
, entityID :: DBName
, entityAttrs :: [Attr]
, entityFields :: [FieldDef]
, entityUniques :: [UniqueDef]
, entityDerives :: [Text]
, entityExtra :: Map Text [ExtraLine]
}
deriving (Show, Eq, Read, Ord)
type ExtraLine = [Text]
newtype HaskellName = HaskellName { unHaskellName :: Text }
deriving (Show, Eq, Read, Ord)
newtype DBName = DBName { unDBName :: Text }
deriving (Show, Eq, Read, Ord)
type Attr = Text
data FieldType
= FTTypeCon (Maybe Text) Text -- ^ optional module, name
| FTApp FieldType FieldType
| FTList FieldType
deriving (Show, Eq, Read, Ord)
data FieldDef = FieldDef
{ fieldHaskell :: HaskellName
, fieldDB :: DBName
, fieldType :: FieldType
, fieldAttrs :: [Attr]
}
deriving (Show, Eq, Read, Ord)
data UniqueDef = UniqueDef
{ uniqueHaskell :: HaskellName
, uniqueDBName :: DBName
, uniqueFields :: [(HaskellName, DBName)]
}
deriving (Show, Eq, Read, Ord)
stripId :: FieldType -> Maybe Text
stripId (FTTypeCon Nothing t) = stripSuffix (pack "Id") t
stripId _ = Nothing
|
