aelve/guide
1
1
Fork 0
mirror of https://github.com/aelve/guide.git synced 2024-11-23 21:13:07 +03:00
Code Issues Projects Releases Wiki Activity

Move item or trait (#254)

Browse Source 
* Move item or trait

* Make body request

* Create trait as body with type and text

* Update back/src/Guide/Api/Methods.hs

Co-Authored-By: willbasky <vladislav.sabanov@gmail.com>

* Update back/src/Guide/Api/Methods.hs

Co-Authored-By: willbasky <vladislav.sabanov@gmail.com>

* Update back/src/Guide/Api/Types.hs

Co-Authored-By: willbasky <vladislav.sabanov@gmail.com>

* Fix style

* Remove spaces
This commit is contained in:
Vladislav Sabanov 2019-01-07 02:29:59 +05:00 committed by GitHub
parent 9c4b7eb687
commit 67beea7d6f
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 124 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
back/src/Guide/Api/Methods.hs
View File

@ -163,6 +163,14 @@ deleteItem db requestDetails itemId = do
addEdit db requestDetails edit)
pure NoContent
-- | Move item up or down
moveItem :: DB -> RequestDetails -> Uid Item -> CMove -> Guider NoContent
moveItem db requestDetails itemId CMove{..} = do
_ <- getItemOrFail db itemId
edit <- dbUpdate db (MoveItem itemId (cmDirection == DirectionUp))
addEdit db requestDetails edit
pure NoContent
----------------------------------------------------------------------------
-- Traits
----------------------------------------------------------------------------
@ -170,13 +178,13 @@ deleteItem db requestDetails itemId = do
-- TODO: move a trait
-- | Create a trait (pro/con).
createTrait :: DB -> RequestDetails -> Uid Item -> TraitType -> Text -> Guider (Uid Trait)
createTrait db requestDetails itemId traitType text = do
when (T.null text) $ throwError err400{errBody = "Trait text not provided"}
createTrait :: DB -> RequestDetails -> Uid Item -> CCreateTrait -> Guider (Uid Trait)
createTrait db requestDetails itemId CCreateTrait{..} = do
when (T.null cctContent) $ throwError err400{errBody = "Trait text not provided"}
traitId <- randomShortUid
(edit, _) <- case traitType of
Con -> dbUpdate db (AddCon itemId traitId text)
Pro -> dbUpdate db (AddPro itemId traitId text)
(edit, _) <- case cctType of
Con -> dbUpdate db (AddCon itemId traitId cctContent)
Pro -> dbUpdate db (AddPro itemId traitId cctContent)
addEdit db requestDetails edit
pure traitId
@ -197,6 +205,14 @@ deleteTrait db requestDetails itemId traitId = do
addEdit db requestDetails edit)
pure NoContent
-- | Move trait up or down
moveTrait :: DB -> RequestDetails -> Uid Item -> Uid Trait -> CMove -> Guider NoContent
moveTrait db requestDetails itemId traitId CMove{..} = do
_ <- getTraitOrFail db itemId traitId
edit <- dbUpdate db (MoveTrait itemId traitId (cmDirection == DirectionUp))
addEdit db requestDetails edit
pure NoContent
----------------------------------------------------------------------------
-- Search
----------------------------------------------------------------------------

6
back/src/Guide/Api/Server.hs
View File

