--LICENSE: BSD3 (or also similar, like GHC, etc.)
--INITIAL AUTHOR: Isaac Dupree <id@isaac.cedarswampstudios.org>
--see IntegerInTermsOfInt.hs - the main file currently


import IntegerInTermsOfInt as Haskell
import Prelude as GMP
import Prelude as P
import Test.QuickCheck
import Control.Monad
import System.Random
import System.IO.Unsafe
import System.Environment
import Data.Char
import Data.Bits
type HI = Haskell.Integer
type GI = GMP.Integer
type PI = P.Integer

newtype In = In Int deriving (Show)
instance Arbitrary In where
  arbitrary = rand >>= \gen1 -> return $ In $ fst (random gen1)
newtype SmIn = SmIn Int deriving (Show)
instance Arbitrary SmIn where
  arbitrary = rand >>= \gen1 -> return $ SmIn $ fst (randomR (-200,200) gen1)
--newtype SmNat = SmNat Int deriving (Show)
--instance Arbitrary SmNat where
--  arbitrary = rand >>= \gen1 -> return $ SmNat $ fst (randomR (0,200) gen1)
newtype I = I PI deriving (Show)
--instance Random I where
--  randomR (lo,hi) g =
instance Arbitrary I where
  arbitrary = rand >>= \gen1 -> return $ I $ let
   (n,gen2) = randomR (0,12::Int) gen1
   (s,gen3) = random gen2
   (c,gen4) = randomR (0,10::Int) gen3
   in (if s then id else negate) $ case c of
    0 -> 0 :: PI
    1 -> 0xfffffff + fst (randomR (-3,3::PI) gen4)
    2 -> 0x3fffffff + fst (randomR (-3,3::PI) gen4)
    x | x <= 6 -> let
                   (d, gen5) = random gen4
                   b = fst (randomR (0,40::Int) gen5)
                  in round (d * 2^b :: Double)
    _ -> sum $ zipWith (\p v -> v * (toInteger(maxBound::Int)+1)^p)
      [0::Int ..] $ map (toInteger) $ take n $ randomRs (0,maxBound::Int) gen4
  --loses some information: coarbitrary (I n) = variant (fromInteger
  --                                (if n >= 0 then 2*n else 2*(-n) + 1))
--Catch plus an Int implemented in terms of GI that checks for overflow
--might be a better way to test
--ghc -Wall helps too
--preconditions = assertions?

-- -W, -Wall: missing type signatures, unused variable that should have been...
--quickcheck: useless in just Int range
--quickcheck: multiplication completely broken; assertions found details
--quickcheck: add/sub sort of broken, very puzzling. Eventually inspired
--    to add assertion to mkInteger and with assert and trace tracked it down
--quickcheck: other things work!
--Squashed a nefarious destructive addition bug! Only found by the code
--copy with division and intSmallBase (though reducing the size of Int
--might have helped too)

--for distribution, something that will actually complete in a semi-reasonable
--amount of time in interpreters
defaultRepetitions = 1000
ck :: Testable a => a -> IO ()
ck = check (defaultConfig { configMaxTest = unsafePerformIO (
       flip fmap getArgs $ \args -> case args of
                              [n] | length n > 0 && all isDigit n -> read n
                              _ -> defaultRepetitions
    ) })

instance (Num a, Num b) => Num (a,b)
   where fromInteger i = (fromInteger i, fromInteger i)
division f a b = if b == 0 then 42 else f a b

