module Clash.Tests.Driver.Manifest where import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LazyByteString import Data.Coerce (coerce) import Data.Text (Text) import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Test.Tasty import qualified Test.Tasty.QuickCheck as Q import qualified Test.QuickCheck.Utf8 as Q import Clash.Driver.Manifest import Clash.Explicit.Signal import Debug.Trace newtype ArbitraryText = ArbitraryText Text deriving (Show) newtype ArbitraryManifest = ArbitraryManifest Manifest deriving (Show) instance Q.Arbitrary ArbitraryText where arbitrary = coerce Q.genValidUtf8 shrink = coerce Q.shrinkValidUtf8 genDigest :: Q.Gen ByteString genDigest = Base16.encode . Text.encodeUtf8 . coerce @ArbitraryText <$> Q.arbitrary genString :: Q.Gen FilePath genString = Text.unpack . coerce @ArbitraryText <$> Q.arbitrary genDomain :: Q.Gen (Text, VDomainConfiguration) genDomain = do nm <- coerce @(Q.Gen ArbitraryText) Q.arbitrary dom <- VDomainConfiguration <$> pure (Text.unpack nm) <*> (fromIntegral @Int . abs <$> Q.arbitraryBoundedIntegral) <*> Q.elements [Rising, Falling] <*> Q.elements [Synchronous, Asynchronous] <*> Q.elements [Defined, Unknown] <*> Q.elements [ActiveHigh, ActiveLow] pure (nm, dom) genPort :: Q.Gen ManifestPort genPort = ManifestPort <$> coerce @(Q.Gen ArbitraryText) Q.arbitrary <*> coerce @(Q.Gen ArbitraryText) Q.arbitrary <*> (fromIntegral @Int . abs <$> Q.arbitraryBoundedIntegral) <*> Q.elements [False, True] <*> coerce @(Q.Gen (Maybe ArbitraryText)) Q.arbitrary genManifest :: Q.Gen Manifest genManifest = Manifest <$> Q.arbitrary -- hash <*> Q.arbitrary -- flags <*> Q.listOf genPort -- in ports <*> Q.listOf genPort -- out ports <*> coerce @(Q.Gen [ArbitraryText]) @(Q.Gen [Text]) Q.arbitrary -- comp names <*> coerce @(Q.Gen ArbitraryText) @(Q.Gen Text) Q.arbitrary -- top name <*> Q.listOf ((,) <$> genString <*> genDigest) -- files <*> (HashMap.fromList <$> Q.listOf genDomain) -- domains <*> coerce @(Q.Gen [ArbitraryText]) @(Q.Gen [Text]) Q.arbitrary -- dependencies tests :: TestTree tests = adjustOption (\_ -> Q.QuickCheckTests 100) $ testGroup "Clash.Tests.Driver.Manifest" [ Q.testProperty "decode . encode ~ id" $ do manifest <- genManifest let encoded = Aeson.encodePretty manifest decoded = Aeson.eitherDecode encoded if decoded == Right manifest then pure True else do !_ <- traceM "-------------------------" !_ <- traceM (show manifest) !_ <- traceM (Text.unpack (Text.decodeUtf8 (LazyByteString.toStrict encoded))) !_ <- traceM (show decoded) pure False ]