Skip to content

Simplify rangedSchema function #2017

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jan 4, 2022
Merged

Simplify rangedSchema function #2017

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions changelog.d/5-internal/simplify-ranged-schema
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
`rangedSchema` does not need to be passed singletons explicitly anymore
10 changes: 4 additions & 6 deletions libs/types-common/src/Data/Range.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -122,14 +122,12 @@ instance (Within a n m, FromJSON a) => FromJSON (Range n m a) where
msg sn sm = fail (errorMsg (fromSing sn) (fromSing sm) "")

rangedSchema ::
forall n m d v w a b.
(Within a n m, HasRangedSchemaDocModifier d b) =>
SNat n ->
SNat m ->
SchemaP d v w a b ->
SchemaP d v w a (Range n m b)
rangedSchema sn sm sch = Range <$> untypedRangedSchema (get sn) (get sm) sch
where
get = toInteger . fromSing
rangedSchema sch =
Range <$> untypedRangedSchema (toInteger (demote @n)) (toInteger (demote @m)) sch

untypedRangedSchema ::
forall d v w a b.
Expand Down Expand Up @@ -181,7 +179,7 @@ instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word32 where ran
instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word64 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier

instance (Within a n m, ToSchema a, HasRangedSchemaDocModifier NamedSwaggerDoc a) => ToSchema (Range n m a) where
schema = fromRange .= rangedSchema sing sing schema
schema = fromRange .= rangedSchema schema

instance (Within a n m, Cql a) => Cql (Range n m a) where
ctype = retag (ctype :: Tagged a ColumnType)
Expand Down
3 changes: 1 addition & 2 deletions libs/wire-api/src/Wire/API/Conversation.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -100,7 +100,6 @@ import Data.Qualified (Qualified (qUnqualified), deprecatedSchema)
import Data.Range (Range, fromRange, rangedSchema)
import Data.Schema
import qualified Data.Set as Set
import Data.Singletons (sing)
import Data.String.Conversions (cs)
import qualified Data.Swagger as S
import qualified Data.Swagger.Build.Api as Doc
Expand Down Expand Up @@ -366,7 +365,7 @@ instance ToSchema ListConversations where
"ListConversations"
(description ?~ "A request to list some of a user's conversations, including remote ones. Maximum 1000 qualified conversation IDs")
$ ListConversations
<$> (fromRange . lcQualifiedIds) .= field "qualified_ids" (rangedSchema sing sing (array schema))
<$> (fromRange . lcQualifiedIds) .= field "qualified_ids" (rangedSchema (array schema))

data ConversationsResponse = ConversationsResponse
{ crFound :: [Conversation],
Expand Down
3 changes: 1 addition & 2 deletions libs/wire-api/src/Wire/API/Team.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,6 @@ import Data.Id (TeamId, UserId)
import Data.Misc (PlainTextPassword (..))
import Data.Range
import Data.Schema
import Data.Singletons (sing)
import qualified Data.Swagger as S
import qualified Data.Swagger.Build.Api as Doc
import Imports
Expand Down Expand Up @@ -215,7 +214,7 @@ instance ToSchema NonBindingNewTeam where
unwrap (NonBindingNewTeam nt) = nt

sch :: ValueSchema SwaggerDoc (Range 1 127 [TeamMember])
sch = fromRange .= rangedSchema sing sing (array schema)
sch = fromRange .= rangedSchema (array schema)

modelNewNonBindingTeam :: Doc.Model
modelNewNonBindingTeam = Doc.defineModel "newNonBindingTeam" $ do
Expand Down