{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BlockArguments #-} module Servant.Util.Combinators.Sorting.Swagger () where import Universum import Control.Lens ((<>~), (?~)) import qualified Data.Swagger as S import qualified Data.Text as T import Fmt (build, fmt, unlinesF) import Servant.API ((:>)) import Servant.Swagger (HasSwagger (..)) import Servant.Util.Combinators.Sorting.Base import Servant.Util.Common instance (HasSwagger api, ReifySortingItems base, ReifyParamsNames provided) => HasSwagger (SortingParams provided base :> api) where toSwagger :: Proxy (SortingParams provided base :> api) -> Swagger toSwagger Proxy (SortingParams provided base :> api) _ = Proxy api -> Swagger forall k (api :: k). HasSwagger api => Proxy api -> Swagger toSwagger (Proxy api forall k (t :: k). Proxy t Proxy @api) Swagger -> (Swagger -> Swagger) -> Swagger forall a b. a -> (a -> b) -> b & (Operation -> Identity Operation) -> Swagger -> Identity Swagger Traversal' Swagger Operation S.allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger) -> (([Referenced Param] -> Identity [Referenced Param]) -> Operation -> Identity Operation) -> ([Referenced Param] -> Identity [Referenced Param]) -> Swagger -> Identity Swagger forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Referenced Param] -> Identity [Referenced Param]) -> Operation -> Identity Operation forall s a. HasParameters s a => Lens' s a S.parameters (([Referenced Param] -> Identity [Referenced Param]) -> Swagger -> Identity Swagger) -> [Referenced Param] -> Swagger -> Swagger forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t <>~ [Param -> Referenced Param forall a. a -> Referenced a S.Inline Param param] where param :: Param param = Param forall a. Monoid a => a mempty Param -> (Param -> Param) -> Param forall a b. a -> (a -> b) -> b & (Text -> Identity Text) -> Param -> Identity Param forall s a. HasName s a => Lens' s a S.name ((Text -> Identity Text) -> Param -> Identity Param) -> Text -> Param -> Param forall s t a b. ASetter s t a b -> b -> s -> t .~ Text "sortBy" Param -> (Param -> Param) -> Param forall a b. a -> (a -> b) -> b & (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param forall s a. HasDescription s a => Lens' s a S.description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param) -> Text -> Param -> Param forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ Builder -> Text forall b. FromBuilder b => Builder -> b fmt do [Builder] -> Builder forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder unlinesF [ Builder "Allows lexicographical sorting on fields." , Builder "General format is one of:" , Builder " * `+field1,-field2`" , Builder " * `asc(field1),desc(field2)`" , Builder "" , Builder allowedFieldsDesc , Builder baseFieldsDesc , Builder " " ] Param -> (Param -> Param) -> Param forall a b. a -> (a -> b) -> b & (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param forall s a. HasRequired s a => Lens' s a S.required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param) -> Bool -> Param -> Param forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ Bool False Param -> (Param -> Param) -> Param forall a b. a -> (a -> b) -> b & (ParamAnySchema -> Identity ParamAnySchema) -> Param -> Identity Param forall s a. HasSchema s a => Lens' s a S.schema ((ParamAnySchema -> Identity ParamAnySchema) -> Param -> Identity Param) -> ParamAnySchema -> Param -> Param forall s t a b. ASetter s t a b -> b -> s -> t .~ ParamOtherSchema -> ParamAnySchema S.ParamOther (ParamOtherSchema forall a. Monoid a => a mempty ParamOtherSchema -> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema forall a b. a -> (a -> b) -> b & (ParamLocation -> Identity ParamLocation) -> ParamOtherSchema -> Identity ParamOtherSchema forall s a. HasIn s a => Lens' s a S.in_ ((ParamLocation -> Identity ParamLocation) -> ParamOtherSchema -> Identity ParamOtherSchema) -> ParamLocation -> ParamOtherSchema -> ParamOtherSchema forall s t a b. ASetter s t a b -> b -> s -> t .~ ParamLocation S.ParamQuery ParamOtherSchema -> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema forall a b. a -> (a -> b) -> b & (ParamSchema 'SwaggerKindParamOtherSchema -> Identity (ParamSchema 'SwaggerKindParamOtherSchema)) -> ParamOtherSchema -> Identity ParamOtherSchema forall s a. HasParamSchema s a => Lens' s a S.paramSchema ((ParamSchema 'SwaggerKindParamOtherSchema -> Identity (ParamSchema 'SwaggerKindParamOtherSchema)) -> ParamOtherSchema -> Identity ParamOtherSchema) -> ParamSchema 'SwaggerKindParamOtherSchema -> ParamOtherSchema -> ParamOtherSchema forall s t a b. ASetter s t a b -> b -> s -> t .~ ParamSchema 'SwaggerKindParamOtherSchema paramSchema ) paramSchema :: ParamSchema 'SwaggerKindParamOtherSchema paramSchema = ParamSchema 'SwaggerKindParamOtherSchema forall a. Monoid a => a mempty ParamSchema 'SwaggerKindParamOtherSchema -> (ParamSchema 'SwaggerKindParamOtherSchema -> ParamSchema 'SwaggerKindParamOtherSchema) -> ParamSchema 'SwaggerKindParamOtherSchema forall a b. a -> (a -> b) -> b & (Maybe (SwaggerType 'SwaggerKindParamOtherSchema) -> Identity (Maybe (SwaggerType 'SwaggerKindParamOtherSchema))) -> ParamSchema 'SwaggerKindParamOtherSchema -> Identity (ParamSchema 'SwaggerKindParamOtherSchema) forall s a. HasType s a => Lens' s a S.type_ ((Maybe (SwaggerType 'SwaggerKindParamOtherSchema) -> Identity (Maybe (SwaggerType 'SwaggerKindParamOtherSchema))) -> ParamSchema 'SwaggerKindParamOtherSchema -> Identity (ParamSchema 'SwaggerKindParamOtherSchema)) -> SwaggerType 'SwaggerKindParamOtherSchema -> ParamSchema 'SwaggerKindParamOtherSchema -> ParamSchema 'SwaggerKindParamOtherSchema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ SwaggerType 'SwaggerKindParamOtherSchema forall (t :: SwaggerKind *). SwaggerType t S.SwaggerString ParamSchema 'SwaggerKindParamOtherSchema -> (ParamSchema 'SwaggerKindParamOtherSchema -> ParamSchema 'SwaggerKindParamOtherSchema) -> ParamSchema 'SwaggerKindParamOtherSchema forall a b. a -> (a -> b) -> b & (Maybe Text -> Identity (Maybe Text)) -> ParamSchema 'SwaggerKindParamOtherSchema -> Identity (ParamSchema 'SwaggerKindParamOtherSchema) forall s a. HasPattern s a => Lens' s a S.pattern ((Maybe Text -> Identity (Maybe Text)) -> ParamSchema 'SwaggerKindParamOtherSchema -> Identity (ParamSchema 'SwaggerKindParamOtherSchema)) -> Text -> ParamSchema 'SwaggerKindParamOtherSchema -> ParamSchema 'SwaggerKindParamOtherSchema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ Text "^" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text fieldPattern Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "(," Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text fieldPattern Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")*" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "$" fieldPattern :: Text fieldPattern = Text "(" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "[+-](" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text allowedFieldsPattern Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")+" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "|" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "(asc|desc)\\((" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text allowedFieldsPattern Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")+\\))" allowedFields :: [Text] allowedFields = ReifyParamsNames provided => [Text] forall k (params :: [TyNamedParam k]). ReifyParamsNames params => [Text] reifyParamsNames @provided allowedFieldsDesc :: Builder allowedFieldsDesc = [Builder] -> Builder forall a. Monoid a => [a] -> a mconcat [ Builder " Fields allowed for this endpoint: " , [Builder] -> Builder forall a. Monoid a => [a] -> a mconcat ([Builder] -> Builder) -> ([Builder] -> [Builder]) -> [Builder] -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . Builder -> [Builder] -> [Builder] forall a. a -> [a] -> [a] intersperse Builder ", " ([Builder] -> Builder) -> [Builder] -> Builder forall a b. (a -> b) -> a -> b $ (Text -> Builder) -> [Text] -> [Builder] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b map ((Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder "`") (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . (Builder "`" Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <>) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Builder forall p. Buildable p => p -> Builder build) [Text] allowedFields ] allowedFieldsPattern :: Text allowedFieldsPattern = Text -> [Text] -> Text T.intercalate Text "|" [Text] allowedFields baseFields :: [SortingItem] baseFields = ReifySortingItems base => [SortingItem] forall (items :: [TyNamedParam (SortingOrderType *)]). ReifySortingItems items => [SortingItem] reifySortingItems @base baseFieldsDesc :: Builder baseFieldsDesc | [SortingItem] -> Bool forall t. Container t => t -> Bool null [SortingItem] baseFields = Builder "" | Bool otherwise = [Builder] -> Builder forall a. Monoid a => [a] -> a mconcat [ Builder " Base sorting (always applied, lexicographically last): " , Builder "`" , [Builder] -> Builder forall a. Monoid a => [a] -> a mconcat ([Builder] -> Builder) -> ([Builder] -> [Builder]) -> [Builder] -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . Builder -> [Builder] -> [Builder] forall a. a -> [a] -> [a] intersperse Builder ", " ([Builder] -> Builder) -> [Builder] -> Builder forall a b. (a -> b) -> a -> b $ (SortingItem -> Builder) -> [SortingItem] -> [Builder] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b map SortingItem -> Builder forall p. Buildable p => p -> Builder build [SortingItem] baseFields , Builder "`" ]