{-|

Copyright   : © 2020 Alex Washburn
License     : BSD-3-Clause
Maintainer  : github@recursion.ninja
Stability   : Stable

-}

{-# Language BangPatterns #-}
{-# Language DeriveAnyClass #-}
{-# Language DeriveGeneric #-}
{-# Language DerivingStrategies #-}
{-# Language FlexibleInstances #-}
{-# Language MultiParamTypeClasses #-}
{-# Language Safe #-}

module Operator.Binary.Comparison
    ( ComparisonOperator (getComparator)
    ) where

import Control.DeepSeq
import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Data.Monoid ()
import GHC.Generics
import Test.QuickCheck hiding (generate)
import Test.SmallCheck.Series


{-|
Representation of all possible binary operators of type @(Bool -> Bool -> Bool)@.
Useful for both property and enumeration based testing.
-}
newtype ComparisonOperator
    = CO { ComparisonOperator -> Bool -> Bool -> Ordering
getComparator :: Bool -> Bool -> Ordering }
    deriving anyclass (ComparisonOperator -> ()
(ComparisonOperator -> ()) -> NFData ComparisonOperator
forall a. (a -> ()) -> NFData a
$crnf :: ComparisonOperator -> ()
rnf :: ComparisonOperator -> ()
NFData)
    deriving stock ((forall x. ComparisonOperator -> Rep ComparisonOperator x)
-> (forall x. Rep ComparisonOperator x -> ComparisonOperator)
-> Generic ComparisonOperator
forall x. Rep ComparisonOperator x -> ComparisonOperator
forall x. ComparisonOperator -> Rep ComparisonOperator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComparisonOperator -> Rep ComparisonOperator x
from :: forall x. ComparisonOperator -> Rep ComparisonOperator x
$cto :: forall x. Rep ComparisonOperator x -> ComparisonOperator
to :: forall x. Rep ComparisonOperator x -> ComparisonOperator
Generic)


comparatorList :: [ComparisonOperator]
comparatorList :: [ComparisonOperator]
comparatorList = do
    Ordering
w <- [Ordering
forall a. Bounded a => a
minBound .. Ordering
forall a. Bounded a => a
maxBound]
    Ordering
x <- [Ordering
forall a. Bounded a => a
minBound .. Ordering
forall a. Bounded a => a
maxBound]
    Ordering
y <- [Ordering
forall a. Bounded a => a
minBound .. Ordering
forall a. Bounded a => a
maxBound]
    Ordering
z <- [Ordering
forall a. Bounded a => a
minBound .. Ordering
forall a. Bounded a => a
maxBound]
    ComparisonOperator -> [ComparisonOperator]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ComparisonOperator -> [ComparisonOperator])
-> ComparisonOperator -> [ComparisonOperator]
forall a b. (a -> b) -> a -> b
$ let
            op :: Bool -> Bool -> Ordering
op Bool
False Bool
False = Ordering
w
            op Bool
False Bool
True  = Ordering
x
            op Bool
True  Bool
False = Ordering
y
            op Bool
True  Bool
True  = Ordering
z
          in  (Bool -> Bool -> Ordering) -> ComparisonOperator
CO Bool -> Bool -> Ordering
op


instance Arbitrary ComparisonOperator where

    arbitrary :: Gen ComparisonOperator
arbitrary = Gen ComparisonOperator
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum


instance Bounded ComparisonOperator where

    minBound :: ComparisonOperator
minBound = [ComparisonOperator] -> ComparisonOperator
forall a. HasCallStack => [a] -> a
head [ComparisonOperator]
comparatorList

    maxBound :: ComparisonOperator
maxBound = [ComparisonOperator] -> ComparisonOperator
forall a. HasCallStack => [a] -> a
last [ComparisonOperator]
comparatorList


instance CoArbitrary ComparisonOperator where

    coarbitrary :: forall b. ComparisonOperator -> Gen b -> Gen b
coarbitrary = ComparisonOperator -> Gen b -> Gen b
forall a b. Enum a => a -> Gen b -> Gen b
coarbitraryEnum


instance Enum ComparisonOperator where

    toEnum :: Int -> ComparisonOperator
toEnum Int
n = let !i :: Int
i = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` [ComparisonOperator] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ComparisonOperator]
comparatorList in [ComparisonOperator]
comparatorList [ComparisonOperator] -> Int -> ComparisonOperator
forall a. HasCallStack => [a] -> Int -> a
!! Int
i

    fromEnum :: ComparisonOperator -> Int
fromEnum ComparisonOperator
c = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ComparisonOperator -> [ComparisonOperator] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ComparisonOperator
c [ComparisonOperator]
comparatorList


instance Eq ComparisonOperator where

    (CO Bool -> Bool -> Ordering
f) == :: ComparisonOperator -> ComparisonOperator -> Bool
== (CO Bool -> Bool -> Ordering
g) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ Bool -> Bool -> Ordering
f Bool
False Bool
False Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool -> Ordering
g Bool
False Bool
False
        , Bool -> Bool -> Ordering
f Bool
False Bool
True Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool -> Ordering
g Bool
False Bool
True
        , Bool -> Bool -> Ordering
f Bool
True Bool
False Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool -> Ordering
g Bool
True Bool
False
        , Bool -> Bool -> Ordering
f Bool
True Bool
True Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool -> Ordering
g Bool
True Bool
True
        ]


instance Monad m => Serial m ComparisonOperator where

    series :: Series m ComparisonOperator
series = (Int -> [ComparisonOperator]) -> Series m ComparisonOperator
forall a (m :: * -> *). (Int -> [a]) -> Series m a
generate ((Int -> [ComparisonOperator]) -> Series m ComparisonOperator)
-> (Int -> [ComparisonOperator]) -> Series m ComparisonOperator
forall a b. (a -> b) -> a -> b
$ [ComparisonOperator] -> Int -> [ComparisonOperator]
forall a b. a -> b -> a
const [ComparisonOperator]
comparatorList


instance Show ComparisonOperator where

    show :: ComparisonOperator -> String
show (CO Bool -> Bool -> Ordering
f) = [String] -> String
unlines
        [ String
""
        , String
"f / F F -> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ordering -> String
forall a. Show a => a -> String
show (Bool -> Bool -> Ordering
f Bool
False Bool
False)
        , String
"  | F T -> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ordering -> String
forall a. Show a => a -> String
show (Bool -> Bool -> Ordering
f Bool
False Bool
True)
        , String
"  | T F -> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ordering -> String
forall a. Show a => a -> String
show (Bool -> Bool -> Ordering
f Bool
True Bool
False)
        , String
"  \\ T T -> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ordering -> String
forall a. Show a => a -> String
show (Bool -> Bool -> Ordering
f Bool
True Bool
True)
        ]