1
1
mirror of https://github.com/aelve/guide.git synced 2024-12-23 21:02:13 +03:00

Add setCategoryNote and setCategoryInfo and setItemInfo (#227)

* Add setCategoryNote

* Fix cache function

* Fix style

* Add setCategoryInfo

* Fix instances, add throwErrorand unH

* WIP

* Add setItemHackage on old kind + commented new realisation

* Refactor and fix bug

* Update src/Guide/Api/Methods.hs

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

* Add a comment

* Update src/Guide/Api/Methods.hs

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

* Update src/Guide/Api/Methods.hs

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

* Update src/Guide/Api/Methods.hs

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

* Update src/Guide/Api/Methods.hs

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

* Update src/Guide/Api/Methods.hs

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

* Update src/Guide/Api/Methods.hs

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

* Update src/Guide/Api/Types.hs

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

* Update src/Guide/Api/Utils.hs

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

* Fix FromJSON ItemKind instance

* Update src/Guide/Api/Methods.hs

Co-Authored-By: willbasky <vladislav.sabanov@gmail.com>
This commit is contained in:
Vladislav Sabanov 2018-11-04 00:09:19 +05:00 committed by GitHub
parent 3063a79830
commit eafe87bd0a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 196 additions and 42 deletions

View File

@ -13,11 +13,13 @@ import Data.Text (Text)
import Servant import Servant
import Guide.Api.Types import Guide.Api.Types
import Guide.Api.Utils
import Guide.Cache import Guide.Cache
import Guide.State import Guide.State
import Guide.Types import Guide.Types
import Guide.Utils import Guide.Utils
import qualified Data.Set as S
import qualified Data.Text as T import qualified Data.Text as T
import qualified Guide.Search as Search import qualified Guide.Search as Search
@ -44,6 +46,8 @@ getCategory db catId =
-- category with this title exists already). -- category with this title exists already).
createCategory :: DB -> Text -> Text -> Handler (Uid Category) createCategory :: DB -> Text -> Text -> Handler (Uid Category)
createCategory db title' group' = do createCategory db title' group' = do
when (T.null title') $ do throwError (err400 {errBody = "Title not provided"})
when (T.null group') $ do throwError (err400 {errBody = "Group' not provided"})
-- If the category exists already, don't create it -- If the category exists already, don't create it
cats <- view categories <$> dbQuery db GetGlobalState cats <- view categories <$> dbQuery db GetGlobalState
let isDuplicate cat = T.toCaseFold (cat^.title) == T.toCaseFold title' let isDuplicate cat = T.toCaseFold (cat^.title) == T.toCaseFold title'
@ -58,9 +62,40 @@ createCategory db title' group' = do
-- TODO addEdit edit -- TODO addEdit edit
return catId return catId
-- | Edit categoty's note.
setCategoryNotes :: DB -> Uid Category -> Text -> Handler NoContent
setCategoryNotes db catId note = uncache db (CacheCategoryNotes catId) $ do
dbQuery db (GetCategoryMaybe catId) >>= \case
Nothing -> throwError (err404 {errBody = "Category not found"})
Just _ -> do
(_edit, _newCategory) <- dbUpdate db (SetCategoryNotes catId note)
-- TODO diff and merge
pure NoContent
-- | Edit category's info (title, group, status, sections (pro/con, ecosystem, note)).
setCategoryInfo :: DB -> Uid Category -> CCategoryInfoEdit -> Handler NoContent
setCategoryInfo db catId CCategoryInfoEdit{..} = uncache db (CacheCategoryInfo catId) $ do
dbQuery db (GetCategoryMaybe catId) >>= \case
Nothing -> throwError (err404 {errBody = "Category not found"})
Just category -> do
-- TODO diff and merge
_ <- dbUpdate db $ SetCategoryTitle catId $ unH ccieTitle
_ <- dbUpdate db $ SetCategoryGroup catId $ unH ccieGroup
_ <- dbUpdate db $ SetCategoryStatus catId $ unH ccieStatus
let oldEnabledSections = category ^. enabledSections
let newEnabledSections = unH ccieSections
_ <- dbUpdate db $ ChangeCategoryEnabledSections catId
(newEnabledSections S.\\ oldEnabledSections)
(oldEnabledSections S.\\ newEnabledSections)
-- TODO record edits
pure NoContent
-- | Delete a category. -- | Delete a category.
deleteCategory :: DB -> Uid Category -> Handler NoContent deleteCategory :: DB -> Uid Category -> Handler NoContent
deleteCategory db catId = uncache db (CacheCategory catId) $ do deleteCategory db catId = uncache db (CacheCategory catId) $ do
dbQuery db (GetCategoryMaybe catId) >>= \case
Nothing -> throwError (err404 {errBody = "Category not found"})
Just _ -> do
_mbEdit <- dbUpdate db (DeleteCategory catId) _mbEdit <- dbUpdate db (DeleteCategory catId)
pure NoContent pure NoContent
-- TODO mapM_ addEdit mbEdit -- TODO mapM_ addEdit mbEdit
@ -75,8 +110,11 @@ deleteCategory db catId = uncache db (CacheCategory catId) $ do
-- with duplicated names. -- with duplicated names.
createItem :: DB -> Uid Category -> Text -> Handler (Uid Item) createItem :: DB -> Uid Category -> Text -> Handler (Uid Item)
createItem db catId name' = do createItem db catId name' = do
-- TODO: do something if the category doesn't exist (e.g. has been dbQuery db (GetCategoryMaybe catId) >>= \case
-- already deleted) Nothing -> throwError (err404 {errBody = "Category not found"})
Just _ -> do
if T.null name' then throwError (err400 {errBody = "Name not provided"})
else do
itemId <- randomShortUid itemId <- randomShortUid
-- If the item name looks like a Hackage library, assume it's a Hackage -- If the item name looks like a Hackage library, assume it's a Hackage
-- library. -- library.
@ -91,6 +129,19 @@ createItem db catId name' = do
-- TODO: move an item -- TODO: move an item
-- | Set item's info
setItemInfo :: DB -> Uid Item -> CItemInfo -> Handler NoContent
setItemInfo db itemId CItemInfo{..} = uncache db (CacheItemInfo itemId) $ do
dbQuery db (GetItemMaybe itemId) >>= \case
Nothing -> throwError (err404 {errBody = "Item not found"})
Just _ -> do
-- TODO diff and merge
_ <- dbUpdate db $ SetItemName itemId $ unH ciiName
_ <- dbUpdate db $ SetItemGroup itemId $ unH ciiGroup
_ <- dbUpdate db $ SetItemLink itemId $ unH ciiLink
_ <- dbUpdate db $ SetItemKind itemId $ unH ciiKind
pure NoContent
-- | Delete an item. -- | Delete an item.
deleteItem :: DB -> Uid Item -> Handler NoContent deleteItem :: DB -> Uid Item -> Handler NoContent
deleteItem db itemId = uncache db (CacheItem itemId) $ do deleteItem db itemId = uncache db (CacheItem itemId) $ do
@ -107,18 +158,20 @@ deleteItem db itemId = uncache db (CacheItem itemId) $ do
-- | Create a trait (pro/con). -- | Create a trait (pro/con).
createTrait :: DB -> Uid Item -> TraitType -> Text -> Handler (Uid Trait) createTrait :: DB -> Uid Item -> TraitType -> Text -> Handler (Uid Trait)
createTrait db itemId traitType text = do createTrait db itemId traitType text = do
when (T.null text) $ throwError (err400 {errBody = "Trait text not provided"})
traitId <- randomShortUid traitId <- randomShortUid
(_edit, _newTrait) <- case traitType of (_edit, _newTrait) <- case traitType of
Con -> dbUpdate db (AddCon itemId traitId text) Con -> dbUpdate db (AddCon itemId traitId text)
Pro -> dbUpdate db (AddPro itemId traitId text) Pro -> dbUpdate db (AddPro itemId traitId text)
invalidateCache' db (CacheItemTraits itemId) invalidateCache' db (CacheItemTraits itemId)
-- TODO: mapM_ addEdit mbEdit -- TODO: mapM_ addEdit mbEdit
pure traitId pure traitId
-- | Update the text of a trait (pro/con). -- | Update the text of a trait (pro/con).
setTrait :: DB -> Uid Item -> Uid Trait -> Text -> Handler NoContent setTrait :: DB -> Uid Item -> Uid Trait -> Text -> Handler NoContent
setTrait db itemId traitId text = uncache db (CacheItemTraits itemId) $ do setTrait db itemId traitId text = uncache db (CacheItemTraits itemId) $ do
(_edit, _newTrait) <- dbUpdate db (SetTraitContent itemId traitId text) (_edit, _newTrait) <- dbUpdate db (SetTraitContent itemId traitId text)
-- TODO diff and merge
pure NoContent pure NoContent
-- | Delete a trait (pro/con). -- | Delete a trait (pro/con).

View File

@ -38,11 +38,14 @@ apiServer db = Site
{ _getCategories = getCategories db { _getCategories = getCategories db
, _getCategory = getCategory db , _getCategory = getCategory db
, _createCategory = createCategory db , _createCategory = createCategory db
, _setCategoryNotes = setCategoryNotes db
, _setCategoryInfo = setCategoryInfo db
, _deleteCategory = deleteCategory db } , _deleteCategory = deleteCategory db }
:: CategorySite AsServer) :: CategorySite AsServer)
, _itemSite = toServant (ItemSite , _itemSite = toServant (ItemSite
{ _createItem = createItem db { _createItem = createItem db
, _setItemInfo = setItemInfo db
, _deleteItem = deleteItem db } , _deleteItem = deleteItem db }
:: ItemSite AsServer) :: ItemSite AsServer)