@ -53,13 +53,15 @@ guiderServer db requestDetails = Site
, _setItemSummary = setItemSummary db requestDetails
, _setItemEcosystem = setItemEcosystem db requestDetails
, _setItemNotes = setItemNotes db requestDetails
, _deleteItem = deleteItem db requestDetails }
, _deleteItem = deleteItem db requestDetails
, _moveItem = moveItem db requestDetails }
:: ItemSite GuiderServer)
, _traitSite = toServant (TraitSite
{ _createTrait = createTrait db requestDetails
, _setTrait = setTrait db requestDetails
, _deleteTrait = deleteTrait db requestDetails }
, _deleteTrait = deleteTrait db requestDetails
, _moveTrait = moveTrait db requestDetails }
:: TraitSite GuiderServer)
, _searchSite = toServant (SearchSite

129
back/src/Guide/Api/Types.hs
View File

@ -33,7 +33,10 @@ module Guide.Api.Types
, CSearchResult(..), toCSearchResult
-- * Other types
, TraitType(..)
, CMove(..)
, CDirection(..)
, CTraitType(..)
, CCreateTrait(..)
, CTextEdit(..)
, CMergeConflict(..)
)
@ -93,7 +96,7 @@ data CategorySite route = CategorySite
Summary "Get contents of a category"
:> ErrorResponse 404 "Category not found"
:> "category"
:> Capture "id" (Uid Category)
:> Capture "categoryId" (Uid Category)
:> Get '[JSON] CCategoryFull
, _createCategory :: route :-
@ -116,7 +119,7 @@ data CategorySite route = CategorySite
Summary "Edit category's notes"
:> ErrorResponse 404 "Category not found"
:> "category"
:> Capture "id" (Uid Category)
:> Capture "categoryId" (Uid Category)
:> "notes"
:> ReqBody '[JSON] CTextEdit
:> ErrorResponse 409 "Merge conflict occurred"
@ -126,7 +129,7 @@ data CategorySite route = CategorySite
Summary "Set category's fields"
:> ErrorResponse 404 "Category not found"
:> "category"
:> Capture "id" (Uid Category)
:> Capture "categoryId" (Uid Category)
:> "info"
:> ReqBody '[JSON] CCategoryInfoEdit
:> Put '[JSON] NoContent
@ -135,7 +138,7 @@ data CategorySite route = CategorySite
Summary "Delete a category"
:> ErrorResponse 404 "Category not found"
:> "category"
:> Capture "id" (Uid Category)
:> Capture "categoryId" (Uid Category)
:> Delete '[JSON] NoContent
}
deriving (Generic)
@ -147,7 +150,7 @@ data ItemSite route = ItemSite
:> Description "Returns the ID of the created item."
:> ErrorResponse 400 "'name' not provided"
:> "item"
:> Capture "category" (Uid Category)
:> Capture "categoryId" (Uid Category)
:> QueryParam' '[Required, Strict] "name" Text
:> Post '[JSON] (Uid Item)
@ -155,7 +158,7 @@ data ItemSite route = ItemSite
Summary "Set item's info"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "info"
:> ReqBody '[JSON] CItemInfo
:> Put '[JSON] NoContent
@ -164,7 +167,7 @@ data ItemSite route = ItemSite
Summary "Set item's summary"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "summary"
:> ReqBody '[JSON] CTextEdit
:> ErrorResponse 409 "Merge conflict occurred"
@ -174,7 +177,7 @@ data ItemSite route = ItemSite
Summary "Set item's ecosystem"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "ecosystem"
:> ReqBody '[JSON] CTextEdit
:> ErrorResponse 409 "Merge conflict occurred"
@ -184,7 +187,7 @@ data ItemSite route = ItemSite
Summary "Set item's notes"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "notes"
:> ReqBody '[JSON] CTextEdit
:> ErrorResponse 409 "Merge conflict occurred"
@ -194,8 +197,17 @@ data ItemSite route = ItemSite
Summary "Delete an item"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "id" (Uid Item)
:> Capture "itemId" (Uid Item)
:> Delete '[JSON] NoContent
, _moveItem :: route :-
Summary "Move item"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "itemId" (Uid Item)
:> "move"
:> ReqBody '[JSON] CMove
:> Post '[JSON] NoContent
}
deriving (Generic)
@ -206,10 +218,9 @@ data TraitSite route = TraitSite
:> Description "Returns the ID of the created trait."
:> ErrorResponse 400 "'text' not provided"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "trait"
:> Capture "type" TraitType
:> ReqBody '[JSON] Text
:> ReqBody '[JSON] CCreateTrait
:> Post '[JSON] (Uid Trait)
, _setTrait :: route :-
@ -217,9 +228,9 @@ data TraitSite route = TraitSite
:> ErrorResponse 404 "Item not found"
:> ErrorResponse 404 "Trait not found"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "trait"
:> Capture "id" (Uid Trait)
:> Capture "traitId" (Uid Trait)
:> ReqBody '[JSON] CTextEdit
:> ErrorResponse 409 "Merge conflict occurred"
:> Put '[JSON] NoContent
@ -229,10 +240,22 @@ data TraitSite route = TraitSite
:> ErrorResponse 404 "Item not found"
:> ErrorResponse 404 "Trait not found"
:> "item"
:> Capture "item" (Uid Item)
:> Capture "itemId" (Uid Item)
:> "trait"
:> Capture "id" (Uid Trait)
:> Capture "traitId" (Uid Trait)
:> Delete '[JSON] NoContent
, _moveTrait :: route :-
Summary "Move trait"
:> ErrorResponse 404 "Item not found"
:> ErrorResponse 404 "Trait not found"
:> "item"
:> Capture "itemId" (Uid Item)
:> "trait"
:> Capture "traitId" (Uid Trait)
:> "move"
:> ReqBody '[JSON] CMove
:> Post '[JSON] NoContent
}
deriving (Generic)
@ -255,25 +278,40 @@ type Api = RequestDetails :> ToServant Site AsApi
--------------------------------------------------------------------------
-- | Trait type (Pro/Con) and instances.
data TraitType = Pro | Con
data CTraitType = Pro | Con
deriving (Show, Generic)
instance ToSchema TraitType where
instance ToSchema CTraitType where
declareNamedSchema = genericDeclareNamedSchema schemaOptions
instance ToParamSchema TraitType where
toParamSchema _ = mempty
& S.type_ .~ SwaggerString
& S.format ?~ "Trait type"
instance A.ToJSON CTraitType where
toJSON = A.genericToJSON jsonOptions
instance ToHttpApiData TraitType where
toUrlPiece = toText . map toLower . show
instance A.FromJSON CTraitType where
parseJSON = A.genericParseJSON jsonOptions
instance FromHttpApiData TraitType where
parseUrlPiece t = case t of
"pro" -> Right Pro
"con" -> Right Con
_ -> Left "Invalid trait type!"
-- | Direction (Up/Down) for item or trait and their instances.
data CDirection = DirectionUp | DirectionDown
deriving (Eq, Show, Generic)
instance ToSchema CDirection where
declareNamedSchema = genericDeclareNamedSchema schemaOptions
{ constructorTagModifier = \case
"DirectionUp" -> "up"
"DirectionDown" -> "down"
other -> error ("Direction schema: unknown tag " <> show other)
}
instance A.ToJSON CDirection where
toJSON = \case
DirectionUp -> "up"
DirectionDown -> "down"
instance A.FromJSON CDirection where
parseJSON = \case
"up" -> pure DirectionUp
"down" -> pure DirectionDown
tag -> fail ("unknown direction " ++ show tag)
----------------------------------------------------------------------------
-- Client types
@ -285,6 +323,35 @@ instance FromHttpApiData TraitType where
-- we might not need on front-end.
----------------------------------------------------------------------------
-- | Client type to create new trait.
data CCreateTrait = CCreateTrait
{ cctType :: CTraitType
, cctContent :: Text
} deriving (Show, Generic)
instance A.ToJSON CCreateTrait where
toJSON = A.genericToJSON jsonOptions
instance A.FromJSON CCreateTrait where
parseJSON = A.genericParseJSON jsonOptions
instance ToSchema CCreateTrait where
declareNamedSchema = genericDeclareNamedSchema schemaOptions
-- | Client type to move trait or item up or down.
data CMove = CMove
{ cmDirection :: CDirection
} deriving (Show, Eq, Generic)
instance A.ToJSON CMove where
toJSON = A.genericToJSON jsonOptions
instance A.FromJSON CMove where
parseJSON = A.genericParseJSON jsonOptions
instance ToSchema CMove where
declareNamedSchema = genericDeclareNamedSchema schemaOptions
-- | A "light-weight" client type of 'Category', which describes a category
-- but doesn't give the notes or the items.
data CCategoryInfo = CCategoryInfo