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

module Data.GenValidity.Scientific where

import Data.GenValidity
import Data.List
import Data.Scientific
import Data.Validity.Scientific ()

instance GenValid Scientific where
  genValid :: Gen Scientific
genValid = Integer -> Int -> Scientific
scientific (Integer -> Int -> Scientific)
-> Gen Integer -> Gen (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. GenValid a => Gen a
genValid Gen (Int -> Scientific) -> Gen Int -> Gen Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. GenValid a => Gen a
genValid
  shrinkValid :: Scientific -> [Scientific]
shrinkValid Scientific
s =
    (Scientific -> Bool) -> [Scientific] -> [Scientific]
forall a. (a -> Bool) -> [a] -> [a]
filter Scientific -> Bool
forall a. Validity a => a -> Bool
isValid ([Scientific] -> [Scientific]) -> [Scientific] -> [Scientific]
forall a b. (a -> b) -> a -> b
$
      [Scientific] -> [Scientific]
forall a. Eq a => [a] -> [a]
nub ([Scientific] -> [Scientific]) -> [Scientific] -> [Scientific]
forall a b. (a -> b) -> a -> b
$
        (Scientific -> Bool) -> [Scientific] -> [Scientific]
forall a. (a -> Bool) -> [a] -> [a]
filter (Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
/= Scientific
s) ([Scientific] -> [Scientific]) -> [Scientific] -> [Scientific]
forall a b. (a -> b) -> a -> b
$
          [ Integer -> Int -> Scientific
scientific Integer
c Int
e
            | (Integer
c, Int
e) <- (Integer, Int) -> [(Integer, Int)]
forall a. GenValid a => a -> [a]
shrinkValid (Scientific -> Integer
coefficient Scientific
s, Scientific -> Int
base10Exponent Scientific
s)
          ]