--pr1 a b = ck (pr1' a b)
pr1s a b = ck (pr1' (\hr gr -> show hr == show gr) a b)
pr1i a b = ck (pr1' (\hr gr -> hr == fromIntegral gr) a b)
pr1' :: (hr -> gr -> Bool) -> (HI -> hr) -> (GI -> gr) -> I -> Bool
pr1' =
  \c opH opG (I i1)
        -> let
         hr = (opH (fromInteger i1 :: HI))
         gr = (opG (fromInteger i1 :: GI))
         in c hr gr
--pr2 a b = ck (pr2' a b)
pr2s a b = ck (pr2' (\hr gr -> show hr == show gr) a b)
pr2i a b = ck (pr2' (\hr gr -> hr == fromIntegral gr) a b)
pr2' :: (hr -> gr -> Bool) -> (HI -> HI -> hr) -> (GI -> GI -> gr)
                                                   -> I -> I -> Bool
pr2' =
  \c opH opG (I i1) (I i2)
        -> let
         hr = ((fromInteger i1 :: HI) `opH` (fromInteger i2 :: HI))
         gr = ((fromInteger i1 :: GI) `opG` (fromInteger i2 :: GI))
         in c hr gr

--HI validity assertions maybe?
main :: IO ()
main = do
  putStrLn ("usage: progname [repetitions]; default repetitions = "
             ++ show defaultRepetitions)
  -- toInteger/fromInteger(fromIntegral), Show
  -- (first because other tests may rely on it)
  putStrLn "fromInteger/toInteger"; pr1i (id) (id)
--
  putStrLn "fromInteger/show"; pr1s (id) (id)
  -- Eq
  putStrLn "=="; pr2s (==) (==)
  putStrLn "/="; pr2s (/=) (/=)
  -- Ord
  putStrLn ">"; pr2s (>) (>)
  putStrLn "<"; pr2s (<) (<)
  putStrLn ">="; pr2s (>=) (>=)
  putStrLn "<="; pr2s (<=) (<=)
  putStrLn "compare"; pr2s (compare) (compare)
  -- Num (skip fromInteger, which is used in pr)
  putStrLn "+"; pr2i (+) (+)
  putStrLn "-"; pr2i (-) (-)
  putStrLn "*"; pr2i (*) (*)
  putStrLn "signum"; pr1i (signum) (signum)
  putStrLn "negate"; pr1i (negate) (negate)
  putStrLn "abs"; pr1i (abs) (abs)
  -- unlimited precision = not Bounded
  -- Enum
  -- toEnum and fromEnum with Int are stupid,
  -- enumFrom... are likely to produce infinite
  -- or at least unusably long lists, so skip them
  -- for now
  putStrLn "succ"; pr1i (succ) (succ)
  putStrLn "pred"; pr1i (pred) (pred)
  -- ...but let's check them anyway...
  --fromEnum crashes with Hugs Integer (though not my Integer in hugs)
--  putStrLn "fromEnum"; pr1s (fromEnum) (fromEnum)
  putStrLn "fromEnum"; ck (\(In i) -> fromEnum (fromIntegral i :: HI)
                                   == fromEnum (fromIntegral i :: GI))
  putStrLn "toEnum"; ck (\(In i) -> show (toEnum i :: HI)
                                 == show (toEnum i :: GI))
  -- Real  (Rational=Ratio Prelude.Integer)
  putStrLn "toRational"; pr1s (toRational) (toRational)
  -- Integral  (hmm, Prelude.Integer)
  putStrLn "toInteger"; pr1s (toInteger) (toInteger)
  putStrLn "quot"; pr2i (division quot) (division quot)
  putStrLn "rem"; pr2i (division rem) (division rem)
  putStrLn "div"; pr2i (division div) (division div)
  putStrLn "mod"; pr2i (division mod) (division mod)
  putStrLn "quotRem"; pr2s (division quotRem) (division quotRem)
  putStrLn "divMod"; pr2s (division divMod) (division divMod)--}
-- nah, not as long as GHC has a Read Integer inconsistent with Haskell98
--  putStrLn "readsPrec"; ck (\p str ->
--                             show (readsPrec p str :: [(HI,String)])
--                          == show (readsPrec p str :: [(GI,String)]))
  --Ix testing??
  --Bits
  putStrLn "isSigned"; pr1s (isSigned) (isSigned) --LOL
  --bitSize is _|_
  putStrLn ".&."; pr2i (.&.) (.&.)
  putStrLn ".|."; pr2i (.|.) (.|.)
  putStrLn "xor"; pr2i (xor) (xor)
  putStrLn "complement"; pr1i (complement) (complement)
  --I'll let these do for {shift,rotate}{R,L} as well
  --(which is fallacious since one of those with argument 0
  -- won't be tested - whatever)
  putStrLn "shift"; ck (\i (SmIn b) -> (shift (fromInteger i :: HI) b)
                       == fromIntegral (shift (fromInteger i :: GI) b))
  putStrLn "rotate"; ck (\i (SmIn b) -> (rotate (fromInteger i :: HI) b)
                        == fromIntegral (rotate (fromInteger i :: GI) b))
  -- Random?
  -- <http://www.haskell.org/ghc/docs/
  --         latest/html/libraries/base/Prelude.html#t%3AInteger>
  -- other non-class like Integer->Int? this is fromEnum/toEnum,
  -- for the current stupid Enum class that uses Int...
--}

instance Arbitrary Char where
  arbitrary = oneof (map return "()-0123456789z")