{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
module Text.StringRandom
( stringRandomIO
, stringRandom
, stringRandomWithError
) where
import qualified Data.IntMap.Strict as Map
import qualified Data.Text as Text
import qualified System.Random as Random
import qualified Text.StringRandom.Parser as Parser
import qualified Control.Monad.Trans.RWS.Strict as RWS
type GenRWS g = RWS.RWS Int () (g, Map.IntMap Text.Text)
stringRandomIO :: Text.Text -> IO Text.Text
stringRandomIO :: Text -> IO Text
stringRandomIO Text
txt = do
StdGen
g <- forall (m :: * -> *). MonadIO m => m StdGen
Random.newStdGen
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall g. RandomGen g => g -> Text -> Text
stringRandom StdGen
g Text
txt
stringRandom :: Random.RandomGen g => g -> Text.Text -> Text.Text
stringRandom :: forall g. RandomGen g => g -> Text -> Text
stringRandom g
g Text
txt = case forall g. RandomGen g => g -> Text -> Either String Text
stringRandomWithError g
g Text
txt of
Left String
l -> forall a. HasCallStack => String -> a
error String
l
Right Text
r -> Text
r
stringRandomWithError :: Random.RandomGen g => g -> Text.Text -> Either String Text.Text
stringRandomWithError :: forall g. RandomGen g => g -> Text -> Either String Text
stringRandomWithError g
g Text
txt = do
Parsed
parsed <- Text -> Either String Parsed
Parser.processParse Text
txt
let (Text
ret, ()
_) = forall r w s a. RWS r w s a -> r -> s -> (a, w)
RWS.evalRWS (forall g. RandomGen g => Parsed -> GenRWS g Text
str Parsed
parsed) Int
10 (g
g, forall a. IntMap a
Map.empty)
forall (m :: * -> *) a. Monad m => a -> m a
return Text
ret
withGen :: Random.RandomGen g => (g -> (a, g)) -> GenRWS g a
withGen :: forall g a. RandomGen g => (g -> (a, g)) -> GenRWS g a
withGen g -> (a, g)
f = do
(g
gen, IntMap Text
m) <- forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
RWS.get
let (a
a, g
gen') = g -> (a, g)
f g
gen
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWS.put (g
gen', IntMap Text
m)
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
randomRM :: (Random.RandomGen g, Random.Random a) => (a, a) -> GenRWS g a
randomRM :: forall g a. (RandomGen g, Random a) => (a, a) -> GenRWS g a
randomRM = forall g a. RandomGen g => (g -> (a, g)) -> GenRWS g a
withGen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR
choice :: Random.RandomGen g => [a] -> GenRWS g a
choice :: forall g a. RandomGen g => [a] -> GenRWS g a
choice [a]
xs = do
Int
i <- forall g a. (RandomGen g, Random a) => (a, a) -> GenRWS g a
randomRM (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
- Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
xs forall a. [a] -> Int -> a
!! Int
i
putGroup :: Int -> Text.Text -> GenRWS g ()
putGroup :: forall g. Int -> Text -> GenRWS g ()
putGroup Int
n Text
v = do
(g
gen, IntMap Text
m) <- forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
RWS.get
let m' :: IntMap Text
m' = forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
n Text
v IntMap Text
m
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWS.put (g
gen, IntMap Text
m')
getGroup :: Int -> GenRWS g Text.Text
getGroup :: forall g. Int -> GenRWS g Text
getGroup Int
n = do
IntMap Text
m <- forall w (m :: * -> *) s a r.
(Monoid w, Monad m) =>
(s -> a) -> RWST r w s m a
RWS.gets forall a b. (a, b) -> b
snd
let maybeV :: Maybe Text
maybeV = forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
n IntMap Text
m
case Maybe Text
maybeV of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Just Text
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
size :: GenRWS g Int
size :: forall g. GenRWS g Int
size = forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
RWS.ask
str :: Random.RandomGen g => Parser.Parsed -> GenRWS g Text.Text
str :: forall g. RandomGen g => Parsed -> GenRWS g Text
str (Parser.PClass String
cs) = Char -> Text
Text.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g a. RandomGen g => [a] -> GenRWS g a
choice String
cs
str (Parser.PRange Int
s Maybe Int
me Parsed
p) = do
Int
e <- case Maybe Int
me of
Just Int
e' -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
e'
Maybe Int
Nothing -> forall g. GenRWS g Int
size
Int
n <- forall g a. (RandomGen g, Random a) => (a, a) -> GenRWS g a
randomRM (Int
s, Int
e)
[Text] -> Text
Text.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall g. RandomGen g => Parsed -> GenRWS g Text
str Parsed
p) [Int
1 .. Int
n]
str (Parser.PConcat [Parsed]
ps) = [Text] -> Text
Text.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall g. RandomGen g => Parsed -> GenRWS g Text
str [Parsed]
ps
str (Parser.PSelect [Parsed]
ps) = forall g. RandomGen g => Parsed -> GenRWS g Text
str forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall g a. RandomGen g => [a] -> GenRWS g a
choice [Parsed]
ps
str (Parser.PGrouped Int
n Parsed
p) = do
Text
v <- forall g. RandomGen g => Parsed -> GenRWS g Text
str Parsed
p
forall g. Int -> Text -> GenRWS g ()
putGroup Int
n Text
v
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
str (Parser.PBackward Int
n) = forall g. Int -> GenRWS g Text
getGroup Int
n
str (Parsed
Parser.PIgnored) = forall (m :: * -> *) a. Monad m => a -> m a
return Text
""