{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE RankNTypes, FlexibleContexts #-}
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  test/Integral
-- Copyright   :  Copyright (c) 2010--2021 wren gayle romano
-- License     :  BSD2
-- Maintainer  :  wren@cpan.org
-- Stability   :  test framework
-- Portability :  FlexibleContexts + RankNTypes
--
-- Correctness testing for "Data.ByteString.Lex.Integral".
----------------------------------------------------------------
module Integral (main, tests) where

import qualified Test.Tasty                   as Tasty
import qualified Test.Tasty.SmallCheck        as SC
import qualified Test.Tasty.QuickCheck        as QC
import           Data.Int                     (Int32, Int64)
import           Control.Monad                ((<=<))
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Char8        as BS8
import           Data.ByteString.Lex.Integral

----------------------------------------------------------------
----------------------------------------------------------------
----- QuickCheck\/SmallCheck properties

-- | Converting a non-negative number to a string using 'show' and
-- then reading it back using 'readDecimal' returns the original
-- number.
prop_readDecimal_show :: (Show a, Integral a) => a -> Bool
prop_readDecimal_show x =
    let px = abs x
    in  Just (px, BS.empty) == (readDecimal . BS8.pack . show) px


-- | Converting a number to a string using 'show' and then reading
-- it back using @'readSigned' 'readDecimal'@ returns the original
-- number.
prop_readSignedDecimal_show :: (Show a, Integral a) => a -> Bool
prop_readSignedDecimal_show x =
    Just (x, BS.empty) == (readSigned readDecimal . BS8.pack . show) x


-- | Converting a non-negative number to a string using 'show' and
-- then reading it back using 'readDecimal_' returns the original
-- number.
prop_readDecimalzu_show :: (Show a, Integral a) => a -> Bool
prop_readDecimalzu_show x =
    let px = abs x
    in  px == (readDecimal_ . BS8.pack . show) px


-- | Converting a non-negative number to a bytestring using
-- 'packDecimal' and then reading it back using 'read' returns the
-- original number.
prop_read_packDecimal :: (Read a, Integral a) => a -> Bool
prop_read_packDecimal x =
    let px = abs x
    in  px == (read . maybe "" BS8.unpack . packDecimal) px


-- | Converting a non-negative number to a string using 'packDecimal'
-- and then reading it back using 'readDecimal' returns the original
-- number.
prop_readDecimal_packDecimal :: (Show a, Integral a) => a -> Bool
prop_readDecimal_packDecimal x =
    let px = abs x
    in  Just (px, BS.empty) == (readDecimal <=< packDecimal) px
-- TODO: how can we check the other composition with QC/SC?

----------------------------------------------------------------
-- | Converting a non-negative number to a string using 'packHexadecimal'
-- and then reading it back using 'readHexadecimal' returns the
-- original number.
prop_readHexadecimal_packHexadecimal :: (Show a, Integral a) => a -> Bool
prop_readHexadecimal_packHexadecimal x =
    let px = abs x
    in  Just (px, BS.empty) == (readHexadecimal <=< packHexadecimal) px

-- TODO: how can we check the other composition with QC/SC?

----------------------------------------------------------------
-- | Converting a non-negative number to a string using 'packOctal'
-- and then reading it back using 'readOctal' returns the original
-- number.
prop_readOctal_packOctal :: (Show a, Integral a) => a -> Bool
prop_readOctal_packOctal x =
    let px = abs x
    in  Just (px, BS.empty) == (readOctal <=< packOctal) px

-- TODO: how can we check the other composition with QC/SC?

----------------------------------------------------------------
{-
-- | A more obviously correct but much slower implementation than
-- the public one.
packDecimal :: (Integral a) => a -> Maybe ByteString
packDecimal = start
    where
    start n0
        | n0 < 0    = Nothing
        | otherwise = Just $ loop n0 BS.empty

    loop !n !xs
        | n <= 9    = BS.cons (0x30 + fromIntegral n) xs
        | otherwise =
            let (q,r) = n `quotRem` 10
            in loop q (BS.cons (0x30 + fromIntegral r) xs)
-}

----------------------------------------------------------------
----------------------------------------------------------------

atInt :: (Int -> a) -> Int -> a
atInt = id

atInt32 :: (Int32 -> a) -> Int32 -> a
atInt32 = id

atInt64 :: (Int64 -> a) -> Int64 -> a
atInt64 = id

atInteger :: (Integer -> a) -> Integer -> a
atInteger = id

-- | Test 'Integers' around the 'Int' boundary. This combinator is
-- for smallcheck.
intBoundary :: (Integer -> a) -> Integer -> a
intBoundary f x = f (x + fromIntegral (maxBound - 8 :: Int))


qc_testGroup
    :: QC.Testable b
    => String
    -> (forall a. (Integral a, Read a, Show a) => a -> b)
    -> Tasty.TestTree
qc_testGroup n f =
    Tasty.testGroup n
        [ QC.testProperty "Int"     $ atInt     f
        , QC.testProperty "Int32"   $ atInt32   f
        , QC.testProperty "Int64"   $ atInt64   f
        , QC.testProperty "Integer" $ atInteger f
        ]

sc_testGroup
    :: SC.Testable IO b
    => String
    -> (forall a. (Integral a, Read a, Show a) => a -> b)
    -> Tasty.TestTree
sc_testGroup n f =
    Tasty.testGroup n
        [ SC.testProperty "Int"         $ atInt       f
        , SC.testProperty "IntBoundary" $ intBoundary f
        ]

----------------------------------------------------------------
main :: IO ()
main = Tasty.defaultMain tests

tests :: Tasty.TestTree
tests = Tasty.testGroup "Integral Tests"
    [Tasty.testGroup "Properties"
        [ quickcheckTests
        , smallcheckTests
        ]
    -- TODO: add some HUnit tests
    ]

quickcheckTests :: Tasty.TestTree
quickcheckTests = Tasty.testGroup "(checked by QuickCheck)"
    [ qc_testGroup
        "prop_readDecimal_show"
         prop_readDecimal_show
    , qc_testGroup
        "prop_readDecimalzu_show"
         prop_readDecimalzu_show
    , qc_testGroup
        "prop_readSignedDecimal_show"
         prop_readSignedDecimal_show
    , qc_testGroup
        "prop_read_packDecimal"
         prop_read_packDecimal
    , qc_testGroup
        "prop_readDecimal_packDecimal"
         prop_readDecimal_packDecimal
    , qc_testGroup
        "prop_readHexadecimal_packHexadecimal"
         prop_readHexadecimal_packHexadecimal
    , qc_testGroup
        "prop_readOctal_packOctal"
         prop_readOctal_packOctal
    ]


-- TODO: how can we set our default 'SmallCheckDepth' to 2^8 while still allowing @--smallcheck-depth@ to override that default?
smallcheckTests :: Tasty.TestTree
smallcheckTests =
    Tasty.localOption (SC.SmallCheckDepth (2 ^ (8 :: Int))) $
    Tasty.testGroup "(checked by SmallCheck)"
    [ sc_testGroup
        "prop_readDecimal_show"
         prop_readDecimal_show
    , sc_testGroup
        "prop_readDecimalzu_show"
         prop_readDecimalzu_show
    , sc_testGroup
        "prop_readSignedDecimal_show"
         prop_readSignedDecimal_show
    , sc_testGroup
        "prop_read_packDecimal"
         prop_read_packDecimal
    , sc_testGroup
        "prop_readDecimal_packDecimal"
         prop_readDecimal_packDecimal
    , sc_testGroup
        "prop_readHexadecimal_packHexadecimal"
         prop_readHexadecimal_packHexadecimal
    , sc_testGroup
        "prop_readOctal_packOctal"
         prop_readOctal_packOctal
    ]

----------------------------------------------------------------
----------------------------------------------------------- fin.