Commit 5c9e849f authored by MrMan's avatar MrMan

Passing simple test with create

parent f1534073
......@@ -280,27 +280,22 @@ instance forall e. SQLInsertable e => SQLInsertable (WithID 'INT64ID e) where
where
(SQLCN innerCols) = columnNames :: SQLColumnNames e
data QueryWithParams = QWP Query [SQLData]
data QueryWithParams p = QWP Query p
-- | Build the insertion SQL query for a given entity with it's ID
buildInsertQuery :: forall (ident :: Identifier) (entity :: FBounded). -- | polymorphic over entities and identifiers (uuid/int64)
buildInsertQuery :: forall (ident :: Identifier) (entity :: FBounded). -- | polymorphic over entities and identifiers (uuid/int64) and params
(SQLInsertable (Complete entity),
SQLInsertable (WithID ident (Complete entity))) -- | entity must be insertable under SQL & complete w/ an ID
=> WithID ident (Complete entity)
-> QueryWithParams
buildInsertQuery = makeInsertQuery tblName cNames
-> QueryWithParams (WithID ident (Complete entity))
buildInsertQuery = QWP insertQuery
where
tblName = tableName :: TableName (WithID ident (Complete entity))
cNames = columnNames :: SQLColumnNames (WithID ident (Complete entity))
(TN tbl) = tableName :: TableName (WithID ident (Complete entity))
(SQLCN cols) = columnNames :: SQLColumnNames (WithID ident (Complete entity))
-- | Build the insertion query for a given entity
makeInsertQuery :: (SQLInsertable entity, ToRow entity) => TableName entity -> SQLColumnNames entity -> entity -> QueryWithParams
makeInsertQuery (TN tbl) (SQLCN colNames) entity = QWP insertQuery params
where
columnPhrase = DT.intercalate "," cols
valueQs = DT.intercalate "," $ replicate (length cols) "?"
insertQuery = Query $ [text| INSERT INTO $tbl ( $columnPhrase ) VALUES ( $valueQs ) |]
columnPhrase = DT.intercalate "," colNames
valueQs = DT.intercalate "," $ replicate (length colNames) "?"
params = toRow entity
-- | Do the actual insertion for an entity
insertEntity :: forall (ident :: Identifier) entity.
......@@ -318,28 +313,19 @@ insertEntity conn e@(WUUID uuid _) = Right <$> execute conn query params
getEntityByUUID :: forall entity.
( SQLInsertable entity
, FromRow entity
, FromRow (WithID 'UUIDID entity))
, FromRow (WithID 'UUIDID entity)
, ToRow (WithID 'UUIDID entity))
=> Connection
-> UUID
-> IO (Either EntityStoreError (WithID 'UUIDID entity))
getEntityByUUID conn uuid = pure (makeSelectByUUIDQuery tableName uuid)
-- >>= \(QWP q p) -> (query conn q p :: IO [WithID 'UUIDID entity])
>>= \(QWP q p) -> (query_ conn (Query "SELECT * FROM tasks LIMIT 1") :: IO [WithID 'UUIDID entity]) -- undefined -- q p
getEntityByUUID conn uuid = (query conn selectQuery (Only uuid) :: IO [WithID 'UUIDID entity])
>>= \case
-- Not 100% percent sure which GADT constructor will get used (there might be a rule for this)
-- So I march all possible ways that a UUID thing comes back
(v@WUUID{}:_) -> pure $ Right v
(v@(WID (Left uuid) inner):_) -> pure $ Right $ WID (Left uuid) inner
_ -> pure $ Left $ NoSuchEntityES (Left uuid) "Failed to find task with given UUID"
where
tableName = tableName :: TableName (WithID 'UUIDID entity)
-- | Create the select query for an entity
makeSelectByUUIDQuery :: SQLInsertable entity => TableName entity -> UUID -> QueryWithParams
makeSelectByUUIDQuery (TN tbl) uuid = QWP query (toRow (Only uuid))
where
uuidTxt = toText uuid
query = Query $ [text| SELECT * FROM $tbl WHERE uuid = $uuidTxt |]
(TN tbl) = tableName :: TableName (WithID 'UUIDID entity)
selectQuery = Query $ [text| SELECT * FROM $tbl WHERE uuid = ? |]
-- | Generalized typeclass for entity storage.
instance SQLEntityStore SQLiteEntityStore where
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment