{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy #-}
#endif
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
generate
:: Int
-> Int
-> RE Void
-> Maybe (Gen String)
generate :: Int -> Int -> RE Void -> Maybe (Gen [Char])
generate Int
starSize Int
fixSize = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ [Char]
"")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Maybe a
Nothing
go RE (Maybe (Gen ShowS))
Full = forall a. a -> Maybe a
Just forall a. Arbitrary a => Gen a
arbitrary
go RE (Maybe (Gen ShowS))
Eps = forall a. a -> Maybe a
Just (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id)
go (Ch CharSet
c) = case CharSet -> [(Char, Char)]
toIntervalList CharSet
c of
[] -> forall a. Maybe a
Nothing
[(Char, Char)]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Char -> Int
ord Char
hi forall a. Num a => a -> a -> a
- Char -> Int
ord Char
lo forall a. Num a => a -> a -> a
+ Int
1, Char -> ShowS
showChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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) = 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') = forall a. a -> Maybe a
Just (forall a. [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 -> forall a. a -> Maybe a
Just (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id)
Just Gen ShowS
x' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Int
n <- forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
starSize)
if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id
else forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
_ Gen ShowS
acc -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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
go (And _ _) = 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar (RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go RE (Maybe (Gen ShowS))
r) 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Bool
otherwise = RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar (Int -> Maybe (Gen ShowS)
go' (Int
n forall a. Num a => a -> a -> a
- Int
1)) forall a. a -> a
id) RE (Var (Maybe (Gen ShowS)))
r)