module Main where

import Data.Decimal
import Data.Ratio
import Data.Word
import Test.HUnit

import Test.QuickCheck
import Test.Framework as TF (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 (testProperty)


-- | Newtype introduced to avoid orphan instance.
newtype TestDecRaw i = Test (DecimalRaw i) deriving Show

type TestDec = TestDecRaw Integer

instance (Integral i, Arbitrary i) => Arbitrary (TestDecRaw i) where
  arbitrary = Test <$> (Decimal <$> arbitrary <*> arbitrary)
  -- arbitrary = do
  --   e <- sized (\n -> resize (n `div` 10) arbitrary) :: Gen Int
  --   m <- sized (\n -> resize (n * 10) arbitrary)
  --   return $ Decimal (fromIntegral $ abs e) m

instance (Integral i, Arbitrary i) => CoArbitrary (TestDecRaw i) where
    coarbitrary (Test (Decimal e m)) = variant (v:: Integer)
       where v = fromIntegral e + fromIntegral m

-- | "read" is the inverse of "show".
--
-- > read (show n) == n
prop_readShow :: TestDec -> Bool
prop_readShow (Test d) =  read (show d) == d


-- | "read" can handle leading spaces.
prop_readShow1 :: TestDec -> Bool
prop_readShow1 (Test d) = read (" " ++ show d) == d

-- | Read and show preserve decimal places.
--
-- > decimalPlaces (read (show n)) == decimalPlaces n
prop_readShowPrecision :: TestDec -> Bool
prop_readShowPrecision (Test d) =  decimalPlaces (read (show d) :: Decimal)
                            == decimalPlaces d


-- | "fromInteger" definition.
--
-- > decimalPlaces (fromInteger n) == 0 &&
-- > decimalMantissa (fromInteger n) == n
prop_fromIntegerZero :: Integer -> Bool
prop_fromIntegerZero n =  decimalPlaces (fromInteger n :: Decimal) == 0 &&
                          decimalMantissa (fromInteger n :: Decimal) == n


-- | Increased precision does not affect equality.
--
-- > decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d
prop_increaseDecimals :: TestDec -> Property
prop_increaseDecimals (Test d) =
    decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d


-- | Decreased precision can make two decimals equal, but it can never change
-- their order.
--
-- > forAll d1, d2 :: Decimal -> legal beforeRound afterRound
-- >      where
-- >         beforeRound = compare d1 d2
-- >         afterRound = compare (roundTo 0 d1) (roundTo 0 d2)
-- >         legal GT x = x `elem` [GT, EQ]
-- >         legal EQ x = x `elem` [EQ]
-- >         legal LT x = x `elem` [LT, EQ]
prop_decreaseDecimals :: TestDec -> TestDec -> Bool
prop_decreaseDecimals (Test d1) (Test d2) =  legal beforeRound afterRound
    where
      beforeRound = compare d1 d2
      afterRound = compare (roundTo 0 d1) (roundTo 0 d2)
      legal GT x = x `elem` [GT, EQ]
      legal EQ x = x `elem` [EQ]
      legal LT x = x `elem` [LT, EQ]

-- | @roundTo == roundTo' round@
prop_roundTo :: TestDec -> Word8 -> Bool
prop_roundTo (Test d) e = roundTo' round e d == roundTo e d

-- | > (x + y) - y == x
prop_inverseAdd :: TestDec -> TestDec -> Bool
prop_inverseAdd (Test x) (Test y) =  (x + y) - y == x


-- | Multiplication is repeated addition.
--
-- > forall d, NonNegative i : (sum $ replicate i d) == d * fromIntegral (max i 0)
prop_repeatedAdd :: TestDec -> Word8 -> Bool
prop_repeatedAdd (Test d) i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0)


-- | Division produces the right number of parts.
--
-- > forall d, Positive i : (sum $ map fst $ divide d i) == i
prop_divisionParts :: TestDec -> Positive Int -> Property
prop_divisionParts (Test d) (Positive i) =  i > 0 ==> (sum $ map fst $ divide d i) == i


