{-# LANGUAGE CPP         #-}
#if __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe        #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy #-}
#endif
-- | Using 'RE' to generate example 'String's.
module RERE.Gen (generate) where

import Control.Applicative (liftA2)
import Data.Char           (ord)
import Data.Void           (Void, vacuous)
import Test.QuickCheck     (Gen, arbitrary, choose, frequency, oneof)

import RERE.CharSet
import RERE.Type
import RERE.Var

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif

-- $setup
-- >>> import Test.QuickCheck.Random (mkQCGen)
-- >>> import Test.QuickCheck.Gen (unGen)
-- >>> import RERE.Type
-- >>> let runGen seed = maybe "<<null>>" (\g' -> unGen g' (mkQCGen seed) 10)

-------------------------------------------------------------------------------
-- Generation
-------------------------------------------------------------------------------

-- | Generate strings.
--
-- >>> runGen 43 $ generate 10 10 $ star_ (ch_ 'a')
-- "aaaaaaaaaa"
--
-- >>> runGen 44 $ generate 10 10 $ star_ (ch_ 'a')
-- "aaa"
--
generate
    :: Int      -- ^ star upper size
    -> Int      -- ^ fix unroll
    -> RE Void
    -> Maybe (Gen String)
generate :: Int -> Int -> RE Void -> Maybe (Gen [Char])
generate Int
starSize Int
fixSize = (Gen ShowS -> Gen [Char])
-> Maybe (Gen ShowS) -> Maybe (Gen [Char])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ShowS -> [Char]) -> Gen ShowS -> Gen [Char]
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"")) (Maybe (Gen ShowS) -> Maybe (Gen [Char]))
-> (RE Void -> Maybe (Gen ShowS)) -> RE Void -> Maybe (Gen [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go (RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS))
-> (RE Void -> RE (Maybe (Gen ShowS)))
-> RE Void
-> Maybe (Gen ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Void -> RE (Maybe (Gen ShowS))
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous where
    go :: RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
    go :: RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
Null = Maybe (Gen ShowS)
forall a. Maybe a
Nothing
    go RE (Maybe (Gen ShowS))
Full = Gen ShowS -> Maybe (Gen ShowS)
forall a. a -> Maybe a
Just Gen ShowS
forall a. Arbitrary a => Gen a
arbitrary
    go RE (Maybe (Gen ShowS))
Eps  = Gen ShowS -> Maybe (Gen ShowS)
forall a. a -> Maybe a
Just (ShowS -> Gen ShowS
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ShowS
forall a. a -> a
id)
    go (Ch CharSet
c) = case CharSet -> [(Char, Char)]
toIntervalList CharSet
c of
        [] -> Maybe (Gen ShowS)
forall a. Maybe a
Nothing
        [(Char, Char)]
xs -> Gen ShowS -> Maybe (Gen ShowS)
forall a. a -> Maybe a
Just (Gen ShowS -> Maybe (Gen ShowS)) -> Gen ShowS -> Maybe (Gen ShowS)
forall a b. (a -> b) -> a -> b
$ [(Int, Gen ShowS)] -> Gen ShowS
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
            [ (Char -> Int
ord Char
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Char -> ShowS
showChar (Char -> ShowS) -> Gen Char -> Gen ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
lo,Char
hi))
            | (Char
lo,Char
hi) <- [(Char, Char)]
xs
            ]

    go (App RE (Maybe (Gen ShowS))
x RE (Maybe (Gen ShowS))
y) = do
        Gen ShowS
x' <- RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
x
        Gen ShowS
y' <- RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
y
        Gen ShowS -> Maybe (Gen ShowS)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ShowS -> ShowS -> ShowS) -> Gen ShowS -> Gen ShowS -> Gen ShowS
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Gen ShowS
x' Gen ShowS
y')
    go (Alt RE (Maybe (Gen ShowS))
x RE (Maybe (Gen ShowS))
y) = Maybe (Gen ShowS) -> Maybe (Gen ShowS) -> Maybe (Gen ShowS)
forall {a}. Maybe (Gen a) -> Maybe (Gen a) -> Maybe (Gen a)
alt (RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
x) (RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
y) where
        alt :: Maybe (Gen a) -> Maybe (Gen a) -> Maybe (Gen a)
