Copyright | (c) Ole Krüger 2016 |
---|---|
License | BSD3 |
Maintainer | Ole Krüger <ole@vprsm.de> |
Safe Haskell | None |
Language | Haskell2010 |
- data Table = Table {
- tableName :: ByteString
- tableCols :: [ByteString]
- class Entity a => TableEntity a where
- genTableName :: Table -> QueryGenerator a
- genTableColumns :: Table -> QueryGenerator a
- genTableColumnsOn :: Table -> ByteString -> QueryGenerator a
- type GenericTable a = (Generic a, GTable (AnalyzeTable a))
- describeGenericTable :: forall a. GenericTable a => Tagged a Table
- data KColumns
- data KTable = TTable Symbol KColumns
- class GColumns rec where
- class GTable tbl where
- type family AnalyzeRecordRep org (rec :: * -> *) :: KColumns where ...
- type family AnalyzeTableRep org (dat :: * -> *) :: KTable where ...
- type AnalyzeTable a = AnalyzeTableRep a (Rep a)
Table
Description of a table
Table | |
|
class Entity a => TableEntity a where Source #
Table entity with extra information about its name and column names
describeTableType :: Tagged a Table Source #
Describe the table type.
describeTableType :: GenericTable a => Tagged a Table Source #
Describe the table type.
genTableName :: Table -> QueryGenerator a Source #
Embed table name.
genTableColumns :: Table -> QueryGenerator a Source #
Embed a comma-seperated list of the table's columns.
genTableColumnsOn :: Table -> ByteString -> QueryGenerator a Source #
Same as genTableColumns
but expands the columns on an alias of the table name.
type GenericTable a = (Generic a, GTable (AnalyzeTable a)) Source #
Constraint for generic tables
describeGenericTable :: forall a. GenericTable a => Tagged a Table Source #
Fetch the table description for a generic table type.
Helpers
Type-level description of a record
class GColumns rec where Source #
Provide the means to demote KColumns
to a value.
gDescribeColumns :: Tagged rec [ByteString] Source #
Instantiate singleton
class GTable tbl where Source #
Provide the means to demote KTable
to a value.
gDescribeTable :: Tagged tbl Table Source #
Instantiate singleton
type family AnalyzeRecordRep org (rec :: * -> *) :: KColumns where ... Source #
AnalyzeRecordRep org (S1 (MetaSel (Just name) m1 m2 m3) (Rec0 typ)) = TSelector name typ | |
AnalyzeRecordRep org (S1 (MetaSel Nothing m1 m2 m3) a) = TypeError ((Text "Given type " :<>: ShowType org) :<>: Text " must have a single record constructor") | |
AnalyzeRecordRep org (lhs :*: rhs) = TCombine (AnalyzeRecordRep org lhs) (AnalyzeRecordRep org rhs) | |
AnalyzeRecordRep org U1 = TypeError ((Text "Given type " :<>: ShowType org) :<>: Text " has one constructor, therefore that constructor must have at least one field") | |
AnalyzeRecordRep org other = TypeError (((Text "Given type " :<>: ShowType org) :<>: Text " has a constructor with an invalid selector") :$$: ShowType other) |
type family AnalyzeTableRep org (dat :: * -> *) :: KTable where ... Source #
AnalyzeTableRep org (D1 meta1 (C1 (MetaCons name f True) sel)) = TTable name (AnalyzeRecordRep org sel) | |
AnalyzeTableRep org (D1 meta other) = TypeError ((Text "Given type " :<>: ShowType org) :<>: Text " must have a single record constructor") | |
AnalyzeTableRep org other = TypeError (((Text "Given type " :<>: ShowType org) :<>: Text " is not a valid data type") :$$: ShowType other) |
type AnalyzeTable a = AnalyzeTableRep a (Rep a) Source #
Analyzes a type in order to retrieve its KTable
representation.