Manifest.hs

{-# LANGUAGE NamedFieldPuns  #-}

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 Data.Coerce (coerce)
import Data.Either (fromRight)
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

newtype ArbitraryText = ArbitraryText Text deriving (Show)

instance Q.Arbitrary ArbitraryText where
  arbitrary = coerce Q.genValidUtf8
  shrink = coerce Q.shrinkValidUtf8

newtype ArbitraryPortDirection = ArbitraryPortDirection PortDirection deriving (Show)

instance Q.Arbitrary ArbitraryPortDirection where
  arbitrary = ArbitraryPortDirection <$> Q.elements [In, Out, InOut]

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
    <*> coerce @(Q.Gen ArbitraryPortDirection) Q.arbitrary
    <*> (fromIntegral @Int . abs <$> Q.arbitraryBoundedIntegral)
    <*> Q.elements [False, True]
    <*> coerce @(Q.Gen (Maybe ArbitraryText)) Q.arbitrary

genManifest :: Q.Gen Manifest
genManifest =
  Manifest
    <$> genDigest -- hash
    <*> Q.arbitrary -- flags
    <*> Q.listOf genPort -- 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

        pure (decoded Q.=== Right manifest)
    , Q.testProperty "FilesManifest can decode encoded Manifest" $ do
        manifest@Manifest{fileNames} <- genManifest
        let
          encoded = Aeson.encodePretty manifest
          FilesManifest fileNamesDecoded =
            fromRight (error "Failed to decode manifest") (Aeson.eitherDecode encoded)

        pure (fileNamesDecoded Q.=== fileNames)
    ]