Skip to content

Commit

Permalink
Renamed AtLeastOneFragment type class to AtMostOneFragment (haske…
Browse files Browse the repository at this point in the history
…ll-servant#1727)

* Renamed `AtLeastOneFragment` to `AtMostOneFragment`
  • Loading branch information
DavidMazarro authored Mar 16, 2024
1 parent 1740e5e commit ef4b38a
Show file tree
Hide file tree
Showing 4 changed files with 26 additions and 15 deletions.
10 changes: 10 additions & 0 deletions changelog.d/1727
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
synopsis: Renamed `AtLeastOneFragment` type class to `AtMostOneFragment`
prs: #1720

description: {

The previously named `AtLeastOneFragment` type class defined in the
`Servant.API.TypeLevel` module has been renamed to `AtMostOneFragment`,
since the previous name was misleading.

}
4 changes: 2 additions & 2 deletions servant-client-core/src/Servant/Client/Core/HasClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,7 @@ import Servant.API.ContentTypes
(contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
import Servant.API.Status
(statusFromNat)
import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
import Servant.API.TypeLevel (FragmentUnique, AtMostOneFragment)
import Servant.API.Modifiers
(FoldRequired, RequiredArgument, foldRequiredArgument)
import Servant.API.TypeErrors
Expand Down Expand Up @@ -821,7 +821,7 @@ instance ( HasClient m api
-- > getBooks = client myApi
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooks' for all books.
instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
instance (AtMostOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
) => HasClient m (Fragment a :> api) where

type Client m (Fragment a :> api) = Client m api
Expand Down
4 changes: 2 additions & 2 deletions servant-server/src/Servant/Server/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,7 @@ import Servant.Server.Internal.ServerError
import GHC.TypeLits
(ErrorMessage (..), TypeError)
import Servant.API.TypeLevel
(AtLeastOneFragment, FragmentUnique)
(AtMostOneFragment, FragmentUnique)

class HasServer api context where
-- | The type of a server for this API, given a monad to run effects in.
Expand Down Expand Up @@ -961,7 +961,7 @@ instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context))
-- > server = getBooks
-- > where getBooks :: Handler [Book]
-- > getBooks = ...return all books...
instance (AtLeastOneFragment api, FragmentUnique (Fragment a1 :> api), HasServer api context)
instance (AtMostOneFragment api, FragmentUnique (Fragment a1 :> api), HasServer api context)
=> HasServer (Fragment a1 :> api) context where
type ServerT (Fragment a1 :> api) m = ServerT api m

Expand Down
23 changes: 12 additions & 11 deletions servant/src/Servant/API/TypeLevel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ module Servant.API.TypeLevel (
And,
-- ** Fragment
FragmentUnique,
AtLeastOneFragment
AtMostOneFragment
) where


Expand Down Expand Up @@ -244,14 +244,14 @@ type family ElemGo e es orig :: Constraint where

-- ** Logic

-- | If either a or b produce an empty constraint, produce an empty constraint.
-- | If either 'a' or 'b' produce an empty constraint, produce an empty constraint.
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
-- This works because of:
-- https://ghc.haskell.org/trac/ghc/wiki/NewAxioms/CoincidentOverlap
Or () b = ()
Or a () = ()

-- | If both a or b produce an empty constraint, produce an empty constraint.
-- | If both 'a' or 'b' produce an empty constraint, produce an empty constraint.
type family And (a :: Constraint) (b :: Constraint) :: Constraint where
And () () = ()

Expand All @@ -263,21 +263,22 @@ families are not evaluated (see https://ghc.haskell.org/trac/ghc/ticket/12048).

-- ** Fragment

class FragmentUnique api => AtLeastOneFragment api

-- | If fragment appeared in API endpoint twice, compile-time error would be raised.
-- | If there is more than one fragment in an API endpoint,
-- a compile-time error is raised.
--
-- >>> -- type FailAPI = Fragment Bool :> Fragment Int :> Get '[JSON] NoContent
-- >>> instance AtLeastOneFragment FailAPI
-- >>> type FailAPI = Fragment Bool :> Fragment Int :> Get '[JSON] NoContent
-- >>> instance AtMostOneFragment FailAPI
-- ...
-- ...Only one Fragment allowed per endpoint in api...
-- ...
-- ...In the instance declaration for...
instance AtLeastOneFragment (Verb m s ct typ)
class FragmentUnique api => AtMostOneFragment api

instance AtMostOneFragment (Verb m s ct typ)

instance AtLeastOneFragment (UVerb m cts as)
instance AtMostOneFragment (UVerb m cts as)

instance AtLeastOneFragment (Fragment a)
instance AtMostOneFragment (Fragment a)

type family FragmentUnique api :: Constraint where
FragmentUnique (sa :<|> sb) = And (FragmentUnique sa) (FragmentUnique sb)
Expand Down

0 comments on commit ef4b38a

Please sign in to comment.