module Servant.Util.Combinators.Sorting.Base
( SortingParams
, SortParamsExpanded
, SortingSpec (..)
, ssBase
, ssAll
, SortingOrder (..)
, NullsSortingOrder (..)
, SortingItemTagged (..)
, SortingItem (..)
, TaggedSortingItemsList
, SortingOrderType (..)
, ReifySortingItems (..)
, BaseSortingToParam
, AllSortingParams
, SortingParamProvidedOf
, SortingParamBaseOf
, SortingParamsOf
, SortingSpecOf
) where
import Universum
import Data.List (nubBy)
import Fmt (Buildable (..))
import GHC.TypeLits (KnownSymbol)
import Servant (QueryParam, (:>))
import Servant.API (NoContent)
import Servant.Server (Tagged (..))
import Servant.Util.Common
import qualified Text.Show
data SortingParams
(provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)])
type SortParamsExpanded allowed subApi =
QueryParam "sortBy" (TaggedSortingItemsList allowed) :> subApi
data SortingOrder
= Descendant
| Ascendant
deriving (Int -> SortingOrder -> ShowS
[SortingOrder] -> ShowS
SortingOrder -> String
(Int -> SortingOrder -> ShowS)
-> (SortingOrder -> String)
-> ([SortingOrder] -> ShowS)
-> Show SortingOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortingOrder] -> ShowS
$cshowList :: [SortingOrder] -> ShowS
show :: SortingOrder -> String
$cshow :: SortingOrder -> String
showsPrec :: Int -> SortingOrder -> ShowS
$cshowsPrec :: Int -> SortingOrder -> ShowS
Show, SortingOrder -> SortingOrder -> Bool
(SortingOrder -> SortingOrder -> Bool)
-> (SortingOrder -> SortingOrder -> Bool) -> Eq SortingOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortingOrder -> SortingOrder -> Bool
$c/= :: SortingOrder -> SortingOrder -> Bool
== :: SortingOrder -> SortingOrder -> Bool
$c== :: SortingOrder -> SortingOrder -> Bool
Eq, Int -> SortingOrder
SortingOrder -> Int
SortingOrder -> [SortingOrder]
SortingOrder -> SortingOrder
SortingOrder -> SortingOrder -> [SortingOrder]
SortingOrder -> SortingOrder -> SortingOrder -> [SortingOrder]
(SortingOrder -> SortingOrder)
-> (SortingOrder -> SortingOrder)
-> (Int -> SortingOrder)
-> (SortingOrder -> Int)
-> (SortingOrder -> [SortingOrder])
-> (SortingOrder -> SortingOrder -> [SortingOrder])
-> (SortingOrder -> SortingOrder -> [SortingOrder])
-> (SortingOrder -> SortingOrder -> SortingOrder -> [SortingOrder])
-> Enum SortingOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SortingOrder -> SortingOrder -> SortingOrder -> [SortingOrder]
$cenumFromThenTo :: SortingOrder -> SortingOrder -> SortingOrder -> [SortingOrder]
enumFromTo :: SortingOrder -> SortingOrder -> [SortingOrder]
$cenumFromTo :: SortingOrder -> SortingOrder -> [SortingOrder]
enumFromThen :: SortingOrder -> SortingOrder -> [SortingOrder]
$cenumFromThen :: SortingOrder -> SortingOrder -> [SortingOrder]
enumFrom :: SortingOrder -> [SortingOrder]
$cenumFrom :: SortingOrder -> [SortingOrder]
fromEnum :: SortingOrder -> Int
$cfromEnum :: SortingOrder -> Int
toEnum :: Int -> SortingOrder
$ctoEnum :: Int -> SortingOrder
pred :: SortingOrder -> SortingOrder
$cpred :: SortingOrder -> SortingOrder
succ :: SortingOrder -> SortingOrder
$csucc :: SortingOrder -> SortingOrder
Enum)
data NullsSortingOrder
= NullsFirst
| NullsLast
deriving (Int -> NullsSortingOrder -> ShowS
[NullsSortingOrder] -> ShowS
NullsSortingOrder -> String
(Int -> NullsSortingOrder -> ShowS)
-> (NullsSortingOrder -> String)
-> ([NullsSortingOrder] -> ShowS)
-> Show NullsSortingOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullsSortingOrder] -> ShowS
$cshowList :: [NullsSortingOrder] -> ShowS
show :: NullsSortingOrder -> String
$cshow :: NullsSortingOrder -> String
showsPrec :: Int -> NullsSortingOrder -> ShowS
$cshowsPrec :: Int -> NullsSortingOrder -> ShowS
Show, NullsSortingOrder -> NullsSortingOrder -> Bool
(NullsSortingOrder -> NullsSortingOrder -> Bool)
-> (NullsSortingOrder -> NullsSortingOrder -> Bool)
-> Eq NullsSortingOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NullsSortingOrder -> NullsSortingOrder -> Bool
$c/= :: NullsSortingOrder -> NullsSortingOrder -> Bool
== :: NullsSortingOrder -> NullsSortingOrder -> Bool
$c== :: NullsSortingOrder -> NullsSortingOrder -> Bool
Eq, Int -> NullsSortingOrder
NullsSortingOrder -> Int
NullsSortingOrder -> [NullsSortingOrder]
NullsSortingOrder -> NullsSortingOrder
NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
NullsSortingOrder
-> NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
(NullsSortingOrder -> NullsSortingOrder)
-> (NullsSortingOrder -> NullsSortingOrder)
-> (Int -> NullsSortingOrder)
-> (NullsSortingOrder -> Int)
-> (NullsSortingOrder -> [NullsSortingOrder])
-> (NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder])
-> (NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder])
-> (NullsSortingOrder
-> NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder])
-> Enum NullsSortingOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NullsSortingOrder
-> NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
$cenumFromThenTo :: NullsSortingOrder
-> NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
enumFromTo :: NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
$cenumFromTo :: NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
enumFromThen :: NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
$cenumFromThen :: NullsSortingOrder -> NullsSortingOrder -> [NullsSortingOrder]
enumFrom :: NullsSortingOrder -> [NullsSortingOrder]
$cenumFrom :: NullsSortingOrder -> [NullsSortingOrder]
fromEnum :: NullsSortingOrder -> Int
$cfromEnum :: NullsSortingOrder -> Int
toEnum :: Int -> NullsSortingOrder
$ctoEnum :: Int -> NullsSortingOrder
pred :: NullsSortingOrder -> NullsSortingOrder
$cpred :: NullsSortingOrder -> NullsSortingOrder
succ :: NullsSortingOrder -> NullsSortingOrder
$csucc :: NullsSortingOrder -> NullsSortingOrder
Enum)
data SortingItem = SortingItem
{ SortingItem -> Text
siName :: Text
, SortingItem -> SortingOrder
siOrder :: SortingOrder
} deriving (Int -> SortingItem -> ShowS
[SortingItem] -> ShowS
SortingItem -> String
(Int -> SortingItem -> ShowS)
-> (SortingItem -> String)
-> ([SortingItem] -> ShowS)
-> Show SortingItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortingItem] -> ShowS
$cshowList :: [SortingItem] -> ShowS
show :: SortingItem -> String
$cshow :: SortingItem -> String
showsPrec :: Int -> SortingItem -> ShowS
$cshowsPrec :: Int -> SortingItem -> ShowS
Show)
newtype SortingItemTagged (provided :: TyNamedParam *) = SortingItemTagged
{ SortingItemTagged provided -> SortingItem
untagSortingItem :: SortingItem
} deriving (Int -> SortingItemTagged provided -> ShowS
[SortingItemTagged provided] -> ShowS
SortingItemTagged provided -> String
(Int -> SortingItemTagged provided -> ShowS)
-> (SortingItemTagged provided -> String)
-> ([SortingItemTagged provided] -> ShowS)
-> Show (SortingItemTagged provided)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (provided :: TyNamedParam *).
Int -> SortingItemTagged provided -> ShowS
forall (provided :: TyNamedParam *).
[SortingItemTagged provided] -> ShowS
forall (provided :: TyNamedParam *).
SortingItemTagged provided -> String
showList :: [SortingItemTagged provided] -> ShowS
$cshowList :: forall (provided :: TyNamedParam *).
[SortingItemTagged provided] -> ShowS
show :: SortingItemTagged provided -> String
$cshow :: forall (provided :: TyNamedParam *).
SortingItemTagged provided -> String
showsPrec :: Int -> SortingItemTagged provided -> ShowS
$cshowsPrec :: forall (provided :: TyNamedParam *).
Int -> SortingItemTagged provided -> ShowS
Show)
instance Buildable SortingItem where
build :: SortingItem -> Builder
build SortingItem{Text
SortingOrder
siOrder :: SortingOrder
siName :: Text
siOrder :: SortingItem -> SortingOrder
siName :: SortingItem -> Text
..} =
let order :: Builder
order = case SortingOrder
siOrder of { SortingOrder
Ascendant -> Builder
"⯅ "; SortingOrder
Descendant -> Builder
"⯆ " }
in Builder
order Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
siName
deriving instance Buildable (SortingItemTagged param)
type TaggedSortingItemsList provided = Tagged (provided :: [TyNamedParam *]) [SortingItem]
data SortingOrderType k
= Desc k
| Asc k
data SortingSpec
(provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)]) =
ReifySortingItems base =>
SortingSpec
{ SortingSpec provided base -> [SortingItem]
ssProvided :: [SortingItem]
}
instance Show (SortingSpec provided base) where
show :: SortingSpec provided base -> String
show SortingSpec provided base
s =
String
"SortingSpec {ssProvided = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SortingItem] -> String
forall b a. (Show a, IsString b) => a -> b
show (SortingSpec provided base -> [SortingItem]
forall (provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)]).
SortingSpec provided base -> [SortingItem]
ssProvided SortingSpec provided base
s) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
", ssBase = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SortingItem] -> String
forall b a. (Show a, IsString b) => a -> b
show (SortingSpec provided base -> [SortingItem]
forall (base :: [TyNamedParam (SortingOrderType *)])
(provided :: [TyNamedParam *]).
SortingSpec provided base -> [SortingItem]
ssBase SortingSpec provided base
s) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
ssBase :: forall base provided. SortingSpec provided base -> [SortingItem]
ssBase :: SortingSpec provided base -> [SortingItem]
ssBase SortingSpec{} = ReifySortingItems base => [SortingItem]
forall (items :: [TyNamedParam (SortingOrderType *)]).
ReifySortingItems items =>
[SortingItem]
reifySortingItems @base
class ReifySortingItems (items :: [TyNamedParam (SortingOrderType *)]) where
reifySortingItems :: [SortingItem]
instance ReifySortingItems '[] where
reifySortingItems :: [SortingItem]
reifySortingItems = []
instance ( ReifySortingOrder order, KnownSymbol name
, ReifySortingItems items
) => ReifySortingItems ('TyNamedParam name (order field) ': items) where
reifySortingItems :: [SortingItem]
reifySortingItems =
SortingItem :: Text -> SortingOrder -> SortingItem
SortingItem
{ siName :: Text
siName = KnownSymbol name => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT @name
, siOrder :: SortingOrder
siOrder = ReifySortingOrder order => SortingOrder
forall (order :: * -> SortingOrderType *).
ReifySortingOrder order =>
SortingOrder
reifySortingOrder @order
} SortingItem -> [SortingItem] -> [SortingItem]
forall a. a -> [a] -> [a]
: ReifySortingItems items => [SortingItem]
forall (items :: [TyNamedParam (SortingOrderType *)]).
ReifySortingItems items =>
[SortingItem]
reifySortingItems @items
class ReifySortingOrder (order :: * -> SortingOrderType *) where
reifySortingOrder :: SortingOrder
instance ReifySortingOrder 'Asc where
reifySortingOrder :: SortingOrder
reifySortingOrder = SortingOrder
Ascendant
instance ReifySortingOrder 'Desc where
reifySortingOrder :: SortingOrder
reifySortingOrder = SortingOrder
Descendant
ssAll :: SortingSpec provided base -> [SortingItem]
ssAll :: SortingSpec provided base -> [SortingItem]
ssAll SortingSpec provided base
s = (SortingItem -> SortingItem -> Bool)
-> [SortingItem] -> [SortingItem]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (SortingItem -> Text) -> SortingItem -> SortingItem -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SortingItem -> Text
siName) (SortingSpec provided base -> [SortingItem]
forall (provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)]).
SortingSpec provided base -> [SortingItem]
ssProvided SortingSpec provided base
s [SortingItem] -> [SortingItem] -> [SortingItem]
forall a. Semigroup a => a -> a -> a
<> SortingSpec provided base -> [SortingItem]
forall (base :: [TyNamedParam (SortingOrderType *)])
(provided :: [TyNamedParam *]).
SortingSpec provided base -> [SortingItem]
ssBase SortingSpec provided base
s)
type family BaseSortingToParam (base :: [TyNamedParam (SortingOrderType *)])
:: [TyNamedParam *] where
BaseSortingToParam '[] = '[]
BaseSortingToParam ('TyNamedParam name (order field) ': xs) =
'TyNamedParam name field ': BaseSortingToParam xs
type family AllSortingParams
(provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)])
:: [TyNamedParam *] where
AllSortingParams provided base = provided ++ BaseSortingToParam base
type family SortingParamProvidedOf a :: [TyNamedParam *]
type family SortingParamBaseOf a :: [TyNamedParam (SortingOrderType *)]
type SortingParamsOf a = SortingParams (SortingParamProvidedOf a) (SortingParamBaseOf a)
type SortingSpecOf a = SortingSpec (SortingParamProvidedOf a) (SortingParamBaseOf a)
type instance SortingParamBaseOf NoContent = '[]
type instance SortingParamProvidedOf NoContent = '[]