{-# LANGUAGE LambdaCase #-}
module Test.Tasty.Sugar.Ranged
( rangedParam
, rangedParamAdjuster
)
where
import Control.Applicative ( liftA2 )
import Control.Monad.IO.Class ( MonadIO )
import Data.Function ( on )
import qualified Data.List as L
import Data.Maybe ( isNothing )
import qualified Data.Set as Set
import Test.Tasty.Sugar.Types
rangedParam :: Enum a => Ord a
=> String -> (String -> Maybe a) -> (a -> a -> Bool)
-> Maybe a
-> CUBE -> [Sweets] -> [Sweets]
rangedParam :: forall a.
(Enum a, Ord a) =>
String
-> (String -> Maybe a)
-> (a -> a -> Bool)
-> Maybe a
-> CUBE
-> [Sweets]
-> [Sweets]
rangedParam String
pname String -> Maybe a
extractVal a -> a -> Bool
cmpVal Maybe a
targetVal CUBE
cube [Sweets]
sweets =
let adj :: Sweets -> Sweets
adj Sweets
sweet = let exps :: [Expectation]
exps = Sweets -> [Expectation]
expected Sweets
sweet
in Sweets
sweet { expected :: [Expectation]
expected = [Expectation] -> [Expectation]
adjustExp [Expectation]
exps }
paramsExceptPName :: Expectation -> [(String, ParamMatch)]
paramsExceptPName = forall a. (a -> Bool) -> [a] -> [a]
filter ((String
pname forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> [(String, ParamMatch)]
expParamsMatch
assocUnionEq :: [(String, ParamMatch)] -> [(String, ParamMatch)] -> Bool
assocUnionEq = \case
[] -> forall a b. a -> b -> a
const Bool
True
((String
an,ParamMatch
av):[(String, ParamMatch)]
as) -> \case
[] -> Bool
True
[(String, ParamMatch)]
bs -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
an [(String, ParamMatch)]
bs of
Maybe ParamMatch
Nothing -> [(String, ParamMatch)] -> [(String, ParamMatch)] -> Bool
assocUnionEq [(String, ParamMatch)]
as [(String, ParamMatch)]
bs
Just ParamMatch
bv -> ParamMatch
av forall a. Eq a => a -> a -> Bool
== ParamMatch
bv Bool -> Bool -> Bool
&& [(String, ParamMatch)] -> [(String, ParamMatch)] -> Bool
assocUnionEq [(String, ParamMatch)]
as [(String, ParamMatch)]
bs
clusterBy :: (a -> a -> Bool) -> [a] -> [[a]]
clusterBy a -> a -> Bool
equiv = \case
[] -> []
(a
x:[a]
xs) -> let ([a]
same,[a]
diff) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (a -> a -> Bool
equiv a
x) [a]
xs
in (a
xforall a. a -> [a] -> [a]
:[a]
same) forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
clusterBy a -> a -> Bool
equiv [a]
diff
adjustExp :: [Expectation] -> [Expectation]
adjustExp :: [Expectation] -> [Expectation]
adjustExp [Expectation]
exps = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Expectation] -> [Expectation]
expInRange
forall a b. (a -> b) -> a -> b
$ forall {a}. (a -> a -> Bool) -> [a] -> [[a]]
clusterBy ([(String, ParamMatch)] -> [(String, ParamMatch)] -> Bool
assocUnionEq forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [(String, ParamMatch)]
paramsExceptPName) [Expectation]
exps
notRange :: Expectation -> Bool
notRange Expectation
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False
(forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
extractVal)
(ParamMatch -> Maybe String
getParamVal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pname (Expectation -> [(String, ParamMatch)]
expParamsMatch Expectation
e))
expInRange :: [Expectation] -> [Expectation]
expInRange :: [Expectation] -> [Expectation]
expInRange =
case Maybe a
targetVal of
Maybe a
Nothing ->
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pname (CUBE -> [ParameterPattern]
validParams CUBE
cube) of
Maybe (Maybe [String])
Nothing ->
forall a. a -> a
id
Just Maybe [String]
Nothing ->
forall a. a -> a
id
Just (Just [String]
vals) -> \[Expectation]
exps ->
let withPVal :: Maybe a -> [Expectation]
withPVal = \case
Maybe a
Nothing -> forall a. (a -> Bool) -> [a] -> [a]
filter Expectation -> Bool
notRange [Expectation]
exps
Just a
v -> a -> [Expectation] -> [Expectation]
expInRangeFor a
v [Expectation]
exps
vals' :: Set (Maybe a)
vals' = forall a. Ord a => [a] -> Set a
Set.fromList (String -> Maybe a
extractVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
vals)
vals'' :: Set (Maybe a)
vals'' = let vs :: Set (Maybe a)
vs = forall a. Maybe a
Nothing forall a. Ord a => a -> Set a -> Set a
`Set.delete` Set (Maybe a)
vals'
lower :: Maybe a
lower = forall a. Enum a => a -> a
pred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum Set (Maybe a)
vs
higher :: Maybe a
higher = forall a. Enum a => a -> a
succ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Set (Maybe a)
vs
in if forall a. Set a -> Bool
Set.null Set (Maybe a)
vs
then Set (Maybe a)
vs
else Maybe a
lower forall a. Ord a => a -> Set a -> Set a
`Set.insert` (Maybe a
higher forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set (Maybe a)
vs)
in forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => a -> Set a -> Set a
Set.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> [Expectation]
withPVal) forall a. Monoid a => a
mempty Set (Maybe a)
vals''
Just a
tv -> a -> [Expectation] -> [Expectation]
expInRangeFor a
tv
expInRangeFor :: a -> [Expectation] -> [Expectation]
expInRangeFor a
tgtVal [Expectation]
exps =
let explParam :: Expectation -> Bool
explParam Expectation
e = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pname forall a b. (a -> b) -> a -> b
$ Expectation -> [(String, ParamMatch)]
expParamsMatch Expectation
e of
Just (Explicit String
v) ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a -> a -> Bool
cmpVal a
tgtVal) forall a b. (a -> b) -> a -> b
$ String -> Maybe a
extractVal String
v
Maybe ParamMatch
_ -> Bool
False
okParam :: Expectation -> Bool
okParam Expectation
e = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pname forall a b. (a -> b) -> a -> b
$ Expectation -> [(String, ParamMatch)]
expParamsMatch Expectation
e of
Just (Assumed String
v) ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a -> a -> Bool
cmpVal a
tgtVal) forall a b. (a -> b) -> a -> b
$ String -> Maybe a
extractVal String
v
Maybe ParamMatch
_ -> Bool
False
pval :: Expectation -> Maybe a
pval Expectation
e = do ParamMatch
pm <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pname forall a b. (a -> b) -> a -> b
$ Expectation -> [(String, ParamMatch)]
expParamsMatch Expectation
e
String
pv <- ParamMatch -> Maybe String
getParamVal ParamMatch
pm
String -> Maybe a
extractVal String
pv
bestsBy :: (Expectation -> Maybe b)
-> (b -> b -> Bool) -> [Expectation] -> [Expectation]
bestsBy Expectation -> Maybe b
getVal b -> b -> Bool
testVal = \case
[] -> []
(Expectation
xp:[Expectation]
xps) ->
let chk :: Expectation -> [Expectation] -> [Expectation]
chk Expectation
e [Expectation]
bests =
let ev :: Maybe b
ev = Expectation -> Maybe b
getVal Expectation
e
ep :: [(String, ParamMatch)]
ep = Expectation -> [(String, ParamMatch)]
paramsExceptPName Expectation
e
matchE :: Expectation -> Bool
matchE = [(String, ParamMatch)] -> [(String, ParamMatch)] -> Bool
assocUnionEq [(String, ParamMatch)]
ep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> [(String, ParamMatch)]
paramsExceptPName
([Expectation]
yes,[Expectation]
oBest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Expectation -> Bool
matchE [Expectation]
bests
yv :: Maybe b
yv = Expectation -> Maybe b
getVal forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Expectation]
yes
in case () of
()
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expectation]
yes -> Expectation
eforall a. a -> [a] -> [a]
:[Expectation]
bests
()
_ | Maybe b
ev forall a. Eq a => a -> a -> Bool
== Maybe b
yv -> Expectation
eforall a. a -> [a] -> [a]
:[Expectation]
bests
()
_ -> case forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Bool
testVal Maybe b
yv Maybe b
ev of
Just Bool
True -> [Expectation]
bests
Just Bool
False -> Expectation
eforall a. a -> [a] -> [a]
:[Expectation]
oBest
Maybe Bool
Nothing -> Expectation
eforall a. a -> [a] -> [a]
:[Expectation]
oBest
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expectation -> [Expectation] -> [Expectation]
chk [Expectation
xp] [Expectation]
xps
exps' :: [Expectation]
exps' = let expl :: [Expectation]
expl = forall a. (a -> Bool) -> [a] -> [a]
L.filter Expectation -> Bool
explParam [Expectation]
exps
assum :: [Expectation]
assum = forall a. (a -> Bool) -> [a] -> [a]
L.filter Expectation -> Bool
okParam [Expectation]
exps
nonRanged :: [Expectation]
nonRanged = forall a. (a -> Bool) -> [a] -> [a]
L.filter Expectation -> Bool
notRange [Expectation]
exps
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expectation]
expl
then if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expectation]
assum
then [Expectation]
nonRanged
else [Expectation]
assum
else [Expectation]
expl
in forall {b}.
Eq b =>
(Expectation -> Maybe b)
-> (b -> b -> Bool) -> [Expectation] -> [Expectation]
bestsBy Expectation -> Maybe a
pval a -> a -> Bool
cmpVal forall a b. (a -> b) -> a -> b
$ [Expectation]
exps'
in Sweets -> Sweets
adj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Sweets]
sweets
rangedParamAdjuster :: Enum a => Ord a
=> MonadIO m
=> String -> (String -> Maybe a) -> (a -> a -> Bool)
-> Maybe a
-> CUBE -> [Sweets] -> m [Sweets]
rangedParamAdjuster :: forall a (m :: * -> *).
(Enum a, Ord a, MonadIO m) =>
String
-> (String -> Maybe a)
-> (a -> a -> Bool)
-> Maybe a
-> CUBE
-> [Sweets]
-> m [Sweets]
rangedParamAdjuster String
pname String -> Maybe a
extractVal a -> a -> Bool
cmpVal Maybe a
targetVal CUBE
cube =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Enum a, Ord a) =>
String
-> (String -> Maybe a)
-> (a -> a -> Bool)
-> Maybe a
-> CUBE
-> [Sweets]
-> [Sweets]
rangedParam String
pname String -> Maybe a
extractVal a -> a -> Bool
cmpVal Maybe a
targetVal CUBE
cube