mirror of https://github.com/voidlizard/hbs2
adding-table-name
This commit is contained in:
parent
32804444c6
commit
cef12180a7
|
@ -32,6 +32,9 @@ class HasColumnNames a where
|
|||
default columnNames :: (Generic a, GHasColumnNames (Rep a)) => a -> [SQLName]
|
||||
columnNames = gColumnNames . from
|
||||
|
||||
class HasTableName t where
|
||||
tableName :: SQLName
|
||||
|
||||
class HasColumnName a where
|
||||
columnName :: SQLName
|
||||
|
||||
|
@ -64,11 +67,11 @@ columnListPart w = SQLPart $ Text.intercalate "," [ coerce @_ @Text x | x <- col
|
|||
bindListPart :: forall a . HasColumnNames a => a -> SQLPart
|
||||
bindListPart w = SQLPart $ Text.intercalate "," [ "?" | _ <- columnNames w ]
|
||||
|
||||
class HasColumnNames b => Insert b where
|
||||
class (HasTableName t, HasColumnNames b) => Insert t b where
|
||||
insert :: b -> SQLPart
|
||||
|
||||
instance HasColumnNames b => Insert b where
|
||||
insert values = [qc|insert into jopakita values({v}) ({n})|]
|
||||
instance (HasTableName t, HasColumnNames b) => Insert t b where
|
||||
insert values = [qc|insert into {tableName @t} values({v}) ({n})|]
|
||||
where
|
||||
n = bindListPart values
|
||||
v = columnListPart values
|
||||
|
|
|
@ -97,4 +97,16 @@ instance ToField (RefLogKey HBS2Basic) where
|
|||
instance (FromField (RefLogKey HBS2Basic)) where
|
||||
fromField x = fromField @String x <&> fromString
|
||||
|
||||
instance HasColumnName GitLwwRef where
|
||||
columnName = "lwwref"
|
||||
|
||||
instance HasColumnName GitLwwSeq where
|
||||
columnName = "lwwseq"
|
||||
|
||||
instance HasColumnName GitRefLog where
|
||||
columnName = "reflog"
|
||||
|
||||
instance HasTableName GitRepoFacts where
|
||||
tableName = "gitrepofact"
|
||||
|
||||
|
||||
|
|
|
@ -96,23 +96,10 @@ isTxProcessed hash = do
|
|||
|
||||
|
||||
|
||||
instance HasColumnName GitLwwRef where
|
||||
columnName = "lwwref"
|
||||
|
||||
instance HasColumnName GitLwwSeq where
|
||||
columnName = "lwwseq"
|
||||
|
||||
instance HasColumnName GitRefLog where
|
||||
columnName = "reflog"
|
||||
|
||||
|
||||
-- instance HasTableName GitRepoFacts where
|
||||
-- tableName = "gitrepofact"
|
||||
|
||||
|
||||
insertRepoFacts :: (MonadUnliftIO m) => GitRepoFacts -> DBPipeM m ()
|
||||
insertRepoFacts GitRepoFacts{..} = do
|
||||
let sql = insert ( gitLwwRef
|
||||
let sql = insert @GitRepoFacts
|
||||
( gitLwwRef
|
||||
, gitLwwSeq
|
||||
, gitRefLog
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue