Commit a46c6ae0 authored by MrMan's avatar MrMan

Working create of TODOs

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