{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Test.Data.Measure (
  tests,
)
where

import GHC.Natural
import Test.Tasty
import Test.Tasty.QuickCheck

import qualified Data.Measure as M

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Data.Measure"
    [ TestName -> (Item -> [Item] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"uncurry (++) undoes splitAt" Item -> [Item] -> Property
prop_idAppendSplitAt
    , TestName -> (Item -> [Item] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"take and drop agrees with splitAt" Item -> [Item] -> Property
prop_eqTakeDropSplitAt
    ]

--------------------------------------------------------------------------------
-- A nice measure to run tests with
--------------------------------------------------------------------------------

newtype Item = Item Natural
  deriving (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
/= :: Item -> Item -> Bool
Eq, Eq Item
Item
Eq Item =>
Item
-> (Item -> Item -> Item)
-> (Item -> Item -> Item)
-> (Item -> Item -> Item)
-> Measure Item
Item -> Item -> Item
forall a.
Eq a =>
a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Measure a
$czero :: Item
zero :: Item
$cplus :: Item -> Item -> Item
plus :: Item -> Item -> Item
$cmin :: Item -> Item -> Item
min :: Item -> Item -> Item
$cmax :: Item -> Item -> Item
max :: Item -> Item -> Item
M.Measure, Int -> Item -> ShowS
[Item] -> ShowS
Item -> TestName
(Int -> Item -> ShowS)
-> (Item -> TestName) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Item -> ShowS
showsPrec :: Int -> Item -> ShowS
$cshow :: Item -> TestName
show :: Item -> TestName
$cshowList :: [Item] -> ShowS
showList :: [Item] -> ShowS
Show)

integerToItem :: Integer -> Item
integerToItem :: Integer -> Item
integerToItem = Natural -> Item
Item (Natural -> Item) -> (Integer -> Natural) -> Integer -> Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
naturalFromInteger (Integer -> Natural) -> (Integer -> Integer) -> Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
abs

itemToInteger :: Item -> Integer
itemToInteger :: Item -> Integer
itemToInteger (Item Natural
n) = Natural -> Integer
naturalToInteger Natural
n

instance Arbitrary Item where
  arbitrary :: Gen Item
arbitrary = (Small Integer -> Item) -> Gen (Small Integer) -> Gen Item
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Item
integerToItem (Integer -> Item)
-> (Small Integer -> Integer) -> Small Integer -> Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Small Integer -> Integer
forall a. Small a -> a
getSmall) Gen (Small Integer)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Item -> [Item]
shrink =
    (Small Integer -> Item) -> [Small Integer] -> [Item]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Item
integerToItem (Integer -> Item)
-> (Small Integer -> Integer) -> Small Integer -> Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Small Integer -> Integer
forall a. Small a -> a
getSmall)
      ([Small Integer] -> [Item])
-> (Item -> [Small Integer]) -> Item -> [Item]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Small Integer -> Bool) -> [Small Integer] -> [Small Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Small Integer -> Small Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Small Integer
0)
      ([Small Integer] -> [Small Integer])
-> (Item -> [Small Integer]) -> Item -> [Small Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Small Integer -> [Small Integer]
forall a. Arbitrary a => a -> [a]
shrink
      (Small Integer -> [Small Integer])
-> (Item -> Small Integer) -> Item -> [Small Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Small Integer
forall a. a -> Small a
Small
      (Integer -> Small Integer)
-> (Item -> Integer) -> Item -> Small Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item -> Integer
itemToInteger

--------------------------------------------------------------------------------
-- Required properties
--------------------------------------------------------------------------------

-- | @uncurry (++)@ undoes 'M.splitAt'
prop_idAppendSplitAt :: Item -> [Item] -> Property
prop_idAppendSplitAt :: Item -> [Item] -> Property
prop_idAppendSplitAt Item
limit [Item]
es =
  [Item]
l [Item] -> [Item] -> [Item]
forall a. [a] -> [a] -> [a]
++ [Item]
r [Item] -> [Item] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [Item]
es
  where
    ([Item]
l, [Item]
r) = (Item -> Item) -> Item -> [Item] -> ([Item], [Item])
forall a e. Measure a => (e -> a) -> a -> [e] -> ([e], [e])
M.splitAt Item -> Item
forall a. a -> a
id Item
limit [Item]
es

-- | 'M.take' and 'M.drop' are the components of 'M.splitAt'
prop_eqTakeDropSplitAt :: Item -> [Item] -> Property
prop_eqTakeDropSplitAt :: Item -> [Item] -> Property
prop_eqTakeDropSplitAt Item
limit [Item]
es =
  ((Item -> Item) -> Item -> [Item] -> [Item]
forall a e. Measure a => (e -> a) -> a -> [e] -> [e]
M.take Item -> Item
forall a. a -> a
id Item
limit [Item]
es, (Item -> Item) -> Item -> [Item] -> [Item]
forall a e. Measure a => (e -> a) -> a -> [e] -> [e]
M.drop Item -> Item
forall a. a -> a
id Item
limit [Item]
es)
    ([Item], [Item]) -> ([Item], [Item]) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Item -> Item) -> Item -> [Item] -> ([Item], [Item])
forall a e. Measure a => (e -> a) -> a -> [e] -> ([e], [e])
M.splitAt Item -> Item
forall a. a -> a
id Item
limit [Item]
es