document-build-0.2.0.0: test/OpticsTests.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

{- | The laws of the classy optics of every data type: the coverage of each
sum by its generator, the manifest of each data type, and the laws of the
kind of every instance of every name, including the identity instances of
names and the inherited instances.
-}
module OpticsTests (
  opticsTests,
) where

import Control.Lens (has)
import Document.Build
import Gens
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Laws
import Prelude hiding (cycle)

genStrings :: Gen [String]
genStrings =
  Gen.list (Range.linear 0 3) genString

genSteps :: Gen [Step]
genSteps =
  Gen.list (Range.linear 0 3) genStep

genReproducesInput :: Gen ReproducesInput
genReproducesInput =
  ReproducesInput <$> genPath <*> genStep <*> genTrail

genRepeatsStep :: Gen RepeatsStep
genRepeatsStep =
  RepeatsStep <$> genStep <*> genTrail

opticsTests :: Laws
opticsTests =
  [ ("cover BuildError", prop_coverBuildError)
  , ("cover Target", prop_coverTarget)
  , ("inherits", prop_inherits)
  ]
    -- Identity instances of names, for their target types
    <> identityLaws "commandLineProgram FilePath" commandLineProgram genString
    <> identityLaws "commandLineArguments [String]" commandLineArguments genStrings
    <> identityLaws "standardOutput String" standardOutput genString
    <> identityLaws "standardError String" standardError genString
    <> identityLaws "expectedOutput String" expectedOutput genString
    <> identityLaws "missingStrings (NonEmpty String)" missingStrings (Gen.nonEmpty (Range.linear 1 3) genString)
    <> identityLaws "supportedExtensions [String]" supportedExtensions genStrings
    <> identityLaws "directory FilePath" directory genPath
    <> identityLaws "inputFileCount Int" inputFileCount genInt
    <> identityLaws "inputFilesNeeded Int" inputFilesNeeded genInt
    <> identityLaws "inputFileMissing FilePath" inputFileMissing genPath
    <> identityLaws "fileNotInGit FilePath" fileNotInGit genPath
    <> identityLaws "fileNotUtf8 FilePath" fileNotUtf8 genPath
    <> identityLaws "shallowRepository FilePath" shallowRepository genPath
    <> identityLaws "outputDirectory FilePath" outputDirectory genPath
    <> identityLaws "inputDirectories [FilePath]" inputDirectories (Gen.list (Range.linear 0 3) genPath)
    <> identityLaws "fontsDirectory (Maybe FilePath)" fontsDirectory (Gen.maybe genPath)
    <> identityLaws "targetFile ()" targetFile (pure ())
    <> identityLaws "targetDirectory ()" targetDirectory (pure ())
    <> identityLaws "targetComplete KnownFiles" targetComplete genKnownFiles
    <> identityLaws "contextProject String" contextProject genWord
    <> identityLaws "gitCommitHash String" gitCommitHash genWord
    <> identityLaws "gitCommitHashShort String" gitCommitHashShort genWord
    <> identityLaws "gitAuthorName String" gitAuthorName genWord
    <> identityLaws "gitAuthorEmail String" gitAuthorEmail genWord
    <> identityLaws "gitAuthorTime UTCTime" gitAuthorTime genTime
    <> identityLaws "gitCommitterName String" gitCommitterName genWord
    <> identityLaws "gitCommitterEmail String" gitCommitterEmail genWord
    <> identityLaws "gitCommitTime UTCTime" gitCommitTime genTime
    <> identityLaws "gitSubject String" gitSubject genWord
    <> identityLaws "gitAuthors [String]" gitAuthors genStrings
    <> identityLaws "imageFormat String" imageFormat genWord
    <> identityLaws "imageWidth Int" imageWidth genInt
    <> identityLaws "imageHeight Int" imageHeight genInt
    <> identityLaws "imageResolutionX Double" imageResolutionX (fromIntegral <$> genInt)
    <> identityLaws "imageResolutionY Double" imageResolutionY (fromIntegral <$> genInt)
    <> identityLaws "imageResolutionUnits String" imageResolutionUnits genWord
    <> identityLaws "imageColourspace String" imageColourspace genWord
    <> identityLaws "imageDepth Int" imageDepth genInt
    <> identityLaws "imageFrames Int" imageFrames genInt
    <> identityLaws "outputPath FilePath" outputPath genPath
    <> identityLaws "outputSha256 String" outputSha256 genWord
    <> identityLaws "outputGitDetails (Maybe GitDetails)" outputGitDetails (Gen.maybe genGitDetails)
    <> identityLaws "outputPages (Maybe Int)" outputPages (Gen.maybe genInt)
    <> identityLaws "outputImageInfo (Maybe ImageInfo)" outputImageInfo (Gen.maybe genImageInfo)
    -- CommandLine
    <> manifestLaw "lawNamesCommandLine" lawNamesCommandLine genCommandLine
    <> identityLaws "commandLine CommandLine" commandLine genCommandLine
    <> lensLaws "commandLineProgram CommandLine" commandLineProgram genCommandLine genString
    <> lensLaws "commandLineArguments CommandLine" commandLineArguments genCommandLine genStrings
    -- ProcessFailed
    <> manifestLaw "lawNamesProcessFailed" lawNamesProcessFailed genProcessFailed
    <> identityLaws "processFailed ProcessFailed" processFailed genProcessFailed
    <> lensLaws "commandLine ProcessFailed" commandLine genProcessFailed genCommandLine
    <> lensLaws "standardOutput ProcessFailed" standardOutput genProcessFailed genString
    <> lensLaws "standardError ProcessFailed" standardError genProcessFailed genString
    <> lensLaws "commandLineProgram ProcessFailed" commandLineProgram genProcessFailed genString
    <> lensLaws "commandLineArguments ProcessFailed" commandLineArguments genProcessFailed genStrings
    -- ProcessOutputUnrecognised
    <> manifestLaw "lawNamesProcessOutputUnrecognised" lawNamesProcessOutputUnrecognised genProcessOutputUnrecognised
    <> identityLaws "processOutputUnrecognised ProcessOutputUnrecognised" processOutputUnrecognised genProcessOutputUnrecognised
    <> lensLaws "commandLine ProcessOutputUnrecognised" commandLine genProcessOutputUnrecognised genCommandLine
    <> lensLaws "expectedOutput ProcessOutputUnrecognised" expectedOutput genProcessOutputUnrecognised genString
    <> lensLaws "commandLineProgram ProcessOutputUnrecognised" commandLineProgram genProcessOutputUnrecognised genString
    <> lensLaws "commandLineArguments ProcessOutputUnrecognised" commandLineArguments genProcessOutputUnrecognised genStrings
    -- OutputFileMissing
    <> manifestLaw "lawNamesOutputFileMissing" lawNamesOutputFileMissing genOutputFileMissing
    <> identityLaws "outputFileMissing OutputFileMissing" outputFileMissing genOutputFileMissing
    <> lensLaws "commandLine OutputFileMissing" commandLine genOutputFileMissing genCommandLine
    <> lensLaws "file OutputFileMissing" file genOutputFileMissing genPath
    <> lensLaws "commandLineProgram OutputFileMissing" commandLineProgram genOutputFileMissing genString
    <> lensLaws "commandLineArguments OutputFileMissing" commandLineArguments genOutputFileMissing genStrings
    -- StringsMissing
    <> manifestLaw "lawNamesStringsMissing" lawNamesStringsMissing genStringsMissing
    <> identityLaws "stringsMissing StringsMissing" stringsMissing genStringsMissing
    <> lensLaws "file StringsMissing" file genStringsMissing genPath
    <> lensLaws "missingStrings StringsMissing" missingStrings genStringsMissing (Gen.nonEmpty (Range.linear 1 3) genString)
    -- FileTypeUnsupported
    <> manifestLaw "lawNamesFileTypeUnsupported" lawNamesFileTypeUnsupported genFileTypeUnsupported
    <> identityLaws "fileTypeUnsupported FileTypeUnsupported" fileTypeUnsupported genFileTypeUnsupported
    <> lensLaws "file FileTypeUnsupported" file genFileTypeUnsupported genPath
    <> lensLaws "supportedExtensions FileTypeUnsupported" supportedExtensions genFileTypeUnsupported genStrings
    -- InputFilesTooFew
    <> manifestLaw "lawNamesInputFilesTooFew" lawNamesInputFilesTooFew genInputFilesTooFew
    <> identityLaws "inputFilesTooFew InputFilesTooFew" inputFilesTooFew genInputFilesTooFew
    <> lensLaws "directory InputFilesTooFew" directory genInputFilesTooFew genPath
    <> lensLaws "inputFileCount InputFilesTooFew" inputFileCount genInputFilesTooFew genInt
    <> lensLaws "inputFilesNeeded InputFilesTooFew" inputFilesNeeded genInputFilesTooFew genInt
    -- OutputNotInDirectory
    <> manifestLaw "lawNamesOutputNotInDirectory" lawNamesOutputNotInDirectory genOutputNotInDirectory
    <> identityLaws "outputNotInDirectory OutputNotInDirectory" outputNotInDirectory genOutputNotInDirectory
    <> lensLaws "file OutputNotInDirectory" file genOutputNotInDirectory genPath
    <> lensLaws "outputDirectory OutputNotInDirectory" outputDirectory genOutputNotInDirectory genPath
    -- BuildError
    <> manifestLaw "lawNamesBuildError" lawNamesBuildError genBuildError
    <> identityLaws "buildError BuildError" buildError genBuildError
    <> prismLaws "processFailed BuildError" processFailed genBuildError genProcessFailed
    <> prismLaws "processOutputUnrecognised BuildError" processOutputUnrecognised genBuildError genProcessOutputUnrecognised
    <> prismLaws "inputFileMissing BuildError" inputFileMissing genBuildError genPath
    <> prismLaws "outputFileMissing BuildError" outputFileMissing genBuildError genOutputFileMissing
    <> prismLaws "stringsMissing BuildError" stringsMissing genBuildError genStringsMissing
    <> prismLaws "fileTypeUnsupported BuildError" fileTypeUnsupported genBuildError genFileTypeUnsupported
    <> prismLaws "fileNotInGit BuildError" fileNotInGit genBuildError genPath
    <> prismLaws "fileNotUtf8 BuildError" fileNotUtf8 genBuildError genPath
    <> prismLaws "cycle BuildError" cycle genBuildError genCycle
    <> prismLaws "inputFilesTooFew BuildError" inputFilesTooFew genBuildError genInputFilesTooFew
    <> prismLaws "outputNotInDirectory BuildError" outputNotInDirectory genBuildError genOutputNotInDirectory
    <> prismLaws "shallowRepository BuildError" shallowRepository genBuildError genPath
    <> prismLaws "reproducesInput BuildError" reproducesInput genBuildError genReproducesInput
    <> prismLaws "repeatsStep BuildError" repeatsStep genBuildError genRepeatsStep
    <> affineLaws "commandLine BuildError" commandLine genBuildError genCommandLine
    <> affineLaws "commandLineProgram BuildError" commandLineProgram genBuildError genString
    <> affineLaws "commandLineArguments BuildError" commandLineArguments genBuildError genStrings
    <> affineLaws "standardOutput BuildError" standardOutput genBuildError genString
    <> affineLaws "standardError BuildError" standardError genBuildError genString
    <> affineLaws "expectedOutput BuildError" expectedOutput genBuildError genString
    <> affineLaws "file BuildError" file genBuildError genPath
    <> affineLaws "missingStrings BuildError" missingStrings genBuildError (Gen.nonEmpty (Range.linear 1 3) genString)
    <> affineLaws "supportedExtensions BuildError" supportedExtensions genBuildError genStrings
    <> affineLaws "directory BuildError" directory genBuildError genPath
    <> affineLaws "inputFileCount BuildError" inputFileCount genBuildError genInt
    <> affineLaws "inputFilesNeeded BuildError" inputFilesNeeded genBuildError genInt
    <> affineLaws "outputDirectory BuildError" outputDirectory genBuildError genPath
    <> affineLaws "step BuildError" step genBuildError genStep
    <> affineLaws "trail BuildError" trail genBuildError genTrail
    <> affineLaws "stepName BuildError" stepName genBuildError genWord
    <> affineLaws "stepInput BuildError" stepInput genBuildError genPath
    <> affineLaws "steps BuildError" steps genBuildError genSteps
    -- Directories
    <> manifestLaw "lawNamesDirectories" lawNamesDirectories genDirectories
    <> identityLaws "directories Directories" directories genDirectories
    <> lensLaws "outputDirectory Directories" outputDirectory genDirectories genPath
    <> lensLaws "inputDirectories Directories" inputDirectories genDirectories (Gen.list (Range.linear 0 3) genPath)
    <> lensLaws "fontsDirectory Directories" fontsDirectory genDirectories (Gen.maybe genPath)
    -- Target
    <> manifestLaw "lawNamesTarget" lawNamesTarget genTarget
    <> identityLaws "target Target" target genTarget
    <> prismLaws "targetFile Target" targetFile genTarget (pure ())
    <> prismLaws "targetDirectory Target" targetDirectory genTarget (pure ())
    <> prismLaws "targetComplete Target" targetComplete genTarget genKnownFiles
    -- Context
    <> manifestLaw "lawNamesContext" lawNamesContext genContext
    <> identityLaws "context Context" context genContext
    <> lensLaws "directories Context" directories genContext genDirectories
    <> lensLaws "contextProject Context" contextProject genContext genWord
    <> lensLaws "target Context" target genContext genTarget
    <> lensLaws "outputDirectory Context" outputDirectory genContext genPath
    <> lensLaws "inputDirectories Context" inputDirectories genContext (Gen.list (Range.linear 0 3) genPath)
    <> lensLaws "fontsDirectory Context" fontsDirectory genContext (Gen.maybe genPath)
    <> affineLaws "targetFile Context" targetFile genContext (pure ())
    <> affineLaws "targetDirectory Context" targetDirectory genContext (pure ())
    <> affineLaws "targetComplete Context" targetComplete genContext genKnownFiles
    -- GitDetails
    <> manifestLaw "lawNamesGitDetails" lawNamesGitDetails genGitDetails
    <> identityLaws "gitDetails GitDetails" gitDetails genGitDetails
    <> lensLaws "gitCommitHash GitDetails" gitCommitHash genGitDetails genWord
    <> lensLaws "gitCommitHashShort GitDetails" gitCommitHashShort genGitDetails genWord
    <> lensLaws "gitAuthorName GitDetails" gitAuthorName genGitDetails genWord
    <> lensLaws "gitAuthorEmail GitDetails" gitAuthorEmail genGitDetails genWord
    <> lensLaws "gitAuthorTime GitDetails" gitAuthorTime genGitDetails genTime
    <> lensLaws "gitCommitterName GitDetails" gitCommitterName genGitDetails genWord
    <> lensLaws "gitCommitterEmail GitDetails" gitCommitterEmail genGitDetails genWord
    <> lensLaws "gitCommitTime GitDetails" gitCommitTime genGitDetails genTime
    <> lensLaws "gitSubject GitDetails" gitSubject genGitDetails genWord
    <> lensLaws "gitAuthors GitDetails" gitAuthors genGitDetails genStrings
    -- ImageInfo
    <> manifestLaw "lawNamesImageInfo" lawNamesImageInfo genImageInfo
    <> identityLaws "imageInfo ImageInfo" imageInfo genImageInfo
    <> lensLaws "imageFormat ImageInfo" imageFormat genImageInfo genWord
    <> lensLaws "imageWidth ImageInfo" imageWidth genImageInfo genInt
    <> lensLaws "imageHeight ImageInfo" imageHeight genImageInfo genInt
    <> lensLaws "imageResolutionX ImageInfo" imageResolutionX genImageInfo (fromIntegral <$> genInt)
    <> lensLaws "imageResolutionY ImageInfo" imageResolutionY genImageInfo (fromIntegral <$> genInt)
    <> lensLaws "imageResolutionUnits ImageInfo" imageResolutionUnits genImageInfo genWord
    <> lensLaws "imageColourspace ImageInfo" imageColourspace genImageInfo genWord
    <> lensLaws "imageDepth ImageInfo" imageDepth genImageInfo genInt
    <> lensLaws "imageFrames ImageInfo" imageFrames genImageInfo genInt
    -- OutputFile
    <> manifestLaw "lawNamesOutputFile" lawNamesOutputFile genOutputFile
    <> identityLaws "outputFile OutputFile" outputFile genOutputFile
    <> lensLaws "outputPath OutputFile" outputPath genOutputFile genPath
    <> lensLaws "outputSha256 OutputFile" outputSha256 genOutputFile genWord
    <> lensLaws "outputGitDetails OutputFile" outputGitDetails genOutputFile (Gen.maybe genGitDetails)
    <> lensLaws "outputPages OutputFile" outputPages genOutputFile (Gen.maybe genInt)
    <> lensLaws "outputImageInfo OutputFile" outputImageInfo genOutputFile (Gen.maybe genImageInfo)

