Commit a46c6ae0 authored by MrMan's avatar MrMan

Working create of TODOs

parent ef4cd1ee
......@@ -36,12 +36,14 @@ type TodoAPI =
:<|> "todos" :> Capture "uuid" UUID :> Get '[JSON] (WithUUID Task)
:<|> "todos" :> Capture "uuid" UUID :> ReqBody '[JSON] (Partial TaskF) :> Patch '[JSON] (WithUUID Task)
:<|> "todos" :> Capture "uuid" UUID :> Delete '[JSON] (WithUUID Task)
:<|> "todos" :> ReqBody '[JSON] Task :> Post '[JSON] (WithUUID Task)
todoServer :: ServerT TodoAPI AppHandler
todoServer = listTodos
:<|> getTodoByUUID
:<|> patchTodoByUUID
:<|> deleteTodoByUUID
:<|> createTodo
listTodos :: AppHandler [WithUUID Task]
listTodos = ask
......@@ -66,6 +68,13 @@ deleteTodoByUUID uuid = ask
>>= \(AppState _ estore) -> liftIO (deleteByUUID estore uuid :: IO (Either EntityStoreError (WithUUID Task)))
>>= rightOrServantErr genericServerError
createTodo :: Task -> AppHandler (WithUUID Task)
createTodo todo = pure (validate todo)
>>= rightOrConvertToServantErr
>>= \validated -> ask
>>= \(AppState _ estore) -> liftIO (create estore validated :: IO (Either EntityStoreError (WithUUID Task)))
>>= rightOrConvertToServantErr
todoAPI :: Proxy TodoAPI
todoAPI = Proxy
......
......@@ -232,13 +232,13 @@ ensureUUID e = Right . flip WUUID e <$> nextRandom
-- | Insert and return an entity
insertAndReturnEntity :: forall entity.
( SQLInsertable (WithUUID (Complete entity))
, SQLInsertable (Complete entity)
, FromRow (WithUUID (Complete entity))
( SQLInsertable (WithUUID entity)
, SQLInsertable entity
, FromRow (WithUUID entity)
)
=> Connection
-> WithUUID (Complete entity)
-> IO (Either EntityStoreError (WithUUID (Complete entity)))
-> WithUUID entity
-> IO (Either EntityStoreError (WithUUID entity))
insertAndReturnEntity conn entity@(WUUID uuid _) = insertEntity conn entity
>> getEntityByUUID conn uuid
instance SQLInsertable Task where
......
......@@ -63,6 +63,7 @@ data Task = Task { tName :: TaskName
} deriving (Eq, Show, Read, Generic)
instance ToJSON Task
instance FromJSON Task
data TaskF f = TaskF { tfName :: f TaskName
, tfDesc :: f TaskDesc
......@@ -83,6 +84,7 @@ deriving instance Generic (Partial TaskF)
instance ToJSON (Partial TaskF)
instance FromJSON (Partial TaskF)
-- The beefy task class
data TaskFInState (state :: TaskState) f where
FinishedT :: f TaskName -> f TaskDesc -> TaskFInState 'Finished f
......@@ -181,6 +183,7 @@ showState (FinishedT _ _) = "Finished"
showState (InProgressT _ _) = "InProgress"
showState (NotStartedT _ _) = "NotStarted"
instance Validatable (Complete (TaskFInState state)) where
validationChecks = [checkName, checkDescription]
where
......@@ -227,6 +230,18 @@ instance Validatable (Partial TaskF) where
validState :: Partial TaskF -> Maybe ValidationError
validState = maybe Nothing (enumStrIfPresent validTaskStateValues taskDescField) . tfState
instance Validatable Task where
validationChecks = [nonEmptyName, nonEmptyDesc, validState]
where
nonEmptyName :: Task -> Maybe ValidationError
nonEmptyName = maybe Nothing (nonEmptyIfPresent taskNameField) . Just . tName
nonEmptyDesc :: Task -> Maybe ValidationError
nonEmptyDesc = maybe Nothing (nonEmptyIfPresent taskDescField) . Just . tDesc
validState :: Task -> Maybe ValidationError
validState = maybe Nothing (enumStrIfPresent validTaskStateValues taskDescField) . Just . tState
----------------
-- Components --
----------------
......@@ -355,13 +370,13 @@ class SQLDeletable entity where
class SQLEntityStore store where
-- | Create an entity
create :: forall entity.
( SQLInsertable (Complete entity)
, SQLInsertable (WithUUID (Complete entity))
, FromRow (WithUUID (Complete entity))
( SQLInsertable entity
, SQLInsertable (WithUUID entity)
, FromRow (WithUUID entity)
)
=> store
-> Validated (Complete entity)
-> IO (Either EntityStoreError (WithUUID (Complete entity)))
-> Validated entity
-> IO (Either EntityStoreError (WithUUID entity))
-- | Get an entity by ID
getByUUID :: forall entity.
......
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