content: {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE UndecidableInstances  #-}
  
  module Scavenge.InputFilter where
  
  import Data.Word
  import QuickSpec
  import Test.QuickCheck
  import GHC.Generics
  
  
  class HasFilter i where
    data CustomFilter i  -- ! 1
    filterMatches :: CustomFilter i -> i -> Bool
  
  ------------------------------------------------------------------------------
  
  data InputFilter i
    = Always
    | Never
    | And (InputFilter i) (InputFilter i)
    | Or (InputFilter i) (InputFilter i)
    | Not (InputFilter i)
    | Custom (CustomFilter i)
    deriving stock (Generic)
  
  deriving stock instance (Eq (CustomFilter i)) => Eq (InputFilter i)
  deriving stock instance (Ord (CustomFilter i)) => Ord (InputFilter i)
  deriving stock instance (Show (CustomFilter i)) => Show (InputFilter i)
  
  -- # ArbitraryInputFilter
  instance Arbitrary (CustomFilter i) => Arbitrary (InputFilter i) where
    arbitrary = sized $ \n ->
      case n <= 1 of
        True -> elements [always, never]
        False -> frequency
          [ (3, pure always)
          , (3, pure never)
          , (5, andF <$> decayArbitrary 2
                     <*> decayArbitrary 2)
          , (5, orF <$> decayArbitrary 2
                    <*> decayArbitrary 2)
          , (4, notF <$> decayArbitrary 2)
          , (8, custom <$> arbitrary)
          ]
  
    shrink Always = []
    shrink Never = []
    shrink x = Always : Never : genericShrink x
  
  instance (Arbitrary i, HasFilter i)
        => Observe i Bool (InputFilter i) where
    observe = flip matches
  
  always :: InputFilter i
  always = Always
  
  never  :: InputFilter i
  never = Never
  
  andF :: InputFilter i -> InputFilter i -> InputFilter i
  andF = And
  
  orF  :: InputFilter i -> InputFilter i -> InputFilter i
  orF = Or
  
  notF :: InputFilter i -> InputFilter i
  notF = Not
  
  custom :: CustomFilter i -> InputFilter i
  custom = Custom
  
  ------------------------------------------------------------------------------
  
  matches :: HasFilter i => InputFilter i -> i -> Bool
  matches Always       _ = True
  matches Never        _ = False
  matches (And f1 f2)  i = matches f1 i && matches f2 i
  matches (Or f1 f2)   i = matches f1 i || matches f2 i
  matches (Not f)      i = not $ matches f i
  matches (Custom f) i = filterMatches f i
  
  ------------------------------------------------------------------------------
  
  decayArbitrary :: Arbitrary a => Int -> Gen a
  decayArbitrary n = scale (`div` n) arbitrary
  
  ------------------------------------------------------------------------------
  
  data Test
    = Number Word8
    deriving stock (Eq, Ord, Show, Generic)
  
  -- # ArbitraryTest
  instance Arbitrary Test where
    arbitrary = Number <$> arbitrary
  
    shrink = genericShrink
  
  -- # ArbitraryInputTest
  instance Arbitrary (CustomFilter Test) where
    arbitrary = Exactly <$> arbitrary
  
    shrink = genericShrink
  
  exactly :: Word8 -> InputFilter Test
  exactly = custom . Exactly
  
  -- # HasFilterTest
  instance HasFilter Test where
    data CustomFilter Test = Exactly Word8
      deriving stock (Eq, Ord, Show, Generic)
    filterMatches (Exactly n') (Number n) = n == n'
  
  ------------------------------------------------------------------------------
  
  sig_filters :: Sig
  sig_filters = signature
    [ sig_filter_cons
    , sig_filter_user_cons
    , sig_filter_types
    ]
  
  sig_filter_cons :: Sig
  sig_filter_cons = signature
    [ con "always" $ always @Test
    , con "never"  $ never  @Test
    , con "andF"   $ andF   @Test
    , con "orF"    $ orF    @Test
    , con "notF"   $ notF   @Test
    , con "matches" $ matches @Test
    , bools  -- ! 1
    ]
  
  sig_filter_user_cons :: Sig
  sig_filter_user_cons = signature
    [ con "exactly" exactly
    , con "Number" Number
    ]
  
  sig_filter_types :: Sig
  sig_filter_types = signature
    [ monoVars @(CustomFilter Test) ["f"]
    , monoVars @(Test) ["i"]
    , monoVars @Word8 ["n"]
    , monoObserve @(InputFilter Test)
    , variableUse Linear $ Proxy @(InputFilter Test)
    ]
  
  