document-build-0.1.0.0: test/OutputTests.hs

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

-- | Properties of the output tree, its JSON, the optics of the context, 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 qualified Data.Map as Map
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Tree (Forest, Tree (..), flatten)
import Document.Build
import Gens (genPath)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Laws (Laws, lensLaws, prismLaws)

genWord :: Gen String
genWord =
  Gen.string (Range.linear 1 12) Gen.alphaNum

genGitDetails :: Gen GitDetails
genGitDetails =
  let time = posixSecondsToUTCTime . fromIntegral <$> Gen.int (Range.linear 0 2000000000)
   in GitDetails <$> genWord <*> genWord <*> genWord <*> genWord <*> time <*> genWord <*> genWord <*> time <*> genWord <*> Gen.list (Range.linear 0 3) genWord

genImageInfo :: Gen ImageInfo
genImageInfo =
  ImageInfo
    <$> genWord
    <*> Gen.int (Range.linear 1 5000)
    <*> Gen.int (Range.linear 1 5000)
    <*> (fromIntegral <$> Gen.int (Range.linear 1 600))
    <*> (fromIntegral <$> Gen.int (Range.linear 1 600))
    <*> genWord
    <*> genWord
    <*> Gen.int (Range.linear 1 16)
    <*> Gen.int (Range.linear 1 10)

genOutputFile :: Gen OutputFile
genOutputFile =
  OutputFile <$> genPath <*> genWord <*> Gen.maybe genGitDetails <*> Gen.maybe (Gen.int (Range.linear 1 500)) <*> Gen.maybe genImageInfo

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 file = Gen.element (fmap (\n -> "public/f" <> show n <> ".pdf") [1 .. 12 :: Int])
   in Gen.list (Range.linear 0 10) ((,) <$> file <*> Gen.list (Range.linear 0 3) file)

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)
  ]
    <> concat
      [ lensLaws "outputDirectory" outputDirectory genDirectories genPath
      , lensLaws "inputDirectories" inputDirectories genDirectories (Gen.list (Range.linear 0 3) genPath)
      , lensLaws "fontsDirectory" fontsDirectory genDirectories (Gen.maybe genPath)
      , lensLaws "contextDirectories" contextDirectories genContext genDirectories
      , lensLaws "contextProject" contextProject genContext genWord
      , lensLaws "contextTarget" contextTarget genContext genTarget
      , prismLaws "_TargetFile" _TargetFile genTarget (pure ())
      , prismLaws "_TargetDirectory" _TargetDirectory genTarget (pure ())
      , prismLaws "_TargetComplete" _TargetComplete genTarget genKnownFiles
      ]

genDirectories :: Gen Directories
genDirectories =
  Directories <$> genPath <*> Gen.list (Range.linear 0 3) genPath <*> Gen.maybe genPath

genKnownFiles :: Gen KnownFiles
genKnownFiles =
  Map.fromList <$> Gen.list (Range.linear 0 3) ((,) <$> genPath <*> (Trail <$> Gen.list (Range.linear 0 3) (Step <$> genWord <*> genPath)))

genTarget :: Gen Target
genTarget =
  Gen.choice [pure TargetFile, pure TargetDirectory, TargetComplete <$> genKnownFiles]

genContext :: Gen Context
genContext =
  Context <$> genDirectories <*> genWord <*> genTarget

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