document-build-0.2.0.0: test/Gens.hs

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

{- | Generators shared by the property tests.

The generator of each data type has the shape of its manifest, and is built
from its public interface: a product is its constructor applied to a
generator of each field, and a sum is one alternative for each constructor,
through its name.
-}
module Gens (
  genInt,
  genString,
  genPath,
  genWord,
  genTime,

  -- * Data types
  genCommandLine,
  genProcessFailed,
  genProcessOutputUnrecognised,
  genOutputFileMissing,
  genStringsMissing,
  genFileTypeUnsupported,
  genInputFilesTooFew,
  genOutputNotInDirectory,
  genBuildError,
  genStep,
  genTrail,
  genCycle,
  genImageInfo,
  genGitDetails,
  genOutputFile,
  genDirectories,
  genKnownFiles,
  genTarget,
  genContext,
) where

import Control.Lens (review)
import qualified Data.Map as Map
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Document.Build
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Prelude hiding (cycle)

genInt :: Gen Int
genInt =
  Gen.int (Range.linear (-100) 100)

genString :: Gen String
genString =
  Gen.string (Range.linear 0 30) Gen.unicode

-- | A file path, such as @src/a/report.fodt@.
genPath :: Gen FilePath
genPath =
  let part = Gen.string (Range.linear 1 6) Gen.alphaNum
   in (\ds f e -> concatMap (<> "/") ds <> f <> "." <> e)
        <$> Gen.list (Range.linear 0 3) part
        <*> part
        <*> Gen.element ["fodt", "md", "pdf", "png", "txt"]

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

genTime :: Gen UTCTime
genTime =
  posixSecondsToUTCTime . fromIntegral <$> Gen.int (Range.linear 0 2000000000)

genCommandLine :: Gen CommandLine
genCommandLine =
  CommandLine <$> genString <*> Gen.list (Range.linear 0 4) genString

genProcessFailed :: Gen ProcessFailed
genProcessFailed =
  ProcessFailed <$> genCommandLine <*> genString <*> genString

genProcessOutputUnrecognised :: Gen ProcessOutputUnrecognised
genProcessOutputUnrecognised =
  ProcessOutputUnrecognised <$> genCommandLine <*> genString

genOutputFileMissing :: Gen OutputFileMissing
genOutputFileMissing =
  OutputFileMissing <$> genCommandLine <*> genString

genStringsMissing :: Gen StringsMissing
genStringsMissing =
  StringsMissing <$> genString <*> Gen.nonEmpty (Range.linear 1 3) genString

genFileTypeUnsupported :: Gen FileTypeUnsupported
genFileTypeUnsupported =
  FileTypeUnsupported <$> genString <*> Gen.list (Range.linear 0 3) genString

genInputFilesTooFew :: Gen InputFilesTooFew
genInputFilesTooFew =
  InputFilesTooFew <$> genString <*> Gen.int (Range.linear 0 10) <*> Gen.int (Range.linear 0 10)

genOutputNotInDirectory :: Gen OutputNotInDirectory
genOutputNotInDirectory =
  OutputNotInDirectory <$> genString <*> genString

genBuildError :: Gen BuildError
genBuildError =
  Gen.choice
    [ review processFailed <$> genProcessFailed
    , review processOutputUnrecognised <$> genProcessOutputUnrecognised
    , review inputFileMissing <$> genString
    , review outputFileMissing <$> genOutputFileMissing
    , review stringsMissing <$> genStringsMissing
    , review fileTypeUnsupported <$> genFileTypeUnsupported
    , review fileNotInGit <$> genString
    , review fileNotUtf8 <$> genString
    , review cycle <$> genCycle
    , review inputFilesTooFew <$> genInputFilesTooFew
    , review outputNotInDirectory <$> genOutputNotInDirectory
    , review shallowRepository <$> genString
    ]

genStep :: Gen Step
genStep =
  Step <$> genWord <*> genPath

genTrail :: Gen Trail
genTrail =
  Trail <$> Gen.list (Range.linear 0 3) genStep

genCycle :: Gen Cycle
genCycle =
  Gen.choice
    [ review reproducesInput <$> (ReproducesInput <$> genPath <*> genStep <*> genTrail)
    , review repeatsStep <$> (RepeatsStep <$> genStep <*> genTrail)
    ]

genImageInfo :: Gen ImageInfo
genImageInfo =
  ImageInfo
    <$> Gen.element ["PNG", "JPEG", "GIF", "PDF"]
    <*> Gen.int (Range.linear 1 10000)
    <*> Gen.int (Range.linear 1 10000)
    <*> (fromIntegral <$> Gen.int (Range.linear 1 1200))
    <*> (fromIntegral <$> Gen.int (Range.linear 1 1200))
    <*> Gen.element ["Undefined", "PixelsPerInch", "PixelsPerCentimeter"]
    <*> Gen.element ["sRGB", "Gray", "CMYK"]
    <*> Gen.element [1, 8, 16]
    <*> Gen.int (Range.linear 1 100)

genGitDetails :: Gen GitDetails
genGitDetails =
  GitDetails
    <$> genWord
    <*> genWord
    <*> genWord
    <*> genWord
    <*> genTime
    <*> genWord
    <*> genWord
    <*> genTime
    <*> Gen.string (Range.linear 0 40) (Gen.filter (`notElem` ("\NUL\n" :: String)) Gen.unicode)
    <*> Gen.list (Range.linear 0 3) genWord

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

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 <*> genTrail)

genTarget :: Gen Target
genTarget =
  Gen.choice
    [ pure (review targetFile ())
    , pure (review targetDirectory ())
    , review targetComplete <$> genKnownFiles
    ]

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