casa-reoc-0.1.0.0: test/PrimitiveGens.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}

-- | Generators of the primitive types and of the other types that the data types hold.
module PrimitiveGens (
  genText,
  genText1,
  genByteString,
  genFilePath,
  genABN,
  genARN,
  genEmailAddress,
  genPhoneNumber,
  genPostcode,
  genPositive,
  genPercentage,
  genMonth,
  genDay,
  genNatural,
  genFormText,
  genGrossWeight,
  genReviewMonths,
  genPassMark,
  genSome,
  genAtMost,
) where

import Control.Lens (preview)
import Data.ByteString (ByteString)
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.Calendar.Month (Month, fromYearMonthValid)
import GHC.TypeNats (KnownNat, natVal)
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Numeric.Natural (Natural)
import ReOC

genText :: Gen Text
genText =
  Gen.text (Range.linear 0 20) Gen.unicode

-- Characters that XML, markdown and the form treat specially, among ordinary ones.
special :: Gen Char
special =
  Gen.frequency [(6, Gen.alphaNum), (2, pure ' '), (3, Gen.element "&<>\"'*|#-.\\_`[]{}é–’")]

genText1 :: Gen Text1
genText1 =
  Gen.mapMaybe (preview _Text1) (Gen.choice [Gen.text (Range.linear 1 20) Gen.unicode, Gen.text (Range.linear 1 30) special])

-- | Bytes, such as the contents of an image.
genByteString :: Gen ByteString
genByteString =
  Gen.bytes (Range.linear 0 64)

-- | A file path.
genFilePath :: Gen FilePath
genFilePath =
  Gen.string (Range.linear 1 30) Gen.unicode

-- | Text that fits a box of the form.
genFormText :: forall f w l. (KnownFormFont f, KnownNat w, KnownNat l) => Gen (FormText f w l)
genFormText =
  let width = fromIntegral (natVal (Proxy :: Proxy w)) :: Int
      lines' = fromIntegral (natVal (Proxy :: Proxy l)) :: Int
      word = Gen.text (Range.linear 1 8) (Gen.frequency [(8, Gen.alphaNum), (2, Gen.element "&<>\"'*|#-.\\é–’")])
      separator = if lines' > 1 then Gen.frequency [(6, pure " "), (1, pure "\n")] else pure " "
      wordsUpTo = max 1 (width * lines' `div` 40)
      phrase = do
        ws <- Gen.list (Range.linear 1 wordsUpTo) word
        seps <- Gen.list (Range.singleton (length ws)) separator
        pure (Text.concat (zipWith (<>) ws (map Text.pack seps)))
   in Gen.mapMaybe (preview _FormText) (Text.strip <$> phrase)

genGrossWeight :: Gen GrossWeight
genGrossWeight =
  Gen.mapMaybe (preview _GrossWeight) (Gen.choice [Gen.integral (Range.linear 1 2000), Gen.integral (Range.linear 1 25000)])

genReviewMonths :: Gen ReviewMonths
genReviewMonths =
  Gen.mapMaybe (preview _ReviewMonths) (Gen.integral (Range.linear 1 12))

genPassMark :: Gen PassMark
genPassMark =
  Gen.mapMaybe (preview _PassMark) (Gen.integral (Range.linear 70 100))

-- | From 1 to n values, at most 3.
genSome :: forall n a. (KnownNat n) => Gen a -> Gen (Some n a)
genSome g =
  Gen.mapMaybe (preview _Some) (Gen.nonEmpty (Range.linear 1 (min 3 (fromIntegral (natVal (Proxy :: Proxy n))))) g)

-- | From 0 to n values, at most 3.
genAtMost :: forall n a. (KnownNat n) => Gen a -> Gen (AtMost n a)
genAtMost g =
  Gen.mapMaybe (preview _AtMost) (Gen.list (Range.linear 0 (min 3 (fromIntegral (natVal (Proxy :: Proxy n))))) g)

digits :: Int -> Gen String
digits n =
  Gen.list (Range.singleton n) Gen.digit

-- | An ABN: 9 digits, with the first check digits that make it valid.
genABN :: Gen ABN
genABN =
  Gen.just $
    (\rest -> listToMaybe (mapMaybe (\p -> preview _ABN (Text.pack (show p <> rest))) [10 .. 99 :: Int]))
      <$> digits 9

genARN :: Gen ARN
genARN =
  Gen.mapMaybe (preview _ARN . Text.pack) (Gen.list (Range.linear 1 10) Gen.digit)

genEmailAddress :: Gen EmailAddress
genEmailAddress =
  let part = Gen.string (Range.linear 1 8) Gen.alphaNum
   in Gen.mapMaybe
        (preview _EmailAddress . Text.pack)
        ((\l d t -> l <> "@" <> d <> "." <> t) <$> part <*> part <*> part)

genPhoneNumber :: Gen PhoneNumber
genPhoneNumber =
  Gen.mapMaybe
    (preview _PhoneNumber . Text.pack)
    (Gen.choice [("0" <>) <$> digits 9, ("13" <>) <$> digits 8, ("18" <>) <$> digits 8])

genPostcode :: Gen Postcode
genPostcode =
  Gen.mapMaybe (preview _Postcode . Text.pack) (digits 4)

genPositive :: Gen Positive
genPositive =
  Gen.mapMaybe (preview _Positive) (Gen.integral (Range.linear 1 1000))

genPercentage :: Gen Percentage
genPercentage =
  Gen.mapMaybe (preview _Percentage) (Gen.integral (Range.linear 0 100))

genMonth :: Gen Month
genMonth =
  Gen.just (fromYearMonthValid <$> Gen.integral (Range.linear 2000 2100) <*> Gen.int (Range.linear 1 12))

genDay :: Gen Day
genDay =
  fromGregorian <$> Gen.integral (Range.linear 2000 2100) <*> Gen.int (Range.linear 1 12) <*> Gen.int (Range.linear 1 31)

genNatural :: Gen Natural
genNatural =
  Gen.integral (Range.linear 0 100)