{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where

import Control.Applicative ((<$>), (<*>), liftA2)
import Data.Monoid ((<>), mempty)
import System.Exit (exitFailure, exitSuccess)

import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import           Network.StackExchange.Request
import           Test.QuickCheck
import           Test.QuickCheck.Function


instance Show (a → b) where
  show = const "<function>"


instance Eq (a → b) where
  (==) = const . const True


deriving instance Show (Request a i r)


deriving instance Eq (Request a i r)


instance Arbitrary Text where
  arbitrary = T.pack <$> arbitrary


instance (Ord k, Arbitrary k, Arbitrary v) ⇒ Arbitrary (Map k v) where
  arbitrary = M.fromList <$> arbitrary


instance Arbitrary (Request a i r) where
  arbitrary =
    Request <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> return Nothing


prop_right_id ∷ Request a i r → Bool
prop_right_id r = r <> mempty == r


prop_left_id ∷ Request a i r → Bool
prop_left_id r = mempty <> r == r


prop_associative ∷ Request a i r → Request a i r → Request a i r → Bool
prop_associative x y z = (x <> y) <> z == x <> (y <> z)


prop_idempotent ∷ Request a i r → Bool
prop_idempotent x = x <> x == x


prop_functor_id ∷ Request a i r → Bool
prop_functor_id x = fmap id x == x


prop_functor_composition ∷ Fun Char Int → Fun Int Char → Request a i Char → Bool
prop_functor_composition (Fun _ f) (Fun _ g) = liftA2 (==) (fmap (g . f)) (fmap g . fmap f)


main ∷ IO ()
main = (,,,,,) <$>
  (check prop_right_id) <*>
  (check prop_left_id) <*>
  (check prop_associative) <*>
  (check prop_idempotent) <*>
  (check prop_functor_id) <*>
  (check prop_functor_composition) >>= \case
  (True,True,True,True,True,True) → exitSuccess
  _                               → exitFailure
 where
  check p = success <$> quickCheckResult p

  success (Success {}) = True
  success _ = False