module Servant.Util.Dummy.Sorting
( SortingSpecApp
, fieldSort
, sortBySpec
) where
import Universum
import Data.Typeable (cast)
import Servant.Util.Combinators.Sorting.Backend
import Servant.Util.Combinators.Sorting.Base
data DummySortingBackend
data SomeOrd = forall a. (Typeable a, Ord a) => SomeOrd a
instance Eq SomeOrd where
== :: SomeOrd -> SomeOrd -> Bool
(==) = (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) (Ordering -> Bool)
-> (SomeOrd -> SomeOrd -> Ordering) -> SomeOrd -> SomeOrd -> Bool
forall a b c. SuperComposition a b c => a -> b -> c
... SomeOrd -> SomeOrd -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord SomeOrd where
SomeOrd a
a compare :: SomeOrd -> SomeOrd -> Ordering
`compare` SomeOrd a
b =
let b' :: a
b' = a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
b Maybe a -> a -> a
forall a. Maybe a -> a -> a
?: Text -> a
forall a. HasCallStack => Text -> a
error Text
"Compared `SomeOrd`s are different inside"
in a
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
b'
instance SortingBackend DummySortingBackend where
type SortedValue DummySortingBackend a = a
type BackendOrdering DummySortingBackend = SomeOrd
type SortedValueConstraint DummySortingBackend a = (Typeable a, Ord a)
backendFieldSort :: SortedValue DummySortingBackend a
-> SortingApp DummySortingBackend ('TyNamedParam name a)
backendFieldSort SortedValue DummySortingBackend a
field = (SortingItemTagged ('TyNamedParam name a)
-> BackendOrdering DummySortingBackend)
-> SortingApp DummySortingBackend ('TyNamedParam name a)
forall backend (param :: TyNamedParam *).
(SortingItemTagged param -> BackendOrdering backend)
-> SortingApp backend param
SortingApp ((SortingItemTagged ('TyNamedParam name a)
-> BackendOrdering DummySortingBackend)
-> SortingApp DummySortingBackend ('TyNamedParam name a))
-> (SortingItemTagged ('TyNamedParam name a)
-> BackendOrdering DummySortingBackend)
-> SortingApp DummySortingBackend ('TyNamedParam name a)
forall a b. (a -> b) -> a -> b
$ \(SortingItemTagged (SortingItem Text
_name SortingOrder
order)) ->
case SortingOrder
order of
SortingOrder
Ascendant -> a -> SomeOrd
forall a. (Typeable a, Ord a) => a -> SomeOrd
SomeOrd a
SortedValue DummySortingBackend a
field
SortingOrder
Descendant -> Down a -> SomeOrd
forall a. (Typeable a, Ord a) => a -> SomeOrd
SomeOrd (a -> Down a
forall a. a -> Down a
Down a
SortedValue DummySortingBackend a
field)
sortBySpec
:: ( backend ~ DummySortingBackend
, allParams ~ AllSortingParams provided base
, ApplyToSortItem backend allParams
)
=> SortingSpec provided base
-> (a -> SortingSpecApp backend allParams)
-> [a] -> [a]
sortBySpec :: SortingSpec provided base
-> (a -> SortingSpecApp backend allParams) -> [a] -> [a]
sortBySpec SortingSpec provided base
spec a -> SortingSpecApp backend allParams
mkApp [a]
values =
((a, [SomeOrd]) -> a) -> [(a, [SomeOrd])] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (a, [SomeOrd]) -> a
forall a b. (a, b) -> a
fst ([(a, [SomeOrd])] -> [a])
-> ([(a, [SomeOrd])] -> [(a, [SomeOrd])])
-> [(a, [SomeOrd])]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [SomeOrd]) -> [SomeOrd])
-> [(a, [SomeOrd])] -> [(a, [SomeOrd])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (a, [SomeOrd]) -> [SomeOrd]
forall a b. (a, b) -> b
snd ([(a, [SomeOrd])] -> [a]) -> [(a, [SomeOrd])] -> [a]
forall a b. (a -> b) -> a -> b
$
(a -> (a, [SomeOrd])) -> [a] -> [(a, [SomeOrd])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (a -> a
forall a. a -> a
id (a -> a) -> (a -> [SomeOrd]) -> a -> (a, [SomeOrd])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SortingSpec provided base
-> SortingSpecApp backend allParams -> [BackendOrdering backend]
forall (provided :: [TyNamedParam *])
(base :: [TyNamedParam (SortingOrderType *)])
(allParams :: [TyNamedParam *]) backend.
(allParams ~ AllSortingParams provided base,
ApplyToSortItem backend allParams) =>
SortingSpec provided base
-> SortingSpecApp backend allParams -> [BackendOrdering backend]
backendApplySorting SortingSpec provided base
spec (SortingSpecApp backend allParams -> [SomeOrd])
-> (a -> SortingSpecApp backend allParams) -> a -> [SomeOrd]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SortingSpecApp backend allParams
mkApp) [a]
values