Commit 50835849 authored by MrMan's avatar MrMan

Working test for persistTask

parent aff8723c
......@@ -18,7 +18,7 @@ migrations =
uuid TEXT PRIMARY KEY NOT NULL,
name TEXT NOT NULL,
description TEXT NOT NULL,
status TEXT NOT NULL
state TEXT NOT NULL
);
|]
}
......
......@@ -120,7 +120,7 @@ makeGenericInsertError = pure . Left . UnexpectedError . ("INSERT command failed
saveAndReturnTask :: ToField state => Connection -> WithID (FullySpecifiedTask state) -> IO (Either TaskStoreError (WithID (FullySpecifiedTask state)))
saveAndReturnTask c t = catch doInsert makeGenericInsertError
where
doInsert = execute c "INSERT INTO tasks (uuid, name, desc, state) VALUES (?,?,?,?)" t
doInsert = execute c "INSERT INTO tasks (uuid, name, description, state) VALUES (?,?,?,?)" t
>> pure (Right t)
......
......@@ -75,6 +75,9 @@ newtype FieldName = FieldName { getFieldName :: DT.Text } deriving (Eq, Show, Re
data ValidationError = InvalidField FieldName
| MissingField FieldName deriving (Eq, Show, Read)
instance Exception ValidationError
instance Exception [ValidationError]
newtype Validated t = Validated { getValidatedObj :: t }
type ValidationCheck t = t -> Maybe ValidationError
......@@ -95,7 +98,12 @@ class Validatable t where
validationChecks :: [ValidationCheck t]
type FullySpecifiedTask = Task Identity
deriving instance Eq (FullySpecifiedTask TaskState)
deriving instance Show (FullySpecifiedTask TaskState)
type PartialTask = Task Maybe
deriving instance Eq (PartialTask TaskState)
deriving instance Show (PartialTask TaskState)
taskNameField :: FieldName
taskNameField = FieldName "name"
......@@ -176,6 +184,14 @@ data WithID a where
UUIDID :: UUID -> a -> WithID a
Int64ID :: Int64 -> a -> WithID a
withoutID :: WithID a -> a
withoutID (UUIDID _ a) = a
withoutID (Int64ID _ a) = a
showID :: WithID a -> String
showID (UUIDID v _) = show v
showID (Int64ID v _) = show v
-- | A typeclass consisting of types that can produce an ID usable by a SQL library to represent itself.
-- for example, if SQL library a can take `Int` for numeric IDs as well as `String`s for UUIDs, and id is an abstraction over both forms of ID,
-- then `getRowIDValue id` will produce the appropriate SQLValue for use in a query using the specified SQL library
......
{-# LANGUAGE OverloadedStrings #-}
module Components.TaskStore.SQLiteSpec (spec) where
import Components.TaskStore.SQLite (SQLiteTaskStore)
import Types (Constructable(..), HasMigratableDB(..), TaskStore(..), TaskStoreError, SQLMigrationVersion(..))
import Types ( Constructable(..)
, HasMigratableDB(..)
, ValidationError
, TaskStore(..)
, TaskStoreError
, SQLMigrationVersion(..)
, Validated
, Validatable(..)
, FullySpecifiedTask
, NotStartedTask
, TaskState(..)
, Task(..)
, TaskName(..)
, TaskDesc(..)
, WithID
, withoutID
, showID
, getValidatedObj
)
import Data.Functor.Identity
import Config (defaultCompleteTaskStoreConfig)
import Data.Either (isRight)
import Control.Monad.IO.Class (liftIO)
......@@ -12,6 +33,13 @@ import Test.Hspec
makeDefaultStore :: IO (Either TaskStoreError SQLiteTaskStore)
makeDefaultStore = construct defaultCompleteTaskStoreConfig
-- generateTask :: IO (Validated NotStartedTask)
generateTask :: IO (Validated (Task Identity TaskState))
generateTask = rightOrThrow $ validate $ Task { tName = Identity $ TaskName "example"
, tDescription = Identity $ TaskDesc "this is a example task"
, tState = Identity NotStarted
}
main :: IO ()
main = hspec spec
......@@ -23,8 +51,17 @@ spec = do
describe "task store migration" $ do
it "migrates with the default config (0 -> 1)" $ \_ -> liftIO makeDefaultStore
-- Default stores
>>= rightOrThrow
-- migrate migrates to `desiredVersion`
>>= liftIO . migrate
>>= shouldBe (Right ())
describe "task store persistTask" $ do
it "works with default config" $ \_ -> liftIO makeDefaultStore
>>= rightOrThrow
>>= \store -> migrate store
>> generateTask
>>= \expected -> persistTask store expected
>>= rightOrThrow
-- | Ensure that the ID is non-empty when printed, and the object we got back is right
>>= \actualWithID -> pure (showID actualWithID /= "" && withoutID actualWithID == getValidatedObj expected)
>>= shouldBe True
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