prop_coverBuildError :: Property
prop_coverBuildError =
  withTests 500 . property $
    do
      x <- forAll genBuildError
      cover 5 "processFailed" (has processFailed x)
      cover 5 "processOutputUnrecognised" (has processOutputUnrecognised x)
      cover 5 "inputFileMissing" (has inputFileMissing x)
      cover 5 "outputFileMissing" (has outputFileMissing x)
      cover 5 "stringsMissing" (has stringsMissing x)
      cover 5 "fileTypeUnsupported" (has fileTypeUnsupported x)
      cover 5 "fileNotInGit" (has fileNotInGit x)
      cover 5 "fileNotUtf8" (has fileNotUtf8 x)
      cover 5 "cycle" (has cycle x)
      cover 5 "inputFilesTooFew" (has inputFilesTooFew x)
      cover 5 "outputNotInDirectory" (has outputNotInDirectory x)
      cover 5 "shallowRepository" (has shallowRepository x)

prop_coverTarget :: Property
prop_coverTarget =
  property $
    do
      x <- forAll genTarget
      cover 10 "targetFile" (has targetFile x)
      cover 10 "targetDirectory" (has targetDirectory x)
      cover 10 "targetComplete" (has targetComplete x)

-- | The checks of inheritance compile, so each is @()@.
prop_inherits :: Property
prop_inherits =
  withTests 1 . property $
    concat
      [ inheritsProcessFailed
      , inheritsProcessOutputUnrecognised
      , inheritsOutputFileMissing
      , inheritsBuildError
      , inheritsContext
      ]
      === replicate 13 ()