Commit bf66ff3a authored by MrMan's avatar MrMan

Delete working with a single test

parent bbfbc919
......@@ -305,6 +305,9 @@ instance SQLUpdatable (Partial (Task state)) where
data QueryWithParams p = QWP Query p
instance SQLDeletable (Task state) where
deletionMode = Hard
-- | 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) and params
(SQLInsertable (Complete entity),
......@@ -359,7 +362,7 @@ updateEntityByUUID :: forall entity.
-> UUID
-> Partial entity
-> IO (Either EntityStoreError (WithID 'UUIDID (Complete entity)))
updateEntityByUUID conn uuid partial = withTransaction conn updateAndCheckChnages
updateEntityByUUID conn uuid partial = withTransaction conn updateAndCheckChanges
>>= \case
1 -> getEntityByUUID conn uuid
_ -> pure $ Left $ UnexpectedErrorES "Update failed, no rows were changed"
......@@ -374,7 +377,31 @@ updateEntityByUUID conn uuid partial = withTransaction conn updateAndCheckChnage
updateQuery = Query $ [text| UPDATE $tbl SET $setPhrase WHERE uuid = ? |]
updateAndCheckChnages = execute conn updateQuery valuesWithID
updateAndCheckChanges = execute conn updateQuery valuesWithID
>> changes conn
deleteEntityByUUID :: forall entity.
( SQLInsertable (Complete entity)
, SQLDeletable entity
, FromRow (Complete entity)
, FromRow (WithID 'UUIDID (Complete entity)))
=> Connection
-> UUID
-> IO (Either EntityStoreError (WithID 'UUIDID (Complete entity)))
deleteEntityByUUID conn uuid = getEntityByUUID conn uuid
>>= rightOrThrow
>>= \beforeDelete -> withTransaction conn deleteAndCheckChanges
>>= \case
1 -> pure $ Right $ beforeDelete
_ -> pure $ Left $ UnexpectedErrorES "Delete failed, no rows were changed"
where
(TN tbl) = tableName :: TableName (Complete entity)
deleteQuery = case deletionMode :: DeletionMode entity of
Hard -> Query $ [text| DELETE FROM $tbl WHERE uuid = ? |]
Soft -> Query $ [text| UPDATE $tbl SET deleted=1 WHERE uuid = ? |]
deleteAndCheckChanges = execute conn deleteQuery (Only uuid)
>> changes conn
-- | Generalized typeclass for entity storage.
......@@ -405,4 +432,10 @@ instance SQLEntityStore SQLiteEntityStore where
>>= pure . Right . uuidToGenericIdent
_ -> pure $ Left $ UnsupportedOperationES "integer-identified entities are currently unsupported"
deleteByID eid = undefined
deleteByID store eid = withActiveConn store _work
where
_work conn = case eid of
(Left uuid) -> deleteEntityByUUID conn uuid
>>= rightOrThrow
>>= pure . Right . uuidToGenericIdent
_ -> pure $ Left $ UnsupportedOperationES "integer-identified entities are currently unsupported"
......@@ -311,6 +311,12 @@ class SQLUpdatable e where
updateColumnGetters :: e -> [(SQLColumnName, e -> Maybe SQLData)]
data DeletionMode e = Soft
| Hard deriving (Eq, Show, Read)
class SQLDeletable entity where
deletionMode :: DeletionMode entity
-- | Generalized typeclass for entity storage.
class SQLEntityStore store where
-- | Create an entity
......@@ -342,7 +348,9 @@ class SQLEntityStore store where
-- | Delete an entity by ID
deleteByID :: forall (ident :: Identifier) (entity :: FBounded).
FromRow (Complete entity)
( SQLInsertable (Complete entity)
, SQLDeletable entity
, FromRow (Complete entity))
=> store
-> EntityID
-> IO (Either EntityStoreError (WithID ident (Complete entity)))
......@@ -6,22 +6,24 @@
module Components.EntityStore.SQLiteSpec (spec) where
import Components.EntityStore.SQLite (SQLiteEntityStore)
import Types ( Constructable(..)
, HasMigratableDB(..)
, ValidationError
, SQLEntityStore(..)
import Control.Monad (when)
import Types ( Complete
, Constructable(..)
, EntityStoreError
, SQLMigrationVersion(..)
, Validated
, Validatable(..)
, FullySpecifiedTask
, HasMigratableDB(..)
, NotStartedTask
, TaskState(..)
, Partial
, SQLEntityStore(..)
, SQLInsertable
, SQLMigrationVersion(..)
, Task(..)
, TaskName(..)
, TaskDesc(..)
, Complete
, Partial
, TaskName(..)
, TaskState(..)
, Validatable(..)
, Validated
, ValidationError
, WithID(..)
, withoutID
, showID
......@@ -85,7 +87,7 @@ spec = do
-- | Generate and perform update
>>= \createdTask -> generateTaskNameUpdate
>>= \update -> case createdTask of
(WUUID uuid _ ) -> updateByID store (Left uuid) update
(WUUID uuid _) -> updateByID store (Left uuid) update
(WID (Left uuid) _) -> updateByID store (Left uuid) update
_ -> error "Unexpected thing received"
>>= rightOrThrow
......@@ -93,3 +95,28 @@ spec = do
>>= \updated -> pure ( showID updated /= "" &&
withoutID updated /= getValidatedObj original )
>>= (`shouldBe` True)
describe "entity store delete" $
it "works with default config" $ \_ -> liftIO makeDefaultStore
>>= rightOrThrow
>>= \store -> migrate store
>> generateTask
-- | Create a task
>>= \original -> create store original
>>= rightOrThrow
-- | Delete the created task right after creating it
>>= \created -> case created of
(WUUID uuid _) -> deleteByID store (Left uuid)
(WID (Left uuid) _) -> deleteByID store (Left uuid)
_ -> error "Unexpected thing received"
>>= rightOrThrow
-- | Ensure task returned by the deletion matches created one
>>= \deleted -> when (withoutID deleted /= getValidatedObj original) (error "returned deleted object mismatch")
-- | Ensure that a get with the deleted item's ID fails
>> let
-- | Unfortunately we have to give GHC some hints so it can work out what's supposed to come out of get
getFn uuid = getByID store (Left uuid) :: IO (Either EntityStoreError (WithID ident (Complete (Task state)))) in
case created of
(WUUID uuid _) -> getFn uuid `shouldThrow` anyException
(WID (Left uuid) _) -> getFn uuid `shouldThrow` anyException
_ -> expectationFailure "uuid missing when ensuring get failed"
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