{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Manual construction of sorting spec.
module Servant.Util.Combinators.Sorting.Arbitrary () where

import Universum

import Test.QuickCheck (Arbitrary (..), elements, infiniteList, shuffle, sublistOf)

import Servant.Util.Combinators.Sorting.Base
import Servant.Util.Common


instance Arbitrary SortingOrder where
    arbitrary :: Gen SortingOrder
arbitrary = [SortingOrder] -> Gen SortingOrder
forall a. [a] -> Gen a
elements [SortingOrder
Ascendant, SortingOrder
Descendant]

instance (ReifySortingItems base, ReifyParamsNames provided) =>
         Arbitrary (SortingSpec provided base) where
    arbitrary :: Gen (SortingSpec provided base)
arbitrary = do
        let names :: [Element [Text]]
names = [Text] -> [Element [Text]]
forall t. Container t => t -> [Element t]
toList ([Text] -> [Element [Text]]) -> [Text] -> [Element [Text]]
forall a b. (a -> b) -> a -> b
$ ReifyParamsNames provided => [Text]
forall k (params :: [TyNamedParam k]).
ReifyParamsNames params =>
[Text]
reifyParamsNames @provided
        [Text]
someNames <- [Text] -> Gen [Text]
forall a. [a] -> Gen [a]
sublistOf ([Text] -> Gen [Text]) -> Gen [Text] -> Gen [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> Gen [Text]
forall a. [a] -> Gen [a]
shuffle [Text]
[Element [Text]]
names
        [SortingOrder]
orders <- Gen [SortingOrder]
forall a. Arbitrary a => Gen [a]
infiniteList
        let sortItems :: [SortingItem]
sortItems = (Text -> SortingOrder -> SortingItem)
-> [Text] -> [SortingOrder] -> [SortingItem]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> SortingOrder -> SortingItem
SortingItem [Text]
someNames [SortingOrder]
orders
        SortingSpec provided base -> Gen (SortingSpec provided base)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SortingItem] -> SortingSpec provided base
forall (provided :: [TyNamedParam *])
       (base :: [TyNamedParam (SortingOrderType *)]).
ReifySortingItems base =>
[SortingItem] -> SortingSpec provided base
SortingSpec [SortingItem]
sortItems)
    shrink :: SortingSpec provided base -> [SortingSpec provided base]
shrink SortingSpec{[SortingItem]
ssProvided :: forall (provided :: [TyNamedParam *])
       (base :: [TyNamedParam (SortingOrderType *)]).
SortingSpec provided base -> [SortingItem]
ssProvided :: [SortingItem]
..} = ([SortingItem] -> SortingSpec provided base)
-> [[SortingItem]] -> [SortingSpec provided base]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [SortingItem] -> SortingSpec provided base
forall (provided :: [TyNamedParam *])
       (base :: [TyNamedParam (SortingOrderType *)]).
ReifySortingItems base =>
[SortingItem] -> SortingSpec provided base
SortingSpec ([[SortingItem]] -> [SortingSpec provided base])
-> ([[SortingItem]] -> [[SortingItem]])
-> [[SortingItem]]
-> [SortingSpec provided base]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[SortingItem]] -> [[SortingItem]]
forall a. [a] -> [a]
reverse ([[SortingItem]] -> [SortingSpec provided base])
-> [[SortingItem]] -> [SortingSpec provided base]
forall a b. (a -> b) -> a -> b
$ [SortingItem] -> [[SortingItem]]
forall a. [a] -> [[a]]
inits [SortingItem]
ssProvided