{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Data.Finitary.Optics (reindexed, tighter)
import Data.Int (Int16, Int8)
import Data.Word (Word8)
import Hedgehog ((===), discard, forAll)
import Hedgehog.Gen (bool, choice, int8, word8)
import Hedgehog.Range (constantBounded)
import Optics.AffineFold (preview)
import Optics.Getter (view)
import Optics.Iso (Iso')
import Optics.Prism (Prism')
import Optics.Review (review)
import Test.Hspec (describe, hspec, it)
import Test.Hspec.Hedgehog (hedgehog)
main :: IO ()
main = hspec $ do
describe "tighter" $ do
it "should follow the review-preview law" . hedgehog $ do
x <- forAll . word8 $ constantBounded
let t :: Prism' Int16 Word8 = tighter
(preview t . review t $ x) === Just x
it "should follow the preview-review law" . hedgehog $ do
x <- forAll . choice $ [Left <$> bool, Right <$> int8 constantBounded]
let t :: Prism' (Either Bool Int8) Word8 = tighter
case preview t x of
Nothing -> discard
Just y -> review t y === x
it "should preserve ordering via review" . hedgehog $ do
x <- forAll . word8 $ constantBounded
y <- forAll . word8 $ constantBounded
let t :: Prism' Int16 Word8 = tighter
compare x y === compare (review t x) (review t y)
it "should preserve ordering via preview" . hedgehog $ do
x <- forAll . choice $ [Left <$> bool, Right <$> int8 constantBounded]
y <- forAll . choice $ [Left <$> bool, Right <$> int8 constantBounded]
let t :: Prism' (Either Bool Int8) Word8 = tighter
case (preview t x, preview t y) of
(Just x', Just y') -> compare x y === compare x' y'
_ -> discard
describe "reindexed" $ do
it "should follow the iso laws" . hedgehog $ do
x <- forAll . word8 $ constantBounded
let i :: Iso' Word8 Int8 = reindexed
(review i . view i $ x) === x
it "should preserve ordering" . hedgehog $ do
x <- forAll . word8 $ constantBounded
y <- forAll . word8 $ constantBounded
let i :: Iso' Word8 Int8 = reindexed
compare x y === compare (view i x) (view i y)