Commit 77ad3ff8 authored by MrMan's avatar MrMan

Simplify, simplify, simplify!

- tests pass
- listing endpoint works
parent 3d6792b9
...@@ -90,7 +90,7 @@ server cfg = buildEntityStore entityStoreCfg -- | Build & start the entity store ...@@ -90,7 +90,7 @@ server cfg = buildEntityStore entityStoreCfg -- | Build & start the entity store
-- | Start the app -- | Start the app
>>= startApp >>= startApp
where where
makeTestTask = pure $ validate $ NotStartedT (Identity (TaskName "test")) (Identity (TaskDesc "test description")) makeTestTask = pure $ validate $ NotStartedT (Identity "test") (Identity "test description")
entityStoreCfg = runIdentity $ entityStoreConfig cfg entityStoreCfg = runIdentity $ entityStoreConfig cfg
appPort = runIdentity $ port cfg appPort = runIdentity $ port cfg
......
...@@ -27,14 +27,14 @@ type Name = DT.Text ...@@ -27,14 +27,14 @@ type Name = DT.Text
type Greeting = DT.Text type Greeting = DT.Text
type TodoAPI = type TodoAPI =
"todos" :> Get '[JSON] [TaskWithStateAndID] "todos" :> Get '[JSON] [WithUUID Task]
todoServer :: ServerT TodoAPI AppHandler todoServer :: ServerT TodoAPI AppHandler
todoServer = listTodos todoServer = listTodos
listTodos :: AppHandler [TaskWithStateAndID] listTodos :: AppHandler [WithUUID Task]
listTodos = ask listTodos = ask
>>= \(AppState _ estore) -> liftIO (list estore :: IO (Either EntityStoreError [WithID 'UUIDID (Complete (Task Some))])) >>= \(AppState _ estore) -> liftIO (list estore :: IO (Either EntityStoreError [WithUUID Task]))
>>= rightOrServantErr genericServerError >>= rightOrServantErr genericServerError
todoAPI :: Proxy TodoAPI todoAPI :: Proxy TodoAPI
......
...@@ -36,6 +36,7 @@ library: ...@@ -36,6 +36,7 @@ library:
- sqlite-simple - sqlite-simple
- neat-interpolation - neat-interpolation
- transformers - transformers
- unordered-containers
executables: executables:
haskell-restish-todo-exe: haskell-restish-todo-exe:
...@@ -89,3 +90,4 @@ tests: ...@@ -89,3 +90,4 @@ tests:
dependencies: dependencies:
- haskell-restish-todo - haskell-restish-todo
- hspec - hspec
- uuid
This diff is collapsed.
This diff is collapsed.
...@@ -7,34 +7,14 @@ module Components.EntityStore.SQLiteSpec (spec) where ...@@ -7,34 +7,14 @@ module Components.EntityStore.SQLiteSpec (spec) where
import Components.EntityStore.SQLite (SQLiteEntityStore) import Components.EntityStore.SQLite (SQLiteEntityStore)
import Control.Monad (when) import Control.Monad (when)
import Types ( Complete import Types
, Constructable(..) import Data.Either (isLeft)
, EntityStoreError
, FullySpecifiedTask
, HasMigratableDB(..)
, NotStartedTask
, Partial
, SQLEntityStore(..)
, SQLInsertable
, SQLMigrationVersion(..)
, Task(..)
, TaskDesc(..)
, TaskName(..)
, TaskState(..)
, Validatable(..)
, Validated
, ValidationError
, WithID(..)
, Identifier(..)
, withoutID
, showID
, getValidatedObj
)
import Data.Functor.Identity import Data.Functor.Identity
import Config (defaultCompleteEntityStoreConfig) import Config (defaultCompleteEntityStoreConfig)
import Data.Either (isRight) import Data.Either (isRight)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Util (rightOrThrow) import Util (rightOrThrow)
import Data.UUID (toText)
import Test.Hspec import Test.Hspec
...@@ -42,14 +22,14 @@ makeDefaultStore :: IO (Either EntityStoreError SQLiteEntityStore) ...@@ -42,14 +22,14 @@ makeDefaultStore :: IO (Either EntityStoreError SQLiteEntityStore)
makeDefaultStore = construct defaultCompleteEntityStoreConfig makeDefaultStore = construct defaultCompleteEntityStoreConfig
-- generateTask :: IO (Validated NotStartedTask) -- generateTask :: IO (Validated NotStartedTask)
generateTask :: IO (Validated NotStartedTask) generateTask :: IO (Validated (Complete NotStartedTask))
generateTask = rightOrThrow $ validate $ NotStartedT name desc generateTask = rightOrThrow $ validate $ NotStartedT name desc
where where
name = Identity $ TaskName "example" name = Identity "example"
desc = Identity $ TaskDesc "this is a example task" desc = Identity "this is a example task"
generateTaskNameUpdate :: IO (Validated (Partial (Task 'NotStarted))) generateTaskNameUpdate :: IO (Validated (Partial NotStartedTask))
generateTaskNameUpdate = rightOrThrow $ validate $ NotStartedT (Just (TaskName "updated name")) Nothing generateTaskNameUpdate = rightOrThrow $ validate $ NotStartedT (Just "updated name") Nothing
main :: IO () main :: IO ()
main = hspec spec main = hspec spec
...@@ -71,11 +51,10 @@ spec = do ...@@ -71,11 +51,10 @@ spec = do
>>= rightOrThrow >>= rightOrThrow
>>= \store -> migrate store >>= \store -> migrate store
>> generateTask >> generateTask
>>= \expected -> create store (expected :: Validated NotStartedTask) >>= \expected -> (create store expected :: IO (Either EntityStoreError (WithUUID (Complete NotStartedTask))))
>>= rightOrThrow >>= rightOrThrow
-- | Ensure that the ID is non-empty when printed, and the object we got back is right -- | Ensure that the ID is non-empty when printed, and the object we got back is right
>>= \actualWithID -> pure ( showID actualWithID /= "" && >>= \(WUUID uuid task) -> pure (toText uuid /= "" && task == getValidatedObj expected)
withoutID actualWithID == getValidatedObj expected )
>>= (`shouldBe` True) >>= (`shouldBe` True)
describe "entity store update" $ describe "entity store update" $
...@@ -83,18 +62,14 @@ spec = do ...@@ -83,18 +62,14 @@ spec = do
>>= rightOrThrow >>= rightOrThrow
>>= \store -> migrate store >>= \store -> migrate store
>> generateTask >> generateTask
>>= \original -> create store original >>= \original -> (create store original :: IO (Either EntityStoreError (WithUUID (Complete NotStartedTask))))
>>= rightOrThrow >>= rightOrThrow
-- | Generate and perform update -- | Generate and perform update
>>= \createdTask -> generateTaskNameUpdate >>= \expected@(WUUID uuid _) -> generateTaskNameUpdate
>>= \update -> case createdTask of >>= updateByUUID store uuid
(WUUID uuid _) -> updateByID store (Left uuid) update
(WID (Left uuid) _) -> updateByID store (Left uuid) update
_ -> error "Unexpected thing received"
>>= rightOrThrow >>= rightOrThrow
-- | The task should have changed -- | The task should have changed
>>= \updated -> pure ( showID updated /= "" && >>= \returned@(WUUID uuid task) -> pure (toText uuid /= "" && returned /= expected)
withoutID updated /= getValidatedObj original )
>>= (`shouldBe` True) >>= (`shouldBe` True)
describe "entity store delete" $ describe "entity store delete" $
...@@ -106,30 +81,22 @@ spec = do ...@@ -106,30 +81,22 @@ spec = do
>>= \original -> create store original >>= \original -> create store original
>>= rightOrThrow >>= rightOrThrow
-- | Delete the created task right after creating it -- | Delete the created task right after creating it
>>= \created -> case created of >>= \(WUUID uuid _) -> (deleteByUUID store uuid :: IO (Either EntityStoreError (WithUUID (Complete NotStartedTask))))
(WUUID uuid _) -> deleteByID store (Left uuid)
(WID (Left uuid) _) -> deleteByID store (Left uuid)
_ -> error "Unexpected thing received"
>>= rightOrThrow >>= rightOrThrow
-- | Ensure task returned by the deletion matches created one -- | Ensure task returned by the deletion matches created one
>>= \deleted -> when (withoutID deleted /= getValidatedObj original) (error "returned deleted object mismatch") >>= \(WUUID _ obj) -> when (obj /= getValidatedObj original) (error "returned deleted object mismatch")
-- | Ensure that a get with the deleted item's ID fails -- | Ensure that a get with the deleted item's ID fails (produces a Left value)
>> let >> (getByUUID store uuid :: IO (Either EntityStoreError (WithUUID (Complete NotStartedTask))))
-- | Unfortunately we have to give GHC some hints so it can work out what's supposed to come out of get >>= (`shouldSatisfy` isLeft)
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"
describe "entity store lsit" $ describe "entity store lsit" $
it "works with default config" $ \_ -> liftIO makeDefaultStore it "works with default config" $ \_ -> liftIO makeDefaultStore
>>= rightOrThrow >>= rightOrThrow
>>= \store -> migrate store >>= \store -> migrate store
>> generateTask >> generateTask
>>= \expected -> create store (expected :: Validated NotStartedTask) >>= \expected -> create store expected
>>= rightOrThrow >>= rightOrThrow
-- | Ensure that the ID is non-empty when printed, and the object we got back is right -- | Ensure that the ID is non-empty when printed, and the object we got back is right
>> (list store :: IO (Either EntityStoreError [(WithID 'UUIDID (Complete (Task state)))])) >> (list store :: IO (Either EntityStoreError [WithUUID Task]))
>>= rightOrThrow >>= rightOrThrow
>>= (`shouldBe` 1) . length >>= (`shouldBe` 1) . length
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