alt (Just Gen a
x') (Just Gen a
y') = Gen a -> Maybe (Gen a)
forall a. a -> Maybe a
Just ([Gen a] -> Gen a
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen a
x', Gen a
y'])
        alt Maybe (Gen a)
x'        Maybe (Gen a)
Nothing   = Maybe (Gen a)
x'
        alt Maybe (Gen a)
Nothing   Maybe (Gen a)
y'        = Maybe (Gen a)
y'
    go (Star RE (Maybe (Gen ShowS))
x) = case RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
x of
        Maybe (Gen ShowS)
Nothing -> Gen ShowS -> Maybe (Gen ShowS)
forall a. a -> Maybe a
Just (ShowS -> Gen ShowS
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ShowS
forall a. a -> a
id)
        Just Gen ShowS
x' -> Gen ShowS -> Maybe (Gen ShowS)
forall a. a -> Maybe a
Just (Gen ShowS -> Maybe (Gen ShowS)) -> Gen ShowS -> Maybe (Gen ShowS)
forall a b. (a -> b) -> a -> b
$ do
            Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
starSize)
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
            then ShowS -> Gen ShowS
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ShowS
forall a. a -> a
id
            else (Int -> Gen ShowS -> Gen ShowS) -> Gen ShowS -> [Int] -> Gen ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
_ Gen ShowS
acc -> (ShowS -> ShowS -> ShowS) -> Gen ShowS -> Gen ShowS -> Gen ShowS
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Gen ShowS
acc Gen ShowS
x') Gen ShowS
x' [Int
2..Int
n]

#ifdef RERE_INTERSECTION
    -- this is tricky.
    go (And RE (Maybe (Gen ShowS))
_ RE (Maybe (Gen ShowS))
_) = Maybe (Gen ShowS)
forall a. Maybe a
Nothing
#endif

    go (Var Maybe (Gen ShowS)
x) = Maybe (Gen ShowS)
x
    go (Let Name
_ RE (Maybe (Gen ShowS))
r RE (Var (Maybe (Gen ShowS)))
s)  = RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go ((Var (Maybe (Gen ShowS)) -> Maybe (Gen ShowS))
-> RE (Var (Maybe (Gen ShowS))) -> RE (Maybe (Gen ShowS))
forall a b. (a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Gen ShowS)
-> (Maybe (Gen ShowS) -> Maybe (Gen ShowS))
-> Var (Maybe (Gen ShowS))
-> Maybe (Gen ShowS)
forall r a. r -> (a -> r) -> Var a -> r
unvar (RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
r) Maybe (Gen ShowS) -> Maybe (Gen ShowS)
forall a. a -> a
id) RE (Var (Maybe (Gen ShowS)))
s)
    go (Fix Name
_ RE (Var (Maybe (Gen ShowS)))
r) = Int -> Maybe (Gen ShowS)
go' Int
fixSize where
        go' :: Int -> Maybe (Gen ShowS)
        go' :: Int -> Maybe (Gen ShowS)
go' Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Maybe (Gen ShowS)
forall a. Maybe a
Nothing
              | Bool
otherwise = RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go ((Var (Maybe (Gen ShowS)) -> Maybe (Gen ShowS))
-> RE (Var (Maybe (Gen ShowS))) -> RE (Maybe (Gen ShowS))
forall a b. (a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Gen ShowS)
-> (Maybe (Gen ShowS) -> Maybe (Gen ShowS))
-> Var (Maybe (Gen ShowS))
-> Maybe (Gen ShowS)
forall r a. r -> (a -> r) -> Var a -> r
unvar (Int -> Maybe (Gen ShowS)
go' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Maybe (Gen ShowS) -> Maybe (Gen ShowS)
forall a. a -> a
id) RE (Var (Maybe (Gen ShowS)))
r)