{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Util where

import Control.Applicative (liftA2)
import System.Random (StdGen, random, mkStdGen, split)
import qualified Data.Text as T
import Data.List (group, sort, intersperse)
import System.Random.Shuffle (shuffle')

-- * Function manipulation
compose2 :: (t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
compose2 :: forall t1 t2 t3 t4.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
compose2 t1 -> t2
f t3 -> t4 -> t1
g t3
x t4
y = t1 -> t2
f (t3 -> t4 -> t1
g t3
x t4
y)

-- * List manipulation
stripLeft :: (Eq a) => a -> [a] -> [a]
stripLeft :: forall a. Eq a => a -> [a] -> [a]
stripLeft a
x = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)

stripRight :: (Eq a) => a -> [a] -> [a]
stripRight :: forall a. Eq a => a -> [a] -> [a]
stripRight a
x = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
stripLeft a
x ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

strip :: (Eq a) => a -> [a] -> [a]
strip :: forall a. Eq a => a -> [a] -> [a]
strip a
x = a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
stripLeft a
x ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
stripRight a
x

replace :: (Eq a) => a -> a -> [a] -> [a]
replace :: forall a. Eq a => a -> a -> [a] -> [a]
replace a
x a
y = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
r where
    r :: a -> a
r a
z = if a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then a
y else a
z

filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd b -> Bool
f = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
f (b -> Bool) -> ((a, b) -> b) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd)

filterOutWords :: [T.Text] -> [(Int, T.Text)] -> [(Int, T.Text)]
filterOutWords :: [Text] -> [(Int, Text)] -> [(Int, Text)]
filterOutWords [Text]
forbiddenWords [(Int, Text)]
expressions = (Text -> [(Int, Text)] -> [(Int, Text)])
-> [(Int, Text)] -> [Text] -> [(Int, Text)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> [(Int, Text)] -> [(Int, Text)]
filterOutWord [(Int, Text)]
expressions [Text]
forbiddenWords

filterOutWord :: T.Text -> [(Int, T.Text)] -> [(Int, T.Text)]
filterOutWord :: Text -> [(Int, Text)] -> [(Int, Text)]
filterOutWord Text
forbiddenWord = (Text -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd ((Text -> Bool) -> [(Int, Text)] -> [(Int, Text)])
-> (Text -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool
isSubexpressionOf Text
forbiddenWord)

sortUniq :: (Ord a) => [a] -> [a]
sortUniq :: forall a. Ord a => [a] -> [a]
sortUniq = (([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. HasCallStack => [a] -> a
head) ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

headOrDefault :: a -> [a] -> a
headOrDefault :: forall a. a -> [a] -> a
headOrDefault a
d [] = a
d
headOrDefault a
_ (a
h:[a]
_) = a
h

isContiguousSequence :: (Integral a) => [a] -> Bool
isContiguousSequence :: forall a. Integral a => [a] -> Bool
isContiguousSequence [a]
xs = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1) ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs) [a]
xs

infixr 5 ?:
(?:) :: (Eq a) => a -> [a] -> [a]
a
x ?: :: forall a. Eq a => a -> [a] -> [a]
?: [a]
xs
    | a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs = [a]
xs
    | Bool
otherwise   = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs

concatET :: [Either String T.Text] -> Either String T.Text
concatET :: [Either String Text] -> Either String Text
concatET = (Either String Text -> Either String Text -> Either String Text)
-> [Either String Text] -> Either String Text
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ((Text -> Text -> Text)
-> Either String Text -> Either String Text -> Either String Text
forall a b c.
(a -> b -> c)
-> Either String a -> Either String b -> Either String c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Text -> Text -> Text
T.append)

unwordsET :: [Either String T.Text] -> Either String T.Text
unwordsET :: [Either String Text] -> Either String Text
unwordsET = [Either String Text] -> Either String Text
concatET ([Either String Text] -> Either String Text)
-> ([Either String Text] -> [Either String Text])
-> [Either String Text]
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String Text -> [Either String Text] -> [Either String Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" ")

-- * String manipulation
substr :: Int -> Int -> T.Text -> T.Text
substr :: Int -> Int -> Text -> Text
substr Int
beg Int
end = Int -> Text -> Text
T.drop Int
beg (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
end

subfield :: Int -> Int -> T.Text -> T.Text
subfield :: Int -> Int -> Text -> Text
subfield Int
beg Int
end = Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Text -> Text
substr Int
beg Int
end

isWordOf :: T.Text -> T.Text -> Bool
isWordOf :: Text -> Text -> Bool
isWordOf Text
word = (Text
word Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Text] -> Bool) -> (Text -> [Text]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

isSubexpressionOf :: T.Text -> T.Text -> Bool
isSubexpressionOf :: Text -> Text -> Bool
isSubexpressionOf Text
expr Text
text = (Text
expr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
text) Bool -> Bool -> Bool
|| (Text
prefixExpr Text -> Text -> Bool
`T.isPrefixOf` Text
text) Bool -> Bool -> Bool
|| (Text
suffixExpr Text -> Text -> Bool
`T.isSuffixOf` Text
text) Bool -> Bool -> Bool
|| (Text
infixExpr Text -> Text -> Bool
`T.isInfixOf` Text
text) where
    prefixExpr :: Text
prefixExpr = Text
expr Text -> Text -> Text
`T.append` Text
" "
    suffixExpr :: Text
suffixExpr = Text
" " Text -> Text -> Text
`T.append` Text
expr
    infixExpr :: Text
infixExpr = [Text] -> Text
T.concat [Text
" ", Text
expr, Text
" "]

replaceFirstSubstring :: T.Text -> T.Text -> T.Text -> T.Text
replaceFirstSubstring :: Text -> Text -> Text -> Text
replaceFirstSubstring Text
old Text
new Text
text =
    let
        components :: [Text]
components = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
old Text
text
    in
        if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
components then
            Text
text
        else
            ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
components) Text -> Text -> Text
`T.append` Text
new Text -> Text -> Text
`T.append` (Text -> [Text] -> Text
T.intercalate Text
old ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail [Text]
components))

replaceFirstSubexpression :: T.Text -> T.Text -> T.Text -> T.Text
replaceFirstSubexpression :: Text -> Text -> Text -> Text
replaceFirstSubexpression Text
old Text
new = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replaceFirstSubstring (Text
" " Text -> Text -> Text
`T.append` Text
old Text -> Text -> Text
`T.append` Text
" ") (Text
" " Text -> Text -> Text
`T.append` Text
new Text -> Text -> Text
`T.append` Text
" ") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
`T.append` Text
" ") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
`T.append`)

