{-# 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 String)
generate Int
starSize Int
fixSize = (Gen (String -> String) -> Gen String)
-> Maybe (Gen (String -> String)) -> Maybe (Gen String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String -> String) -> String)
-> Gen (String -> String) -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"")) (Maybe (Gen (String -> String)) -> Maybe (Gen String))
-> (RE Void -> Maybe (Gen (String -> String)))
-> RE Void
-> Maybe (Gen String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go (RE (Maybe (Gen (String -> String)))
 -> Maybe (Gen (String -> String)))
-> (RE Void -> RE (Maybe (Gen (String -> String))))
-> RE Void
-> Maybe (Gen (String -> String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Void -> RE (Maybe (Gen (String -> String)))
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous where
    go :: RE (Maybe (Gen ShowS)) -> Maybe (Gen ShowS)
    go :: RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go RE (Maybe (Gen (String -> String)))
Null = Maybe (Gen (String -> String))
forall a. Maybe a
Nothing
    go RE (Maybe (Gen (String -> String)))
Full = Gen (String -> String) -> Maybe (Gen (String -> String))
forall a. a -> Maybe a
Just Gen (String -> String)
forall a. Arbitrary a => Gen a
arbitrary
    go RE (Maybe (Gen (String -> String)))
Eps  = Gen (String -> String) -> Maybe (Gen (String -> String))
forall a. a -> Maybe a
Just ((String -> String) -> Gen (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String
forall a. a -> a
id)
    go (Ch CharSet
c) = case CharSet -> [(Char, Char)]
toIntervalList CharSet
c of
        [] -> Maybe (Gen (String -> String))
forall a. Maybe a
Nothing
        [(Char, Char)]
xs -> Gen (String -> String) -> Maybe (Gen (String -> String))
forall a. a -> Maybe a
Just (Gen (String -> String) -> Maybe (Gen (String -> String)))
-> Gen (String -> String) -> Maybe (Gen (String -> String))
forall a b. (a -> b) -> a -> b
$ [(Int, Gen (String -> String))] -> Gen (String -> String)
forall a. [(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 -> String -> String
showChar (Char -> String -> String) -> Gen Char -> Gen (String -> String)
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 (String -> String)))
x RE (Maybe (Gen (String -> String)))
y) = do
        Gen (String -> String)
x' <- RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go RE (Maybe (Gen (String -> String)))
x
        Gen (String -> String)
y' <- RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go RE (Maybe (Gen (String -> String)))
y
        Gen (String -> String) -> Maybe (Gen (String -> String))
forall (m :: * -> *) a. Monad m => a -> m a
return (((String -> String) -> (String -> String) -> String -> String)
-> Gen (String -> String)
-> Gen (String -> String)
-> Gen (String -> String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Gen (String -> String)
x' Gen (String -> String)
y')
    go (Alt RE (Maybe (Gen (String -> String)))
x RE (Maybe (Gen (String -> String)))
y) = Maybe (Gen (String -> String))
-> Maybe (Gen (String -> String)) -> Maybe (Gen (String -> String))
forall a. Maybe (Gen a) -> Maybe (Gen a) -> Maybe (Gen a)
alt (RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go RE (Maybe (Gen (String -> String)))
x) (RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go RE (Maybe (Gen (String -> String)))
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. [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 (String -> String)))
x) = case RE (Maybe (Gen (String -> String)))
-> Maybe (Gen (String -> String))
go RE (Maybe (Gen (String -> String)))
x of
        Maybe (Gen (String -> String))
Nothing -> Gen (String -> String) -> Maybe (Gen (String -> String))
forall a. a -> Maybe a
Just ((String -> String) -> Gen (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String
forall a. a -> a
id)
        Just Gen (String -> String)
x' -> Gen (String -> String) -> Maybe (Gen (String -> String))
forall a. a -> Maybe a
Just (Gen (String -> String) -> Maybe (Gen (String -> String)))
-> Gen (String -> String) -> Maybe (Gen (String -> String))
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 (String -> String) -> Gen (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String
forall a. a -> a
id
            else (Int -> Gen (String -> String) -> Gen (String -> String))
-> Gen (String -> String) -> [Int] -> Gen (String -> String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
_ Gen (String -> String)
acc -> ((String -> String) -> (String -> String) -> String -> String)
-> Gen (String -> String)
-> Gen (String -> String)
-> Gen (String -> String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Gen (String -> String)
acc Gen (String -> String)
x') Gen (String -> String)
x' [Int
2..Int
n]

#ifdef RERE_INTERSECTION
    -- this is tricky.
    go (And _ _) = Nothing
#endif

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