document-build-0.2.0.0: test/OutputTests.hs

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

-- | Properties of the output tree, its JSON, and placeholders.
module OutputTests (
  outputTests,
) where

import Data.Aeson (fromJSON, toJSON)
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (parseEither)
import Data.Containers.ListUtils (nubOrd)
import Data.Foldable (toList)
import Data.List (sort)
import Data.Tree (Forest, Tree (..), flatten)
import Document.Build
import Gens (genGitDetails, genImageInfo, genOutputFile, genPath, genWord)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Laws (Laws)

genForest :: Gen (Forest OutputFile)
genForest =
  Gen.list (Range.linear 0 3) (Gen.recursive Gen.choice [Node <$> genOutputFile <*> pure []] [Node <$> genOutputFile <*> Gen.list (Range.linear 0 3) (Node <$> genOutputFile <*> pure [])])

{- | Edges between a small set of file paths, so that some outputs have more
than one input.
-}
genEdges :: Gen Edges
genEdges =
  let genFile = Gen.element (fmap (\n -> "public/f" <> show n <> ".pdf") [1 .. 12 :: Int])
   in Gen.list (Range.linear 0 10) ((,) <$> genFile <*> Gen.list (Range.linear 0 3) genFile)

outputTests :: Laws
outputTests =
  [ ("edgeForest has every file once", prop_everyFileOnce)
  , ("edgeForest puts an output under its first input", prop_firstInput)
  , ("OutputFile JSON round trip", prop_outputFileJson)
  , ("output forest JSON round trip", prop_forestJson)
  , ("GitDetails JSON round trip", prop_gitDetailsJson)
  , ("ImageInfo JSON round trip", prop_imageInfoJson)
  , ("withPlaceholder then placeholderValue gives the value", prop_withPlaceholder)
  , ("placeholderAliases gives the value of the other placeholder", prop_placeholderAliases)
  ]

genPlaceholders :: Gen Placeholders
genPlaceholders =
  Gen.list (Range.linear 0 5) ((,) <$> fmap (\n -> "${" <> n <> "}") genWord <*> genWord)

prop_withPlaceholder :: Property
prop_withPlaceholder =
  property $
    do
      ph <- forAll genPlaceholders
      n <- forAll genWord
      v <- forAll genWord
      placeholderValue (withPlaceholder n v ph) n === v

prop_placeholderAliases :: Property
prop_placeholderAliases =
  property $
    do
      ph <- forAll genPlaceholders
      n <- forAll genWord
      v <- forAll genWord
      placeholderValue (placeholderAliases [(n, v)] ph) n === placeholderValue ph v

prop_everyFileOnce :: Property
prop_everyFileOnce =
  property $
    do
      es <- forAll genEdges
      others <- forAll (Gen.list (Range.linear 0 3) genPath)
      let files = concatMap flatten (edgeForest es others)
          expected = sort (nubOrd (concatMap (uncurry (:)) es <> others))
      sort files === expected

prop_firstInput :: Property
prop_firstInput =
  property $
    do
      es <- forAll genEdges
      let forest = edgeForest es []
          parent o = lookup o (concatMap pairs forest)
          pairs (Node p cs) = fmap (\(Node c _) -> (c, p)) cs <> concatMap pairs cs
          firstInput o = lookup o [(x, i) | (i, os) <- es, x <- os, x /= i]
      for' (nubOrd (concatMap snd es)) $ \o ->
        case parent o of
          Nothing -> pure ()
          Just p -> Just p === firstInput o
 where
  for' xs f = mapM_ f xs

prop_outputFileJson :: Property
prop_outputFileJson =
  property $
    do
      o <- forAll genOutputFile
      fromJSON (toJSON o) === Aeson.Success o

prop_forestJson :: Property
prop_forestJson =
  property $
    do
      f <- forAll genForest
      parseEither outputForestFromJSON (outputForestToJSON f) === Right f
      length (concatMap toList f) === length (concatMap flatten f)

prop_gitDetailsJson :: Property
prop_gitDetailsJson =
  property $
    do
      g <- forAll genGitDetails
      fromJSON (toJSON g) === Aeson.Success g

prop_imageInfoJson :: Property
prop_imageInfoJson =
  property $
    do
      i <- forAll genImageInfo
      fromJSON (toJSON i) === Aeson.Success i