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]
|
default columnNames :: (Generic a, GHasColumnNames (Rep a)) => a -> [SQLName]
|
||||||
columnNames = gColumnNames . from
|
columnNames = gColumnNames . from
|
||||||
|
|
||||||
|
class HasTableName t where
|
||||||
|
tableName :: SQLName
|
||||||
|
|
||||||
class HasColumnName a where
|
class HasColumnName a where
|
||||||
columnName :: SQLName
|
columnName :: SQLName
|
||||||
|
|
||||||
|
@ -64,11 +67,11 @@ columnListPart w = SQLPart $ Text.intercalate "," [ coerce @_ @Text x | x <- col
|
||||||
bindListPart :: forall a . HasColumnNames a => a -> SQLPart
|
bindListPart :: forall a . HasColumnNames a => a -> SQLPart
|
||||||
bindListPart w = SQLPart $ Text.intercalate "," [ "?" | _ <- columnNames w ]
|
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
|
insert :: b -> SQLPart
|
||||||
|
|
||||||
instance HasColumnNames b => Insert b where
|
instance (HasTableName t, HasColumnNames b) => Insert t b where
|
||||||
insert values = [qc|insert into jopakita values({v}) ({n})|]
|
insert values = [qc|insert into {tableName @t} values({v}) ({n})|]
|
||||||
where
|
where
|
||||||
n = bindListPart values
|
n = bindListPart values
|
||||||
v = columnListPart values
|
v = columnListPart values
|
||||||
|
|
|
@ -97,4 +97,16 @@ instance ToField (RefLogKey HBS2Basic) where
|
||||||
instance (FromField (RefLogKey HBS2Basic)) where
|
instance (FromField (RefLogKey HBS2Basic)) where
|
||||||
fromField x = fromField @String x <&> fromString
|
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 :: (MonadUnliftIO m) => GitRepoFacts -> DBPipeM m ()
|
||||||
insertRepoFacts GitRepoFacts{..} = do
|
insertRepoFacts GitRepoFacts{..} = do
|
||||||
let sql = insert ( gitLwwRef
|
let sql = insert @GitRepoFacts
|
||||||
|
( gitLwwRef
|
||||||
, gitLwwSeq
|
, gitLwwSeq
|
||||||
, gitRefLog
|
, gitRefLog
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue