Move item or trait (#254)

* 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

back/src/Guide/Api/Methods.hs

@@ -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 -> Uid Item -> CCreateTrait -> Guider (Uid Trait)
-createTrait db requestDetails itemId traitType text = do
+createTrait db requestDetails itemId CCreateTrait{..} = do
-  when (T.null text) $ throwError err400{errBody = "Trait text not provided"}
+  when (T.null cctContent) $ throwError err400{errBody = "Trait text not provided"}
   traitId <- randomShortUid
-  (edit, _) <- case traitType of
+  (edit, _) <- case cctType of
-    Con -> dbUpdate db (AddCon itemId traitId text)
+    Con -> dbUpdate db (AddCon itemId traitId cctContent)
-    Pro -> dbUpdate db (AddPro itemId traitId text)
+    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
 ----------------------------------------------------------------------------

back/src/Guide/Api/Server.hs

@@ -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

back/src/Guide/Api/Types.hs

@@ -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] CCreateTrait
-      :> ReqBody '[JSON] Text
       :> 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
+instance A.ToJSON CTraitType where
-    toParamSchema _ = mempty
+  toJSON = A.genericToJSON jsonOptions
-        & S.type_ .~ SwaggerString
-        & S.format ?~ "Trait type"
 
-instance ToHttpApiData TraitType where
+instance A.FromJSON CTraitType where
-    toUrlPiece = toText . map toLower . show
+  parseJSON = A.genericParseJSON jsonOptions
 
-instance FromHttpApiData TraitType where
+-- | Direction (Up/Down) for item or trait and their instances.
-    parseUrlPiece t = case t of
+data CDirection = DirectionUp | DirectionDown
-        "pro" -> Right Pro
+    deriving (Eq, Show, Generic)
-        "con" -> Right Con
+
-        _     -> Left "Invalid trait type!"
+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