replaceSubexpression :: T.Text -> T.Text -> T.Text -> T.Text
replaceSubexpression :: Text -> Text -> Text -> Text
replaceSubexpression Text
old Text
new = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (Text
" " Text -> Text -> Text
`T.append` Text
old Text -> Text -> Text
`T.append` Text
" ") (Text
" " Text -> Text -> Text
`T.append` Text
new Text -> Text -> Text
`T.append` Text
" ") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
`T.append` Text
" ") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
`T.append`)

-- * Random (TODO: assert that sum > 0)
shuffle_ :: StdGen -> [a] -> [a]
shuffle_ :: forall a. StdGen -> [a] -> [a]
shuffle_ StdGen
r0 = ([a], StdGen) -> [a]
forall a b. (a, b) -> a
fst (([a], StdGen) -> [a]) -> ([a] -> ([a], StdGen)) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [a] -> ([a], StdGen)
forall a. StdGen -> [a] -> ([a], StdGen)
shuffle StdGen
r0

shuffle :: StdGen -> [a] -> ([a], StdGen)
shuffle :: forall a. StdGen -> [a] -> ([a], StdGen)
shuffle StdGen
r0 [a]
xs = ([a] -> Int -> StdGen -> [a]
forall gen a. RandomGen gen => [a] -> Int -> gen -> [a]
shuffle' [a]
xs ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) StdGen
r1, StdGen
r2) where
    (StdGen
r1, StdGen
r2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
r0

chooseItem :: StdGen -> [(Int, a)] -> (a, StdGen)
chooseItem :: forall a. StdGen -> [(Int, a)] -> (a, StdGen)
chooseItem StdGen
r0 [] = String -> (a, StdGen)
forall a. HasCallStack => String -> a
error String
"choosing item from empty list"
chooseItem StdGen
r0 [(Int, a)]
xs = (Int -> [(Int, a)] -> a
forall {b}. Int -> [(Int, b)] -> b
f Int
0 [(Int, a)]
xs, StdGen
r1) where
    (Int
val, StdGen
r1) = (StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
forall g. RandomGen g => g -> (Int, g)
random StdGen
r0)
    pos :: Int
pos = Int
val Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> Int) -> [(Int, a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> Int
forall a b. (a, b) -> a
fst [(Int, a)]
xs)
    f :: Int -> [(Int, b)] -> b
f Int
acc ((Int
n, b
x):[(Int, b)]
xs)
        | (Int
accInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pos = b
x
        | Bool
otherwise = Int -> [(Int, b)] -> b
f (Int
accInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) [(Int, b)]
xs

chooseItemUniformly :: StdGen -> [a] -> (a, StdGen)
chooseItemUniformly :: forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [a]
xs = StdGen -> [(Int, a)] -> (a, StdGen)
forall a. StdGen -> [(Int, a)] -> (a, StdGen)
chooseItem StdGen
r0 ([(Int, a)] -> (a, StdGen)) -> [(Int, a)] -> (a, StdGen)
forall a b. (a -> b) -> a -> b
$ (a -> (Int, a)) -> [a] -> [(Int, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
1,) [a]
xs

chooseItemsUniformly :: (Eq a) => StdGen -> Int -> [a] -> ([a], StdGen)
chooseItemsUniformly :: forall a. Eq a => StdGen -> Int -> [a] -> ([a], StdGen)
chooseItemsUniformly StdGen
r0 Int
0 [a]
_ = ([], StdGen
r0)
chooseItemsUniformly StdGen
r0 Int
_ [] = String -> ([a], StdGen)
forall a. HasCallStack => String -> a
error String
"not enough items to choose from"
chooseItemsUniformly StdGen
r0 Int
q [a]
xs = (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, StdGen
r2) where
    (a
y, StdGen
r1) = StdGen -> [a] -> (a, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [a]
xs
    ([a]
ys, StdGen
r2) = StdGen -> Int -> [a] -> ([a], StdGen)
forall a. Eq a => StdGen -> Int -> [a] -> ([a], StdGen)
chooseItemsUniformly StdGen
r1 (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y) [a]
xs)

generatorFromSingleton :: a -> StdGen -> (a, StdGen)
generatorFromSingleton :: forall a. a -> StdGen -> (a, StdGen)
generatorFromSingleton a
x StdGen
r0 = (a
x, StdGen
r0)

generatorFromList :: [a] -> StdGen -> (a, StdGen)
generatorFromList :: forall a. [a] -> StdGen -> (a, StdGen)
generatorFromList = (StdGen -> [a] -> (a, StdGen)) -> [a] -> StdGen -> (a, StdGen)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StdGen -> [a] -> (a, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly

generatorFromWeightedList :: [(Int, a)] -> StdGen -> (a, StdGen)
generatorFromWeightedList :: forall a. [(Int, a)] -> StdGen -> (a, StdGen)
generatorFromWeightedList = (StdGen -> [(Int, a)] -> (a, StdGen))
-> [(Int, a)] -> StdGen -> (a, StdGen)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StdGen -> [(Int, a)] -> (a, StdGen)
forall a. StdGen -> [(Int, a)] -> (a, StdGen)
chooseItem

generatorWithRetries :: Int -> (StdGen -> (Maybe b, StdGen)) -> (StdGen -> (Maybe b, StdGen))
generatorWithRetries :: forall b.
Int -> (StdGen -> (Maybe b, StdGen)) -> StdGen -> (Maybe b, StdGen)
generatorWithRetries Int
numberOfRetries StdGen -> (Maybe b, StdGen)
originalGenerator =
    if Int
numberOfRetries Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then
        \StdGen
r0 -> (Maybe b
forall a. Maybe a
Nothing, StdGen
r0)
    else
        \StdGen
r0 ->
            let (Maybe b
generatedValue, StdGen
r1) = StdGen -> (Maybe b, StdGen)
originalGenerator StdGen
r0
            in case Maybe b
generatedValue of
               Just b
x -> (b -> Maybe b
forall a. a -> Maybe a
Just b
x, StdGen
r1)
               Maybe b
Nothing -> Int -> (StdGen -> (Maybe b, StdGen)) -> StdGen -> (Maybe b, StdGen)
forall b.
Int -> (StdGen -> (Maybe b, StdGen)) -> StdGen -> (Maybe b, StdGen)
generatorWithRetries (Int
numberOfRetries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) StdGen -> (Maybe b, StdGen)
originalGenerator StdGen
r1

-- | Lifts a function that transforms a Foo into a Bar into a function that transforms a FooGenerator into a BarGenerator.
liftGen :: (a -> b) -> (StdGen -> (a, StdGen)) -> (StdGen -> (b, StdGen))
liftGen :: forall a b.
(a -> b) -> (StdGen -> (a, StdGen)) -> StdGen -> (b, StdGen)
liftGen a -> b
f StdGen -> (a, StdGen)
inputGenerator StdGen
r0 = (a -> b
f a
input, StdGen
r1) where
    (a
input, StdGen
r1) = StdGen -> (a, StdGen)
inputGenerator StdGen
r0

-- combineSimpleFunctions :: [(Int, a)] -> (StdGen -> a)

combineGenerators :: [(Int, StdGen -> a)] -> (StdGen -> a)
combineGenerators :: forall a. [(Int, StdGen -> a)] -> StdGen -> a
combineGenerators [(Int, StdGen -> a)]
fs StdGen
r0 =
    let (StdGen -> a
f, StdGen
r1) = StdGen -> [(Int, StdGen -> a)] -> (StdGen -> a, StdGen)
forall a. StdGen -> [(Int, a)] -> (a, StdGen)
chooseItem StdGen
r0 [(Int, StdGen -> a)]
fs
    in StdGen -> a
f StdGen
r1

combineGeneratorsUniformly :: [StdGen -> a] -> (StdGen -> a)
combineGeneratorsUniformly :: forall a. [StdGen -> a] -> StdGen -> a
combineGeneratorsUniformly [StdGen -> a]
fs = [(Int, StdGen -> a)] -> StdGen -> a
forall a. [(Int, StdGen -> a)] -> StdGen -> a
combineGenerators ([(Int, StdGen -> a)] -> StdGen -> a)
-> [(Int, StdGen -> a)] -> StdGen -> a
forall a b. (a -> b) -> a -> b
$ ((StdGen -> a) -> (Int, StdGen -> a))
-> [StdGen -> a] -> [(Int, StdGen -> a)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
1,) [StdGen -> a]
fs

mapRandom :: StdGen -> (StdGen -> a -> (b, StdGen)) -> [a] -> ([b], StdGen)
mapRandom :: forall a b.
StdGen -> (StdGen -> a -> (b, StdGen)) -> [a] -> ([b], StdGen)
mapRandom StdGen
r0 StdGen -> a -> (b, StdGen)
_ [] = ([], StdGen
r0)
mapRandom StdGen
r0 StdGen -> a -> (b, StdGen)
f (a
x:[a]
xs) = (b
f_x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
f_xs, StdGen
r2) where
    (b
f_x, StdGen
r1) = StdGen -> a -> (b, StdGen)
f StdGen
r0 a
x
    ([b]
f_xs, StdGen
r2) = StdGen -> (StdGen -> a -> (b, StdGen)) -> [a] -> ([b], StdGen)
forall a b.
StdGen -> (StdGen -> a -> (b, StdGen)) -> [a] -> ([b], StdGen)
mapRandom StdGen
r1 StdGen -> a -> (b, StdGen)
f [a]
xs

-- Tests
testChooseItem :: Int -> T.Text
testChooseItem :: Int -> Text
testChooseItem Int
x = (Text, StdGen) -> Text
forall a b. (a, b) -> a
fst ((Text, StdGen) -> Text) -> (Text, StdGen) -> Text
forall a b. (a -> b) -> a -> b
$ StdGen -> [(Int, Text)] -> (Text, StdGen)
forall a. StdGen -> [(Int, a)] -> (a, StdGen)
chooseItem (Int -> StdGen
mkStdGen Int
x) [(Int
5, Text
"a"), (Int
2, Text
"b"), (Int
3, Text
"c"), (Int
10, Text
"d")]

testChooseItemUniformly :: Int -> T.Text
testChooseItemUniformly :: Int -> Text
testChooseItemUniformly Int
x = (Text, StdGen) -> Text
forall a b. (a, b) -> a
fst ((Text, StdGen) -> Text) -> (Text, StdGen) -> Text
forall a b. (a -> b) -> a -> b
$ StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly (Int -> StdGen
mkStdGen Int
x) [Text
"a", Text
"b", Text
"c", Text
"d"]

testChooseFunctionUniformly :: Int -> T.Text
testChooseFunctionUniformly :: Int -> Text
testChooseFunctionUniformly Int
x = [StdGen -> Text] -> StdGen -> Text
forall a. [StdGen -> a] -> StdGen -> a
combineGeneratorsUniformly [Text -> StdGen -> Text
forall a b. a -> b -> a
const Text
"a", Text -> StdGen -> Text
forall a b. a -> b -> a
const Text
"b", Text -> StdGen -> Text
forall a b. a -> b -> a
const Text
"c"] (Int -> StdGen
mkStdGen Int
x)

-- Old implementations

{-chooseItemUniformly :: StdGen -> [a] -> (a, StdGen)-}
{-chooseItemUniformly r0 [] = error "choosing item from empty list"-}
{-chooseItemUniformly r0 list =-}
    {-let len = length list-}
        {-(p, r1) = random r0-}
        {-x = list !! (p `mod` len)-}
    {-in (x, r1)-}

{-chooseFunctionUniformly :: [(StdGen -> a)] -> (StdGen -> a)-}
{-chooseFunctionUniformly [] r0 = error "choosing function from empty list"-}
{-chooseFunctionUniformly fs r0 =-}
    {-let len = length fs-}
        {-(f, r1) = chooseItemUniformly r0 fs-}
    {-in f r1-}

curryUniformly :: (a -> b) -> [a] -> (StdGen -> b)
curryUniformly :: forall a b. (a -> b) -> [a] -> StdGen -> b
curryUniformly a -> b
f [] StdGen
r0 = String -> b
forall a. HasCallStack => String -> a
error String
"choosing argument from empty list"
curryUniformly a -> b
f [a]
xs StdGen
r0 =
    let len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
        (Int
p, StdGen
r1) = StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
forall g. RandomGen g => g -> (Int, g)
random StdGen
r0
        x :: a
x = [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
p Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len)
    in a -> b
f a
x

isTextWhitespace :: T.Text -> Bool
isTextWhitespace :: Text -> Bool
isTextWhitespace = Text -> Bool
T.null (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip