document-build-0.2.0.0: test/BuildTests.hs

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

{- | Properties of the pure parts of the document build commands: parsers,
string replacement, hashing, exit codes and the display of errors.
-}
module BuildTests (
  buildTests,
) where

import qualified Data.ByteString.Lazy.Char8 as Char8
import Data.Char (isHexDigit)
import Data.List (isPrefixOf, isSuffixOf, nub)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Document.Build
import Gens (genBuildError, genGitDetails, genImageInfo, genString, genWord)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Laws (Laws)

buildTests :: Laws
buildTests =
  [ ("parsePdfinfoPages finds the page count", prop_parsePdfinfoPages)
  , ("parseImageInfo round trip", prop_parseImageInfo)
  , ("parseGitLog round trip", prop_parseGitLog)
  , ("pageImagePaths has one path for each page", prop_pageImagePaths)
  , ("replaceText with no pairs is the identity", prop_replaceTextEmpty)
  , ("replaceText of a string with itself is the identity", prop_replaceTextSame)
  , ("replaceText of an absent string is the identity", prop_replaceTextAbsent)
  , ("sha256Hex is 64 hexadecimal digits", prop_sha256Hex)
  , ("xmlEscape leaves no markup", prop_xmlEscape)
  , ("shellQuote leaves no unquoted special characters", prop_shellQuote)
  , ("flatExtension and zippedExtension are inverse", prop_flatZipped)
  , ("buildErrorExitCode is distinct for each kind of error", prop_exitCodes)
  , ("displayBuildError ends with a newline", prop_display)
  ]

prop_parsePdfinfoPages :: Property
prop_parsePdfinfoPages =
  property $
    do
      n <- forAll (Gen.int (Range.linear 0 10000))
      before <- forAll (Gen.list (Range.linear 0 4) (("Title: " <>) <$> genWord))
      parsePdfinfoPages (unlines (before <> ["Pages:           " <> show n, "Encrypted:       no"])) === Just n

prop_parseImageInfo :: Property
prop_parseImageInfo =
  property $
    do
      i@(ImageInfo m w h x y u c z n) <- forAll genImageInfo
      parseImageInfo (unlines [m, show w, show h, show x, show y, u, c, show z, show n]) === Just i

prop_parseGitLog :: Property
prop_parseGitLog =
  property $
    do
      g@(GitDetails h h' an ae at cn ce ct subject as) <- forAll genGitDetails
      let seconds t = show (floor (utcTimeToPOSIXSeconds t) :: Integer)
      parseGitLog (concatMap (<> "\NUL") [h, h', an, ae, seconds at, cn, ce, seconds ct] <> subject <> "\n") as === Just g

prop_pageImagePaths :: Property
prop_pageImagePaths =
  property $
    do
      n <- forAll (Gen.int (Range.linear 1 50))
      length (pageImagePaths n "public/report.pdf.png") === n
      pageImagePaths n "public/report.pdf.gif" === ["public/report.pdf.gif"]

prop_replaceTextEmpty :: Property
prop_replaceTextEmpty =
  property $
    do
      t <- Text.pack <$> forAll genString
      replaceText [] t === t

prop_replaceTextSame :: Property
prop_replaceTextSame =
  property $
    do
      a <- Text.pack <$> forAll genWord
      t <- Text.pack <$> forAll genString
      replaceText [(a, a)] t === t

prop_replaceTextAbsent :: Property
prop_replaceTextAbsent =
  property $
    do
      t <- Text.pack <$> forAll (Gen.string (Range.linear 0 30) Gen.lower)
      b <- Text.pack <$> forAll genString
      replaceText [("0", b)] t === t

prop_sha256Hex :: Property
prop_sha256Hex =
  property $
    do
      s <- forAll genString
      let h = sha256Hex (Char8.pack s)
      length h === 64
      assert (all isHexDigit h)

prop_xmlEscape :: Property
prop_xmlEscape =
  property $
    do
      s <- forAll genString
      assert (all (`notElem` ("<>\"'" :: String)) (xmlEscape s))

prop_shellQuote :: Property
prop_shellQuote =
  property $
    do
      s <- forAll genString
      let q = shellQuote s
      assert (q == s || ("'" `isPrefixOf` q && "'" `isSuffixOf` q))

prop_flatZipped :: Property
prop_flatZipped =
  property $
    do
      e <- forAll (Gen.element ["odt", "ods", "odp", "odg"])
      (flatExtension e >>= zippedExtension) === Just e

prop_exitCodes :: Property
prop_exitCodes =
  withTests 1 . property $
    let errors =
          [ BuildErrorProcessOutputUnrecognised (ProcessOutputUnrecognised (CommandLine "" []) "")
          , InputFileMissing ""
          , BuildErrorOutputFileMissing (OutputFileMissing (CommandLine "" []) "")
          , BuildErrorStringsMissing (StringsMissing "" ("" NonEmpty.:| []))
          , BuildErrorFileTypeUnsupported (FileTypeUnsupported "" [])
          , FileNotInGit ""
          , FileNotUtf8 ""
          , BuildCycle (CycleRepeatsStep (RepeatsStep (Step "" "") (Trail [])))
          , BuildErrorInputFilesTooFew (InputFilesTooFew "" 0 0)
          , BuildErrorOutputNotInDirectory (OutputNotInDirectory "" "")
          , ShallowRepository ""
          ]
        codes = fmap buildErrorExitCode errors
     in length (nub codes) === length codes

prop_display :: Property
prop_display =
  property $
    do
      e <- forAll genBuildError
      let d = displayBuildError e
      assert ("\n" `isSuffixOf` d)