algebraic-graph-duoids-0.0.1.0: tests/laws.hs

{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
-- TODO: Remove this once yaya-hedgehog has improved recursive generators.
{-# OPTIONS_GHC -fplugin-opt=NoRecursion:ignore-decls:genGraph #-}

-- |
-- Copyright: 2024 Greg Pfeil
-- License: AGPL-3.0-only WITH Universal-FOSS-exception-1.0 OR LicenseRef-commercial
module Main (main) where

import safe "algebraic-graph-duoids" Algebra.Graph.Duoid.Orphans ()
import "algebraic-graphs" Algebra.Graph
  ( Graph (Connect, Empty, Overlay, Vertex),
  )
import safe "base" Control.Applicative (pure, (<*>))
import safe "base" Control.Category ((.))
import safe "base" Data.Function (($))
import safe "base" Data.Functor (fmap, (<$>))
import safe "base" Data.Ord ((<=))
import safe "base" Data.Word (Word8)
import safe "base" System.IO (IO)
import safe "duoids-hedgehog" Test.Duoid qualified as Duoid
import "hedgehog" Hedgehog qualified
import "hedgehog" Hedgehog.Gen qualified as Gen
import safe "hedgehog" Hedgehog.Main qualified as Hedgehog
import "hedgehog" Hedgehog.Range qualified as Range

genGraph :: (Hedgehog.MonadGen m) => m a -> m (Graph a)
genGraph genA =
  Gen.recursive
    Gen.choice
    [ pure Empty,
      Vertex <$> genA
    ]
    [ Overlay <$> genGraph genA <*> genGraph genA,
      Connect <$> genGraph genA <*> genGraph genA
    ]

main :: IO ()
main =
  Hedgehog.defaultMain $
    fmap
      Hedgehog.checkParallel
      [ Duoid.validateNormal @(Graph Word8) (<=) . genGraph $
          Gen.word8 Range.linearBounded
      ]