{-# 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 = 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
    -- this is tricky.
    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)