View File

@ -19,10 +19,10 @@ module Guide.Api.Types
, SearchSite(..) , SearchSite(..)
, Site(..) , Site(..)
, TraitSite(..) , TraitSite(..)
, TraitType (..)
-- * View types -- * View types
, CCategoryInfo(..), toCCategoryInfo , CCategoryInfo(..), toCCategoryInfo
, CCategoryInfoEdit(..)
, CCategoryFull(..), toCCategoryFull , CCategoryFull(..), toCCategoryFull
, CItemInfo(..), toCItemInfo , CItemInfo(..), toCItemInfo
, CItemFull(..), toCItemFull , CItemFull(..), toCItemFull
@ -31,6 +31,9 @@ module Guide.Api.Types
-- * Search -- * Search
, CSearchResult(..), toCSearchResult , CSearchResult(..), toCSearchResult
-- * Other types
, TraitType (..)
) )
where where
@ -96,6 +99,7 @@ data CategorySite route = CategorySite
\If a category with the same title already exists \ \If a category with the same title already exists \
\in the group, returns its ID instead." \in the group, returns its ID instead."
:> ErrorResponse 400 "'title' not provided" :> ErrorResponse 400 "'title' not provided"
:> ErrorResponse 400 "'group' not provided"
:> "category" :> "category"
:> QueryParam' '[Required, Strict, :> QueryParam' '[Required, Strict,
Description "Title of the newly created category"] Description "Title of the newly created category"]
@ -105,6 +109,24 @@ data CategorySite route = CategorySite
"group" Text "group" Text
:> Post '[JSON] (Uid Category) :> Post '[JSON] (Uid Category)
, _setCategoryNotes :: route :-
Summary "Edit category's notes"
:> ErrorResponse 404 "Category not found"
:> "category"
:> Capture "id" (Uid Category)
:> "notes"
:> ReqBody '[JSON] Text
:> Put '[JSON] NoContent
, _setCategoryInfo :: route :-
Summary "Set category's fields"
:> ErrorResponse 404 "Category not found"
:> "category"
:> Capture "id" (Uid Category)
:> "info"
:> ReqBody '[JSON] CCategoryInfoEdit
:> Put '[JSON] NoContent
, _deleteCategory :: route :- , _deleteCategory :: route :-
Summary "Delete a category" Summary "Delete a category"
:> "category" :> "category"
@ -124,6 +146,15 @@ data ItemSite route = ItemSite
:> QueryParam' '[Required, Strict] "name" Text :> QueryParam' '[Required, Strict] "name" Text
:> Post '[JSON] (Uid Item) :> Post '[JSON] (Uid Item)
, _setItemInfo :: route :-
Summary "Set item's fields"
:> ErrorResponse 404 "Item not found"
:> "item"
:> Capture "item" (Uid Item)
:> "info"
:> ReqBody '[JSON] CItemInfo
:> Put '[JSON] NoContent
, _deleteItem :: route :- , _deleteItem :: route :-
Summary "Delete an item" Summary "Delete an item"
:> "item" :> "item"
@ -178,6 +209,10 @@ data SearchSite route = SearchSite
type Api = ToServant Site AsApi type Api = ToServant Site AsApi
--------------------------------------------------------------------------
-- Additional types for routes
--------------------------------------------------------------------------
-- | Trait type (Pro/Con) and instances. -- | Trait type (Pro/Con) and instances.
data TraitType = Pro | Con data TraitType = Pro | Con
deriving (Show, Generic) deriving (Show, Generic)
@ -265,7 +300,30 @@ toCCategoryFull Category{..} = CCategoryFull
, ccfStatus = H $ _categoryStatus , ccfStatus = H $ _categoryStatus
} }
-- | A lightweight info type about an 'Item' -- | Client type to edit meta category information.
data CCategoryInfoEdit = CCategoryInfoEdit
{ ccieTitle :: Text ? "Category title"
, ccieGroup :: Text ? "Category group ('grandcategory')"
, ccieStatus :: CategoryStatus ? "Status (done, in progress, ...)"
, ccieSections :: Set ItemSection ? "Enabled item sections"
}
deriving (Show, Generic)
instance A.ToJSON CCategoryInfoEdit where
toJSON = A.genericToJSON jsonOptions
instance A.FromJSON CCategoryInfoEdit where
parseJSON = A.genericParseJSON jsonOptions
instance ToSchema CCategoryInfoEdit where
declareNamedSchema = genericDeclareNamedSchema schemaOptions
instance ToSchema ItemSection where
declareNamedSchema = genericDeclareNamedSchema schemaOptions
-- | A lightweight info type about an 'Item'.
--
-- When updating it, don't forget to also update 'setItemInfo'.
data CItemInfo = CItemInfo data CItemInfo = CItemInfo
{ ciiUid :: Uid Item ? "Item ID" { ciiUid :: Uid Item ? "Item ID"
, ciiName :: Text ? "Item name" , ciiName :: Text ? "Item name"
@ -278,6 +336,9 @@ data CItemInfo = CItemInfo
instance A.ToJSON CItemInfo where instance A.ToJSON CItemInfo where
toJSON = A.genericToJSON jsonOptions toJSON = A.genericToJSON jsonOptions
instance A.FromJSON CItemInfo where
parseJSON = A.genericParseJSON jsonOptions
instance ToSchema CItemInfo where instance ToSchema CItemInfo where
declareNamedSchema = genericDeclareNamedSchema schemaOptions declareNamedSchema = genericDeclareNamedSchema schemaOptions

View File

@ -12,6 +12,7 @@ module Guide.Api.Utils
( jsonOptions ( jsonOptions
, schemaOptions , schemaOptions
, type (?)(..) , type (?)(..)
, unH
, BranchTag , BranchTag
) where ) where
@ -48,6 +49,9 @@ newtype (?) (field :: *) (help :: Symbol) = H field
instance ToJSON field => ToJSON (field ? help) where instance ToJSON field => ToJSON (field ? help) where
toJSON (H a) = toJSON a toJSON (H a) = toJSON a
instance FromJSON field => FromJSON (field ? help) where
parseJSON f = H <$> parseJSON f
instance (KnownSymbol help, ToSchema a) => ToSchema (a ? help) where instance (KnownSymbol help, ToSchema a) => ToSchema (a ? help) where
declareNamedSchema _ = do declareNamedSchema _ = do
NamedSchema _ s <- declareNamedSchema (Proxy @a) NamedSchema _ s <- declareNamedSchema (Proxy @a)
@ -58,6 +62,10 @@ instance (KnownSymbol help, ToSchema a) => ToSchema (a ? help) where
instance {-# OVERLAPPING #-} (KnownSymbol help, Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c ? help))) where instance {-# OVERLAPPING #-} (KnownSymbol help, Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c ? help))) where
gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c ? help))) False gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c ? help))) False
-- | Unwrapper for @field '?' help@
unH :: forall field help . (field ? help) -> field
unH (H field) = field
-- | A way to name branches of Swagger API. -- | A way to name branches of Swagger API.
-- --
-- Taken from <https://github.com/haskell-servant/servant-swagger/issues/73> -- Taken from <https://github.com/haskell-servant/servant-swagger/issues/73>

