module OpcXmlDaClient.QuickCheckUtil.Gens where

import qualified Data.Text as Text
import qualified Data.Time.Calendar.OrdinalDate as Time
import qualified Data.Time.LocalTime as Time
import Test.QuickCheck
import Prelude hiding (choose, optional)

-- * General

maybeOf :: Gen a -> Gen (Maybe a)
maybeOf :: forall a. Gen a -> Gen (Maybe a)
maybeOf Gen a
gen =
  [Gen (Maybe a)] -> Gen (Maybe a)
forall a. [Gen a] -> Gen a
oneof [Maybe a -> Gen (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen]

onceIn :: Int -> Gen Bool
onceIn :: Int -> Gen Bool
onceIn Int
n =
  (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> Gen Int -> Gen Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
chooseInt (Int
1, Int
n)

-- * Time

year :: Gen Integer
year :: Gen Integer
year = (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (-Integer
9999, Integer
9999)

dayOfCommonYear :: Gen Int
dayOfCommonYear :: Gen Int
dayOfCommonYear = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
365)

dayOfLeapYear :: Gen Int
dayOfLeapYear :: Gen Int
dayOfLeapYear = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
366)

-- |
-- The arbitrary instance generates scarce values.
day :: Gen Day
day :: Gen Day
day = do
  Integer
_year <- Gen Integer
year
  Int
_dayOfYear <- if Integer -> Bool
Time.isLeapYear Integer
_year then Gen Int
dayOfLeapYear else Gen Int
dayOfCommonYear
  return $ Integer -> Int -> Day
Time.fromOrdinalDate Integer
_year Int
_dayOfYear

-- |
-- The arbitrary instance generates broken values.
-- This is an alternative to it.
timeZone :: Gen TimeZone
timeZone :: Gen TimeZone
timeZone =
  Int -> TimeZone
Time.hoursToTimeZone (Int -> TimeZone) -> Gen Int -> Gen TimeZone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (-Int
24, Int
24)

utcTimeInRange :: UTCTime -> UTCTime -> Gen UTCTime
utcTimeInRange :: UTCTime -> UTCTime -> Gen UTCTime
utcTimeInRange UTCTime
min UTCTime
max =
  SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime)
-> (Int64 -> SystemTime) -> Int64 -> UTCTime
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int64 -> Word32 -> SystemTime) -> Word32 -> Int64 -> SystemTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int64 -> Word32 -> SystemTime
MkSystemTime Word32
0 (Int64 -> UTCTime) -> Gen Int64 -> Gen UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64, Int64) -> Gen Int64
forall a. Random a => (a, a) -> Gen a
choose (Int64
minSec, Int64
maxSec)
  where
    MkSystemTime Int64
minSec Word32
_ = UTCTime -> SystemTime
utcToSystemTime UTCTime
min
    MkSystemTime Int64
maxSec Word32
_ = UTCTime -> SystemTime
utcToSystemTime UTCTime
max

recentTime :: Gen UTCTime
recentTime :: Gen UTCTime
recentTime =
  UTCTime -> UTCTime -> Gen UTCTime
utcTimeInRange (String -> UTCTime
forall a. Read a => String -> a
read String
"2020-01-01 00:00:00Z") (IO UTCTime -> UTCTime
forall a. IO a -> a
unsafePerformIO (IO UTCTime
getCurrentTime))

-- * Text

text :: Gen Text
text :: Gen Text
text =
  do
    Text
firstSentence <- Gen Text
sentence
    [Text]
otherSentences <- Gen Text -> Gen [Text]
forall a. Gen a -> Gen [a]
listOf (Gen Text -> Gen [Text]) -> Gen Text -> Gen [Text]
forall a b. (a -> b) -> a -> b
$ do
      Bool
doParagraph <- Int -> Gen Bool
onceIn Int
5
      let prefix :: Text
prefix = if Bool
doParagraph then Text
"\n" else Text
" "
      (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Gen Text -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
sentence
    return ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Text
firstSentence Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
otherSentences))

sentence :: Gen Text
sentence :: Gen Text
sentence =
  do
    Text
firstWord <- Text -> Text
Text.toTitle (Text -> Text) -> Gen Text -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
word
    Int
extraWordsAmount <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
20)
    [Text]
extraWords <- Int -> Gen Text -> Gen [Text]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
extraWordsAmount (Gen Text -> Gen [Text]) -> Gen Text -> Gen [Text]
forall a b. (a -> b) -> a -> b
$ do
      Text
prefix <- do
        Bool
prependPunctuation <- (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> Gen Int -> Gen Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
chooseInt (Int
0, Int
9)
        if Bool
prependPunctuation
          then [Text] -> Gen Text
forall a. [a] -> Gen a
elements [Text
", ", Text
": ", Text
" - "]
          else Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
" "
      Text
theWord <- do
        Bool
titleCase <- (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> Gen Int -> Gen Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
chooseInt (Int
0, Int
9)
        (if Bool
titleCase then Text -> Text
Text.toTitle else Text -> Text
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (Text -> Text) -> Gen Text -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
word
      return (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
theWord)
    return (Text
firstWord Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
extraWords)

word :: Gen Text
word :: Gen Text
word =
  [Text] -> Gen Text
forall a. [a] -> Gen a
elements
    [Text
"foo", Text
"bar", Text
"qux", Text
"quux", Text
"quuz", Text
"corge", Text
"grault", Text
"garply", Text
"waldo", Text
"fred", Text
"plugh", Text
"xyzzy", Text
"thud"]