symantic-http 0.0.0.20190324 → 0.1.1.20190410

raw patch · 2 files changed

+191/−40 lines, 2 filesdep −timePVP ok

version bump matches the API change (PVP)

Dependencies removed: time

API changes (from Hackage documentation)

Files

• Symantic/HTTP/API.hs +190/−38
• symantic-http.cabal +1/−2

@@ -2,6 +2,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE StrictData #-}+{-# LANGUAGE UndecidableInstances #-} -- for type instance defaults -- | Combinators to build a Web API. module Symantic.HTTP.API where @@ -9,6 +10,7 @@ import Data.Bool import Data.Either (Either(..)) import Data.Eq (Eq(..))+import Data.Function ((.)) import Data.Functor (Functor) import Data.Kind (Constraint) import Data.Proxy (Proxy)@@ -30,7 +32,13 @@ -- with the notable exception of the server instance -- where some HTTP error codes must be prioritized. class Cat repr where-	(<.>) :: repr a b -> repr b c -> repr a c; infixl 4 <.>+	(<.>) :: repr a b -> repr b c -> repr a c; infixr 4 <.>+	-- Trans defaults+	default (<.>) ::+	 Trans repr =>+	 Cat (UnTrans repr) =>+	 repr a b -> repr b c -> repr a c+	x <.> y = noTrans (unTrans x <.> unTrans y) 	-- (.>)  :: repr x y -> repr a c -> repr a c; infixl 4  .>  -- * Class 'Alt'@@ -42,45 +50,119 @@ 	type AltMerge repr :: * -> * -> * 	(<!>) :: repr a b -> repr c d -> repr (a:!:c) (AltMerge repr b d); infixl 3 <!> 	-}-	(<!>) :: repr a k -> repr b k -> repr (a:!:b) k; infixl 3 <!>+	(<!>) :: repr a k -> repr b k -> repr (a:!:b) k; infixr 3 <!>+	-- Trans defaults+	default (<!>) ::+	 Trans repr =>+	 Alt (UnTrans repr) =>+	 repr a k -> repr b k -> repr (a:!:b) k+	x <!> y = noTrans (unTrans x <!> unTrans y) 	-- try :: repr k k -> repr k k 	-- option :: k -> repr k k -> repr k k  -- ** Type (':!:')--- | Like @(,)@ but @infixl@.+-- | Like @(,)@ but @infixr@. -- Used to get alternative commands from a 'Client' -- or to supply alternative handlers to a 'Server'. data (:!:) a b = a:!:b-infixl 3 :!:+infixr 3 :!: +-- * Class 'Trans'+-- | A 'Trans'formation from one representation @('UnTrans' repr)@ to another one @(repr)@.+--+-- * 'noTrans' lifts to the identity 'Trans'formation+--   (the one which does nothing wrt. the 'UnTrans'formed @(repr)@esentation).+-- * 'unTrans' unlifts a 'Trans'formed value to its underlying @(repr)@esentation.+--+-- At its @class@ definition,+-- a combinator should be defined with a default value using 'noTrans'.+-- And at its @instance@ definition,+-- a combinator can be overwritten to apply a specific 'Trans'formation for @(repr)@.+--+-- For an example, see the @('Trans' ('Router' repr))@ instance+-- in <https://hackage.haskell.org/package/symantic-http-server symantic-http-server>.+class Trans repr where+	-- | The @(repr)@esentation that @(repr)@ 'Trans'forms.+	type UnTrans repr :: * -> * -> *+	-- | Lift the underlying @(repr)@esentation to @(repr)@.+	-- Useful to define a combinator that does nothing in a 'Trans'formation.+	noTrans :: UnTrans repr a b -> repr a b+	-- | Unlift a @(repr)@esentation. Useful when a 'Trans'formation+	-- combinator needs to access the 'UnTrans'formed @(repr)@esentation,+	-- or at the end to get the underlying 'UnTrans'formed @(repr)@esentation+	-- from the inferred @(repr)@ value (eg. in 'server').+	unTrans :: repr a b -> UnTrans repr a b+ -- * Class 'Pro' -- | Mainly useful to write a combinator which is a specialization of another -- (eg. 'queryFlag' wrt. 'queryParams'), -- by calling it directly in the class declaration -- instead of rewriting its logic in the instance declaration. ----- Because type @a@ is asked by a 'Client' but given to a 'Server',--- both @a->b@ and @b->a@ are used. This is reminiscent of a 'Profunctor'.+-- Because type @(a)@ is asked by a 'Client' but given to a 'Server',+-- both @(a->b)@ and @(b->a)@ are used. This is reminiscent of a 'Profunctor'. -- Hence the names 'Pro' and 'dimap'. class Pro repr where 	dimap :: (a -> b) -> (b -> a) -> repr (a -> k) k -> repr (b -> k) k+	-- Trans defaults+	default dimap ::+	 Trans repr =>+	 Pro (UnTrans repr) =>+	 (a -> b) -> (b -> a) -> repr (a -> k) k -> repr (b -> k) k+	dimap a2b b2a = noTrans . dimap a2b b2a . unTrans +-- * Class 'HTTP_Raw'+class HTTP_Raw repr where+	type RawConstraint repr :: Constraint+	type RawArgs repr :: *+	type Raw repr :: *+	raw ::+	 RawConstraint repr =>+	 repr (RawArgs repr) (Raw repr)+	-- Trans defaults+	type RawConstraint repr = RawConstraint (UnTrans repr)+	type RawArgs repr = RawArgs (UnTrans repr)+	type Raw repr = Raw (UnTrans repr)+	default raw ::+	 Trans repr =>+	 HTTP_Raw (UnTrans repr) =>+	 RawConstraint (UnTrans repr) =>+	 RawArgs (UnTrans repr) ~ RawArgs repr =>+	 Raw (UnTrans repr) ~ Raw repr =>+	 repr (RawArgs repr) (Raw repr)+	raw = noTrans raw+ -- * Class 'HTTP_Path' class HTTP_Path repr where 	type PathConstraint repr a :: Constraint-	type PathConstraint repr a = ()-	segment :: Segment -> repr k k-	capture' ::-	 PathConstraint repr a =>+	segment :: PathSegment -> repr k k+	capture' :: PathConstraint repr a => Name -> repr (a -> k) k+	captureAll :: repr ([PathSegment] -> k) k+	-- Trans defaults+	type PathConstraint repr a = PathConstraint (UnTrans repr) a+	default segment ::+	 Trans repr =>+	 HTTP_Path (UnTrans repr) =>+	 PathSegment -> repr k k+	default capture' ::+	 Trans repr =>+	 HTTP_Path (UnTrans repr) =>+	 PathConstraint (UnTrans repr) a => 	 Name -> repr (a -> k) k-	captureAll :: repr ([Segment] -> k) k+	default captureAll ::+	 Trans repr =>+	 HTTP_Path (UnTrans repr) =>+	 repr ([PathSegment] -> k) k+	segment    = noTrans . segment+	capture'   = noTrans . capture'+	captureAll = noTrans captureAll  -- | Convenient wrapper of 'segment'.-(</>) :: Cat repr => HTTP_Path repr => Segment -> repr a b -> repr a b-(</>) n = (segment n <.>); infixr 5 </>+(</>) :: Cat repr => HTTP_Path repr => PathSegment -> repr a b -> repr a b+(</>) n = (segment n <.>); infixr 4 </> --- | Like 'capture'' but with the type variable 'a' first instead or 'repr'--- so it can be passed using 'TypeApplications' without adding a @@_@ for 'repr'.+-- | Like 'capture'' but with the type variable @(a)@ first instead or @(repr)@+-- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@. capture ::  forall a k repr.  HTTP_Path repr =>@@ -89,13 +171,19 @@ capture = capture' {-# INLINE capture #-} -type Segment = Text-type Path    = [Segment]-type Name    = String+type PathSegment = Text+type Path = [PathSegment]+type Name = String  -- * Class 'HTTP_Header' class HTTP_Header repr where 	header :: HTTP.HeaderName -> repr (HeaderValue -> k) k+	-- Trans defaults+	default header ::+	 Trans repr =>+	 HTTP_Header (UnTrans repr) =>+	 HTTP.HeaderName -> repr (HeaderValue -> k) k+	header = noTrans . header  type HeaderValue = BS.ByteString @@ -103,14 +191,23 @@ class HTTP_Body repr where 	type BodyArg repr a (ts::[*]) :: * 	type BodyConstraint repr a (ts::[*]) :: Constraint-	type BodyConstraint repr a ts = () 	body' ::-	 forall a (ts::[*]) k. 	 BodyConstraint repr a ts => 	 repr (BodyArg repr a ts -> k) k+	-- Trans defaults+	type BodyArg repr a ts = BodyArg (UnTrans repr) a ts+	type BodyConstraint repr a ts = BodyConstraint (UnTrans repr) a ts+	default body' ::+	 forall a (ts::[*]) k.+	 Trans repr =>+	 HTTP_Body (UnTrans repr) =>+	 BodyConstraint (UnTrans repr) a ts =>+	 BodyArg repr a ts ~ BodyArg (UnTrans repr) a ts =>+	 repr (BodyArg repr a ts -> k) k+	body' = noTrans (body' @_ @a @ts) --- | Like 'body'' but with the type variables 'a' and 'ts' first instead or 'repr',--- so it can be passed using 'TypeApplications' without adding a @@_@ for 'repr'.+-- | Like 'body'' but with the type variables @(a)@ and @(ts)@ first instead or @(repr)@,+-- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@. body ::  forall a ts k repr.  HTTP_Body repr =>@@ -123,14 +220,24 @@ class HTTP_BodyStream repr where 	type BodyStreamArg repr as (ts::[*]) framing :: * 	type BodyStreamConstraint repr as (ts::[*]) framing :: Constraint-	type BodyStreamConstraint repr as ts framing = () 	bodyStream' :: 	 BodyStreamConstraint repr as ts framing => 	 repr (BodyStreamArg repr as ts framing -> k) k+	-- Trans defaults+	type BodyStreamArg repr as ts framing = BodyStreamArg (UnTrans repr) as ts framing+	type BodyStreamConstraint repr as ts framing = BodyStreamConstraint (UnTrans repr) as ts framing+	default bodyStream' ::+	 forall as ts framing k.+	 Trans repr =>+	 HTTP_BodyStream (UnTrans repr) =>+	 BodyStreamConstraint (UnTrans repr) as ts framing =>+	 BodyStreamArg repr as ts framing ~ BodyStreamArg (UnTrans repr) as ts framing =>+	 repr (BodyStreamArg repr as ts framing -> k) k+	bodyStream' = noTrans (bodyStream' @_ @as @ts @framing) --- | Like 'bodyStream'' but with the type variables 'as', 'ts' and 'framing'--- first instead or 'repr', so it can be passed using 'TypeApplications'--- without adding a @@_@ for 'repr'.+-- | Like 'bodyStream'' but with the type variables @(as)@, @(ts)@ and @(framing)@+-- first instead or @(repr)@, so it can be passed using 'TypeApplications'+-- without adding a |\@_| for @(repr)@. bodyStream ::  forall as ts framing k repr.  HTTP_BodyStream repr =>@@ -142,7 +249,6 @@ -- * Class 'HTTP_Query' class HTTP_Query repr where 	type QueryConstraint repr a :: Constraint-	type QueryConstraint repr a = () 	queryParams' :: 	 QueryConstraint repr a => 	 QueryName -> repr ([a] -> k) k@@ -154,11 +260,19 @@ 	 QueryConstraint repr Bool => 	 QueryName -> repr (Bool -> k) k 	queryFlag n = dimap and return (queryParams' n)-type QueryName   = BS.ByteString-type QueryValue  = BS.ByteString+	-- Trans defaults+	type QueryConstraint repr a = QueryConstraint (UnTrans repr) a+	default queryParams' ::+	 Trans repr =>+	 HTTP_Query (UnTrans repr) =>+	 QueryConstraint (UnTrans repr) a =>+	 QueryName -> repr ([a] -> k) k+	queryParams' = noTrans . queryParams'+type QueryName  = BS.ByteString+type QueryValue = BS.ByteString --- | Like 'capture'' but with the type variable 'a' first instead or 'repr'--- so it can be passed using 'TypeApplications' without adding a @@_@ for 'repr'.+-- | Like 'capture'' but with the type variable @(a)@ first instead or @(repr)@+-- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@. queryParams ::  forall a k repr.  HTTP_Query repr =>@@ -171,14 +285,24 @@ -- | <https://tools.ietf.org/html/rfc2617#section-2 Basic Access Authentication> class HTTP_BasicAuth repr where 	type BasicAuthConstraint repr a :: Constraint-	type BasicAuthConstraint repr a = () 	type BasicAuthArgs repr a k :: * 	basicAuth' :: 	 BasicAuthConstraint repr a => 	 BasicAuthRealm -> repr (BasicAuthArgs repr a k) k+	-- Trans defaults+	type BasicAuthConstraint repr a = BasicAuthConstraint (UnTrans repr) a+	type BasicAuthArgs repr a k = BasicAuthArgs (UnTrans repr) a k+	default basicAuth' ::+	 forall a k.+	 Trans repr =>+	 HTTP_BasicAuth (UnTrans repr) =>+	 BasicAuthConstraint (UnTrans repr) a =>+	 BasicAuthArgs repr a k ~ BasicAuthArgs (UnTrans repr) a k =>+	 BasicAuthRealm -> repr (BasicAuthArgs repr a k) k+	basicAuth' = noTrans . basicAuth' @_ @a --- | Like 'basicAuth'' but with the type variable 'a' first instead or 'repr'--- so it can be passed using 'TypeApplications' without adding a @@_@ for 'repr'.+-- | Like 'basicAuth'' but with the type variable @(a)@ first instead or @(repr)@+-- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@. basicAuth ::  forall a k repr.  HTTP_BasicAuth repr =>@@ -231,7 +355,6 @@ -- * Class 'HTTP_Response' class HTTP_Response repr where 	type ResponseConstraint repr a (ts::[*]) :: Constraint-	type ResponseConstraint repr a ts = () 	type ResponseArgs repr a (ts::[*]) :: * 	type Response repr :: * 	response ::@@ -239,11 +362,26 @@ 	 HTTP.Method -> 	 repr (ResponseArgs repr a ts) 	      (Response repr)+	-- Trans defaults+	type ResponseConstraint repr a ts = ResponseConstraint (UnTrans repr) a ts+	type ResponseArgs repr a ts = ResponseArgs (UnTrans repr) a ts+	type Response repr = Response (UnTrans repr)+	default response ::+	 forall a ts.+	 Trans repr =>+	 HTTP_Response (UnTrans repr) =>+	 ResponseConstraint (UnTrans repr) a ts =>+	 ResponseArgs repr a ts ~ ResponseArgs (UnTrans repr) a ts =>+	 Response repr ~ Response (UnTrans repr) =>+	 HTTP.Method ->+	 repr (ResponseArgs repr a ts)+	      (Response repr)+	response = noTrans . response @_ @a @ts  -- | Wrap 'response' by giving it the corresponding 'HTTP.Method',--- and put the type variables 'a' then 'ts' first instead or 'repr'+-- and put the type variables @(a)@ then @(ts)@ first instead or @(repr)@ -- so they can be passed using 'TypeApplications'--- without adding a |@_| for 'repr'.+-- without adding a |@_| for @(repr)@. get,head,put,post,delete,trace,connect,options,patch ::  forall a ts repr.  HTTP_Response repr =>@@ -272,7 +410,6 @@ -- * Class 'HTTP_ResponseStream' class HTTP_ResponseStream repr where 	type ResponseStreamConstraint repr as (ts::[*]) framing :: Constraint-	type ResponseStreamConstraint repr as ts framing = () 	type ResponseStreamArgs repr as (ts::[*]) framing :: * 	type ResponseStream repr :: * 	responseStream ::@@ -280,6 +417,21 @@ 	 HTTP.Method -> 	 repr (ResponseStreamArgs repr as ts framing) 	      (ResponseStream repr)+	-- Trans defaults+	type ResponseStreamConstraint repr as ts framing = ResponseStreamConstraint (UnTrans repr) as ts framing+	type ResponseStreamArgs repr as ts framing = ResponseStreamArgs (UnTrans repr) as ts framing+	type ResponseStream repr = ResponseStream (UnTrans repr)+	default responseStream ::+	 forall as ts framing.+	 Trans repr =>+	 HTTP_ResponseStream (UnTrans repr) =>+	 ResponseStreamConstraint (UnTrans repr) as ts framing =>+	 ResponseStreamArgs repr as ts framing ~ ResponseStreamArgs (UnTrans repr) as ts framing =>+	 ResponseStream repr ~ ResponseStream (UnTrans repr) =>+	 HTTP.Method ->+	 repr (ResponseStreamArgs repr as ts framing)+	      (ResponseStream repr)+	responseStream = noTrans . responseStream @_ @as @ts @framing  getStream,headStream,putStream,postStream,deleteStream,traceStream,connectStream,optionsStream,patchStream ::  forall as ts framing repr.

@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.0.20190324+version: 0.1.1.20190410 category: Protocol synopsis: Symantic combinators for deriving clients or a server from an HTTP API description:@@ -118,5 +118,4 @@     , network-uri >= 2.6     , stm >= 2.4.5     , text >= 1.2-    , time >= 1.8     , transformers >= 0.5