{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}


module Main where


import           Data.Kind
import           Data.Set                          as Set
import           GHC.Generics

import           Test.Hspec
import           Test.QuickCheck


import           Shpadoinkle.Widgets.Form.Dropdown
import           Shpadoinkle.Widgets.Types


data Foo = Bar | Baz | Qux | Nerp
  deriving (Eq, Ord, Show, Enum, Bounded, Generic)


instance Semigroup Foo where (<>) = min
instance Monoid Foo where mempty = maxBound


instance Arbitrary Foo where
  arbitrary = arbitraryBoundedEnum

instance (Ord a, Arbitrary a, Arbitrary (Selected p a)) => Arbitrary (Choice p a) where
  arbitrary = Choice <$> arbitrary <*> arbitrary

instance (Ord a, Arbitrary a, Arbitrary (Selected p a), Arbitrary (Considered p a)) => Arbitrary (ConsideredChoice p a) where
  arbitrary = ConsideredChoice <$> arbitrary <*> arbitrary

instance (Ord a, Arbitrary a, Arbitrary (ConsideredChoice p a)) => Arbitrary (Dropdown p a) where
  arbitrary = Dropdown <$> arbitrary <*> arbitrary

instance Arbitrary Toggle where
  arbitrary = arbitraryBoundedEnum


type TestConstrant f p =
  ( Arbitrary (f p Foo)
  , Selection f p
  , Show (f p Foo)
  , Eq (f p Foo)
  )


type TestConstrants f =
  ( TestConstrant f 'One
  , TestConstrant f 'AtleastOne
  , TestConstrant f 'Many
  )


selectionProps :: forall (f :: Pick -> Type -> Type). TestConstrants f => Spec
selectionProps = do

  describe "selected is an option" $ do

    it "One"        . property $ \(c :: f 'One Foo) ->
      toSet (selected c) `isSubsetOf` toSet c
    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) ->
      Set.singleton (selected c) `isSubsetOf` toSet c
    it "Many"       . property $ \(c :: f 'Many Foo) ->
      toSet (selected c) `isSubsetOf` toSet c


  describe "if we select something it's an option" $ do

    it "One'"        . property $ \(c :: f 'One Foo) x ->
      x `member` toSet (select' c x)
    it "AtleastOne'" . property $ \(c :: f 'AtleastOne Foo) x ->
      x `member` toSet (select' c x)
    it "Many'"       . property $ \(c :: f 'Many Foo) x ->
      x `member` toSet (select' c x)


  describe "selected and unselected are exclusive" $ do

    it "One"        . property $ \(c :: f 'One Foo) ->
      toSet (selected c) `disjoint` unselected c
    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) ->
      Set.singleton (selected c) `disjoint` unselected c
    it "Many"       . property $ \(c :: f 'Many Foo) ->
      toSet (selected c) `disjoint` unselected c


  describe "idempotence select" $ do

    it "One"        . property $ \(c :: f 'One Foo) x ->
      select' (select' c x) x == select' c x
    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) x ->
      select' (select' c x) x == select' c x
    it "Many"       . property $ \(c :: f 'Many Foo) x ->
      select' (select' c x) x == select' c x


  describe "select selected identity" $ do

    it "One"        . property $ \x ->
      selected (x `withOptions` Set.empty :: f 'One Foo) == x
    it "AtleastOne" . property $ \x ->
      selected (x `withOptions` Set.empty :: f 'AtleastOne Foo) == x
    it "Many"       . property $ \x ->
      selected (x `withOptions` Set.empty :: f 'Many Foo) == x


  describe "unselected withOptions identity" $ do

    it "One"        . property $ \x ->
      unselected (x `withOptions` Set.empty :: f 'One Foo) == mempty
    it "AtleastOne" . property $ \x ->
      unselected (x `withOptions` Set.empty :: f 'AtleastOne Foo) == mempty
    it "Many"       . property $ \x ->
      unselected (x `withOptions` Set.empty :: f 'Many Foo) == mempty


  describe "selected is not unselected" $ do

    it "One" . property $ \(c :: f 'One Foo) x ->
      not $ x `member` unselected (select' c x)
    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) x ->
      not $ x `member` unselected (select' c x)
    it "Many" . property $ \(c :: f 'Many Foo) x ->
      not $ x `member` unselected (select' c x)


deselectionPropsOne :: forall (f :: Pick -> Type -> Type). TestConstrants f => Deselection f 'One => Spec
deselectionPropsOne = describe "One" $ do

    it "idempotence deselect" . property $ \(c :: f 'One Foo) ->
        deselect (deselect c) == deselect c

    it "deselect select selected identity" . property $ \(c :: f 'One Foo) x ->
        selected (select (deselect c) x) == x

    it "selected deselect annihliation" . property $ \(c :: f 'One Foo) ->
        selected (deselect c) == mempty

    it "deselect keeps" . property $ \(c :: f 'One Foo) x ->
        toSet x `isSubsetOf` toSet (deselect (select c x))

    it "unselected passes through deselect keeps" . property $ \(c :: f 'One Foo) x ->
        toSet x `isSubsetOf` unselected (deselect (select c x))

    it "deselect unselected is full set" . property $ \(c :: f 'One Foo) ->
        unselected (deselect c) == toSet c


deselectionPropsMany :: forall (f :: Pick -> Type -> Type). TestConstrants f => Deselection f 'Many => Spec
deselectionPropsMany = describe "Many" $ do

    it "idempotence deselect" . property $ \(c :: f 'Many Foo) ->
        deselect (deselect c) == deselect c

    it "deselect select selected identity" . property $ \(c :: f 'Many Foo) x ->
        selected (select (deselect c) x) == x

    it "selected deselect annihliation" . property $ \(c :: f 'Many Foo) ->
        selected (deselect c) == mempty

    it "deselect keeps" . property $ \(c :: f 'Many Foo) x ->
        toSet x `isSubsetOf` toSet (deselect (select c x))

    it "unselected passes through deselect keeps" . property $ \(c :: f 'Many Foo) x ->
        toSet x `isSubsetOf` unselected (deselect (select c x))

    it "deselect unselected is full set" . property $ \(c :: f 'Many Foo) ->
        unselected (deselect c) == toSet c


main :: IO ()
main = hspec $ do
  it "foooid" . property $ \(x :: Foo) y z ->
    x <> mempty == x && x == mempty <> x && (x <> y) <> z == x <> (y <> z)

  describe "Choice" $ do
    selectionProps       @Choice
    deselectionPropsOne  @Choice
    deselectionPropsMany @Choice


  describe "ConsideredChoice" $ do
    selectionProps       @ConsideredChoice
    deselectionPropsOne  @ConsideredChoice
    deselectionPropsMany @ConsideredChoice


  describe "Dropdown" $ do
    selectionProps      @Dropdown
    deselectionPropsOne @Dropdown