-- | Division doesn't drop any units.
--
-- > forall d, Positive i : (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d
prop_divisionUnits :: TestDec -> Positive Int -> Bool
prop_divisionUnits (Test d) (Positive i) =
    (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d


-- | Allocate produces the right number of parts.
--
-- > sum ps /= 0  ==>  length ps == length (allocate d ps)
prop_allocateParts :: TestDec -> [Integer] -> Property
prop_allocateParts (Test d) ps =
    sum ps /= 0 ==> length ps == length (allocate d ps)


-- | Allocate doesn't drop any units.
--
-- >     sum ps /= 0  ==>  sum (allocate d ps) == d
prop_allocateUnits :: TestDec -> [Integer] -> Property
prop_allocateUnits (Test d) ps =
    sum ps /= 0 ==> sum (allocate d ps) == d

-- | Absolute value definition
--
-- > decimalPlaces a == decimalPlaces d &&
-- > decimalMantissa a == abs (decimalMantissa d)
-- >    where a = abs d
prop_abs :: TestDec -> Bool
prop_abs (Test d) =  decimalPlaces a == decimalPlaces d &&
                     decimalMantissa a == abs (decimalMantissa d)
    where a = abs d

-- | Sign number definition
--
-- > signum d == (fromInteger $ signum $ decimalMantissa d)
prop_signum :: TestDec -> Bool
prop_signum (Test d) =  signum d == (fromInteger $ signum $ decimalMantissa d)

-- | The addition is valid

prop_sumValid :: TestDec -> TestDec -> Property
prop_sumValid (Test a) (Test b) = (decimalPlaces a < maxBound && decimalPlaces b < maxBound) ==>
                    (toRational (a + b) == (toRational a) + (toRational b))

prop_mulValid :: TestDec -> TestDec -> Property
prop_mulValid (Test a) (Test b) = ((ad + bd) < fromIntegral (maxBound :: Word8)) ==>
                    (toRational (a * b) == (toRational a) * (toRational b))
  where
    ad, bd :: Integer
    ad = fromIntegral $ decimalPlaces a
    bd = fromIntegral $ decimalPlaces b

prop_eitherFromRational :: TestDec -> Bool
prop_eitherFromRational (Test d) = (Right d) == (eitherFromRational $ toRational d)

prop_normalizeDecimal :: TestDec -> Bool
prop_normalizeDecimal (Test d) = d == (normalizeDecimal d)


-- | Division is the inverted multiplication
prop_divisionMultiplication :: TestDec -> TestDec -> Property
prop_divisionMultiplication (Test a) (Test b) =
      ((ad + bd) < fromIntegral (maxBound :: Word8) && a /= 0 && b /= 0) ==>
      (c / a == b) .&&. (c / b == a)
  where
    ad :: Integer
    ad = fromIntegral $ decimalPlaces a
    bd = fromIntegral $ decimalPlaces b
    c = a * b

prop_fromRational :: TestDec -> Bool
prop_fromRational (Test a) = a == (fromRational $ toRational a)

prop_properFraction :: TestDec -> Bool
prop_properFraction (Test a) = a == (fromIntegral b + d)
  where
    b :: Integer
    (b, d) = properFraction a

main :: IO ()
main = defaultMain tests


-- Monomorphic variations on polymorphic themes to avoid type default warnings.

dec :: Word8 -> Integer -> Decimal
dec = Decimal

dec1 :: Word8 -> Int -> DecimalRaw Int
dec1 = Decimal

piD :: Double
piD = pi

tests :: [TF.Test]
tests = [
        testGroup "QuickCheck Data.Decimal" [
                testProperty "readShow"           prop_readShow,
                testProperty "readShow1"          prop_readShow1,
                testProperty "readShowPrecision"  prop_readShowPrecision,
                testProperty "fromIntegerZero"    prop_fromIntegerZero,
                testProperty "increaseDecimals"   prop_increaseDecimals,
                testProperty "decreaseDecimals"   prop_decreaseDecimals,
                testProperty "roundTo"            prop_roundTo,
                testProperty "inverseAdd"         prop_inverseAdd,
                testProperty "repeatedAdd"        prop_repeatedAdd,
                testProperty "divisionParts"      prop_divisionParts,
                testProperty "divisionUnits"      prop_divisionUnits,
                testProperty "allocateParts"      prop_allocateParts,
                testProperty "allocateUnits"      prop_allocateUnits,
                testProperty "abs"                prop_abs,
                testProperty "signum"             prop_signum,
                testProperty "sumvalid"           prop_sumValid,
                testProperty "mulValid"           prop_mulValid,
                testProperty "eitherFromRational" prop_eitherFromRational,
                testProperty "normalizeDecimal"   prop_normalizeDecimal,
                testProperty "divisionMultiplication" prop_divisionMultiplication,
                testProperty "fromRational"       prop_fromRational,
                testProperty "properFraction"     prop_properFraction
                ],
        testGroup "Point tests Data.Decimal" [
                testCase "pi to 3dp"     (dec 3 3142  @=? realFracToDecimal 3 piD),
                testCase "pi to 2dp"     (dec 2 314   @=? realFracToDecimal 2 piD),
                testCase "100*pi to 2dp" (dec 2 31416 @=? realFracToDecimal 2 (100 * piD)),
                testCase "1.0 * pi"      (dec 1 31    @=? dec 1 10 *. piD),
                testCase "1.23 * pi"     (dec 2 386   @=? dec 2 123 *. piD),
                testCase "Decimal to DecimalRaw Int"
                                         (decimalConvert (dec 2 123) @=? Just (dec1 2 123)),
                testCase "decimalConvert overflow prevention"
                                         (decimalConvert (1/3 :: Decimal) @=?
                                            (Nothing :: Maybe (DecimalRaw Int))),
                testCase "1.234 to rational" (1234 % 1000 @=? toRational (dec 3 1234)),
                testCase "fromRational (1%10) for DecimalRaw Int"  -- Fixed bug #3
                                         (let v :: DecimalRaw Int
                                              v = fromRational (1%10)
                                          in toRational v @=? 1%10),
                testCase "Bankers rounding up"
                                         (roundTo 1 (dec 2 115) @=? dec 1 12),
                testCase "Bankers rounding down"
                                         (roundTo 1 (dec 2 125) @=? dec 1 12)
                ]
       ]