View File

@ -34,7 +34,7 @@ module Guide.State
GetCategories(..), GetCategories(..),
GetCategory(..), GetCategoryMaybe(..), GetCategory(..), GetCategoryMaybe(..),
GetCategoryByItem(..), GetCategoryByItem(..),
GetItem(..), GetItem(..), GetItemMaybe (..),
GetTrait(..), GetTrait(..),
-- ** add -- ** add
@ -56,6 +56,7 @@ module Guide.State
SetItemLink(..), SetItemLink(..),
SetItemGroup(..), SetItemGroup(..),
SetItemKind(..), SetItemKind(..),
-- SetItemHackage(..),
SetItemDescription(..), SetItemDescription(..),
SetItemNotes(..), SetItemNotes(..),
SetItemEcosystem(..), SetItemEcosystem(..),
@ -333,6 +334,9 @@ getCategoryByItem uid' = findCategoryByItem uid' <$> ask
getItem :: Uid Item -> Acid.Query GlobalState Item getItem :: Uid Item -> Acid.Query GlobalState Item
getItem uid' = view (itemById uid') getItem uid' = view (itemById uid')
getItemMaybe :: Uid Item -> Acid.Query GlobalState (Maybe Item)
getItemMaybe uid' = preview (itemById uid')
-- TODO: this doesn't need the item id, but then we have to be a bit cleverer -- TODO: this doesn't need the item id, but then we have to be a bit cleverer
-- and store a (TraitId -> ItemId) map in global state (and update it -- and store a (TraitId -> ItemId) map in global state (and update it
-- accordingly whenever anything happens, so perhaps let's not do it!) -- accordingly whenever anything happens, so perhaps let's not do it!)
@ -388,7 +392,8 @@ addItem catId itemId name' created' kind' = do
_itemNotes = let pref = "item-notes-" <> uidToText itemId <> "-" _itemNotes = let pref = "item-notes-" <> uidToText itemId <> "-"
in toMarkdownTree pref "", in toMarkdownTree pref "",
_itemLink = Nothing, _itemLink = Nothing,
_itemKind = kind' } _itemKind = kind'}
-- _itemHackage = Nothing }
categoryById catId . items %= (++ [newItem]) categoryById catId . items %= (++ [newItem])
let edit = Edit'AddItem catId itemId name' let edit = Edit'AddItem catId itemId name'
return (edit, newItem) return (edit, newItem)
@ -511,6 +516,12 @@ setItemKind itemId kind' = do
let edit = Edit'SetItemKind itemId oldKind kind' let edit = Edit'SetItemKind itemId oldKind kind'
(edit,) <$> use (itemById itemId) (edit,) <$> use (itemById itemId)
-- setItemHackage :: Uid Item -> Maybe Text -> Acid.Update GlobalState (Edit, Item)
-- setItemHackage itemId hackage' = do
-- oldName <- itemById itemId . hackage <<.= hackage'
-- let edit = Edit'SetItemHackage itemId oldName hackage'
-- (edit,) <$> use (itemById itemId)
setItemDescription :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item) setItemDescription :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item)
setItemDescription itemId description' = do setItemDescription itemId description' = do
oldDescr <- itemById itemId . description <<.= oldDescr <- itemById itemId . description <<.=
@ -874,7 +885,7 @@ makeAcidic ''GlobalState [
'getCategories, 'getCategories,
'getCategory, 'getCategoryMaybe, 'getCategory, 'getCategoryMaybe,
'getCategoryByItem, 'getCategoryByItem,
'getItem, 'getItem, 'getItemMaybe,
'getTrait, 'getTrait,
-- add -- add
'addCategory, 'addCategory,
@ -884,7 +895,7 @@ makeAcidic ''GlobalState [
'setGlobalState, 'setGlobalState,
'setCategoryTitle, 'setCategoryGroup, 'setCategoryNotes, 'setCategoryStatus, 'setCategoryTitle, 'setCategoryGroup, 'setCategoryNotes, 'setCategoryStatus,
'changeCategoryEnabledSections, 'changeCategoryEnabledSections,
'setItemName, 'setItemLink, 'setItemGroup, 'setItemKind, 'setItemName, 'setItemLink, 'setItemGroup, 'setItemKind, --'setItemHackage,
'setItemDescription, 'setItemNotes, 'setItemEcosystem, 'setItemDescription, 'setItemNotes, 'setItemEcosystem,
'setTraitContent, 'setTraitContent,
-- delete -- delete

View File

@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
@ -131,6 +132,14 @@ instance A.ToJSON ItemKind where
toJSON Other = A.object [ toJSON Other = A.object [
"tag" A..= ("Other" :: Text) ] "tag" A..= ("Other" :: Text) ]
instance A.FromJSON ItemKind where
parseJSON = A.withObject "ItemKind" $ \o ->
o A..: "tag" >>= \case
("Library" :: Text) -> Library <$> o A..: "contents"
"Tool" -> Tool <$> o A..: "contents"
"Other" -> pure Other
tag -> fail ("unknown tag " ++ show tag)
data ItemKind_v2 data ItemKind_v2
= Library_v2 (Maybe Text) = Library_v2 (Maybe Text)
| Tool_v2 (Maybe Text) | Tool_v2 (Maybe Text)
@ -158,6 +167,9 @@ deriveSafeCopySimple 0 'base ''ItemSection
instance A.ToJSON ItemSection where instance A.ToJSON ItemSection where
toJSON = A.genericToJSON A.defaultOptions toJSON = A.genericToJSON A.defaultOptions
instance A.FromJSON ItemSection where
parseJSON = A.genericParseJSON A.defaultOptions
-- TODO: add a field like “people to ask on IRC about this library if you -- TODO: add a field like “people to ask on IRC about this library if you
-- need help” -- need help”
@ -206,6 +218,9 @@ deriveSafeCopySimple 2 'extension ''CategoryStatus
instance A.ToJSON CategoryStatus where instance A.ToJSON CategoryStatus where
toJSON = A.genericToJSON A.defaultOptions toJSON = A.genericToJSON A.defaultOptions
instance A.FromJSON CategoryStatus where
parseJSON = A.genericParseJSON A.defaultOptions
data CategoryStatus_v1 data CategoryStatus_v1
= CategoryStub_v1 = CategoryStub_v1
| CategoryWIP_v1 | CategoryWIP_v1

View File

@ -315,6 +315,9 @@ newtype Uid a = Uid {uidToText :: Text}
instance A.ToJSON (Uid a) where instance A.ToJSON (Uid a) where
toJSON = A.toJSON . uidToText toJSON = A.toJSON . uidToText
instance A.FromJSON (Uid a) where
parseJSON a = Uid <$> A.parseJSON a
-- This instance is written manually because otherwise it produces a warning: -- This instance is written manually because otherwise it produces a warning:
-- • Redundant constraint: SafeCopy a -- • Redundant constraint: SafeCopy a
-- • In the instance declaration for SafeCopy (Uid a) -- • In the instance declaration for SafeCopy (Uid a)