Generator.hs

module Data.Schematic.Generator where

import           Data.Maybe
import           Data.Schematic.Generator.Regex
import {-# SOURCE #-} Data.Schematic.Schema
import           Data.Schematic.Verifier
import           Data.Scientific
import           Data.Text (Text, pack)
import qualified Data.Vector as V
import           Test.SmallCheck.Series

maxHigh :: Int
maxHigh = 30

minLow :: Int
minLow = 2

textLengthSeries :: Monad m => [VerifiedTextConstraint] -> Series m Text
textLengthSeries =
  \case
    [VTEq eq]        -> pure $ pack $ take (fromIntegral eq) $ cycle "sample"
    [VTBounds ml mh] -> do
      let
        l = fromMaybe minLow (fromIntegral <$> ml) + 1
        h = fromMaybe maxHigh (fromIntegral <$> mh) - 1
      n <- generate $ \depth -> take depth [l .. h]
      pure $ pack $ take (fromIntegral n) $ cycle "sample"
    _                -> pure "error"

textEnumSeries :: Monad m => [Text] -> Series m Text
textEnumSeries enum = generate $ \depth -> take depth enum

textSeries :: Monad m => [DemotedTextConstraint] -> Series m Text
textSeries cs = do
  let mvcs = verifyTextConstraints cs
  case mvcs of
    Just vcs -> do
      n <- textSeries' vcs
      pure n
    Nothing  -> pure "error"

textSeries' :: Monad m => [VerifiedTextConstraint] -> Series m Text
textSeries' [] = pure "sample"
textSeries' vcs = do
  let enums = listToMaybe [x | VTEnum x <- vcs]
  case enums of
    Just e -> textEnumSeries e
    Nothing -> do
      let regexps = listToMaybe [x | VTRegex x _ _ <- vcs]
      case regexps of
        Just e  -> regexSeries e
        Nothing -> textLengthSeries vcs

numberSeries :: Monad m => [DemotedNumberConstraint] -> Series m Scientific
numberSeries cs = do
  let mvcs = verifyNumberConstraints cs
  case mvcs of
    Just vcs -> do
      n <- numberSeries' vcs
      pure $ n
    Nothing -> pure 0

numberSeries' :: Monad m => VerifiedNumberConstraint -> Series m Scientific
numberSeries' =
  \case
    VNEq eq -> pure $ fromIntegral eq
    VNBounds ml mh -> do
      let l = fromMaybe minLow (fromIntegral <$> ml) + 1
          h = fromMaybe maxHigh (fromIntegral <$> mh) - 1
      n <- generate $ \depth -> take depth [l .. h]
      pure $ fromIntegral n

arraySeries
  :: (Monad m, Serial m (JsonRepr s))
  => [DemotedArrayConstraint]
  -> Series m (V.Vector (JsonRepr s))
arraySeries cs = do
  let mvcs = verifyArrayConstraint cs
  case mvcs of
    Just vcs -> arraySeries' vcs
    Nothing  -> pure V.empty

arraySeries'
  :: forall m s. (Monad m, Serial m (JsonRepr s))
  => Maybe VerifiedArrayConstraint
  -> Series m (V.Vector (JsonRepr s))
arraySeries' ml = do
  objs <- V.replicateM (maybe minRepeat f ml) (series :: Series m (JsonRepr s))
  pure $ objs
  where
    f (VAEq l) = fromIntegral l