{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Modelling.Auxiliary.Common (
  ModellingTasksException (..),
  Object (..),
  Randomise (..),
  RandomiseLayout (..),
  RandomiseNames (..),
  ShuffleExcept (..),
  TaskGenerationException (..),
  findFittingRandomElements,
  getFirstInstance,
  lensRulesL,
  lowerFirst,
  mapIndicesTo,
  oneOf,
  parseInt,
  parseWith,
  skipSpaces,
  toMap,
  upperFirst,
  upperToDash,
  weightedShuffle,
  ) where

import qualified Data.Map                         as M (
  Map,
  empty,
  insertWith,
  )
import qualified Data.Set                         as S (
  Set,
  singleton,
  union,
  )

import Control.Exception                (Exception, SomeException)
import Control.Monad.Catch              (MonadThrow (throwM))
import Control.Monad.Extra              (firstJustM, ifM, maybeM)
import Control.Monad.Random (
  MonadRandom (getRandomR),
  RandT,
  fromList,
  )
import Control.Monad.Trans.Class        (lift)
import Data.Char (
  digitToInt,
  isSpace,
  isUpper,
  toLower,
  toUpper,
  )
import Data.Foldable                    (Foldable (foldl'))
import Data.Function                    ((&))
import Data.List                       (delete)
import Control.Lens (
  LensRules,
  (.~),
  lensField,
  lensRules,
  mappingNamer,
  )
import Math.Combinatorics.Exact.Binomial (choose)
import System.Random.Shuffle            (shuffleM)
import Text.Parsec                      (parse)
import Text.ParserCombinators.Parsec (
  Parser,
  digit,
  many,
  many1,
  optional,
  satisfy,
  )

data MatchListsException =
  FirstListIsLonger
  | SecondListIsLonger
  | ListsDoNotContainSameElements
  deriving Int -> MatchListsException -> ShowS
[MatchListsException] -> ShowS
MatchListsException -> String
(Int -> MatchListsException -> ShowS)
-> (MatchListsException -> String)
-> ([MatchListsException] -> ShowS)
-> Show MatchListsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchListsException -> ShowS
showsPrec :: Int -> MatchListsException -> ShowS
$cshow :: MatchListsException -> String
show :: MatchListsException -> String
$cshowList :: [MatchListsException] -> ShowS
showList :: [MatchListsException] -> ShowS
Show

instance Exception MatchListsException

data ModellingTasksException
  = NeverHappens
  deriving Int -> ModellingTasksException -> ShowS
[ModellingTasksException] -> ShowS
ModellingTasksException -> String
(Int -> ModellingTasksException -> ShowS)
-> (ModellingTasksException -> String)
-> ([ModellingTasksException] -> ShowS)
-> Show ModellingTasksException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModellingTasksException -> ShowS
showsPrec :: Int -> ModellingTasksException -> ShowS
$cshow :: ModellingTasksException -> String
show :: ModellingTasksException -> String
$cshowList :: [ModellingTasksException] -> ShowS
showList :: [ModellingTasksException] -> ShowS
Show

instance Exception ModellingTasksException

instance {-# OVERLAPPABLE #-} MonadThrow m => MonadThrow (RandT g m) where
  throwM :: forall e a. Exception e => e -> RandT g m a
throwM = m a -> RandT g m a
forall (m :: * -> *) a. Monad m => m a -> RandT g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RandT g m a) -> (e -> m a) -> e -> RandT g m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

mapIndicesTo :: (Eq a, MonadThrow m) => [a] -> [a] -> m [(Int, Int)]
mapIndicesTo :: forall a (m :: * -> *).
(Eq a, MonadThrow m) =>
[a] -> [a] -> m [(Int, Int)]
mapIndicesTo [a]
xs [a]
ys = [(Int, a)] -> [(Int, a)] -> m [(Int, Int)]
forall a (m :: * -> *).
(Eq a, MonadThrow m) =>
[(Int, a)] -> [(Int, a)] -> m [(Int, Int)]
mapIndicesToHelper ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
xs) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
ys)

mapIndicesToHelper
  :: (Eq a, MonadThrow m)
  => [(Int, a)]
  -> [(Int, a)]
  -> m [(Int, Int)]
mapIndicesToHelper :: forall a (m :: * -> *).
(Eq a, MonadThrow m) =>
[(Int, a)] -> [(Int, a)] -> m [(Int, Int)]
mapIndicesToHelper [] [] = [(Int, Int)] -> m [(Int, Int)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mapIndicesToHelper [] [(Int, a)]
_ = MatchListsException -> m [(Int, Int)]
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MatchListsException
SecondListIsLonger
mapIndicesToHelper [(Int, a)]
_ [] = MatchListsException -> m [(Int, Int)]
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MatchListsException
FirstListIsLonger
mapIndicesToHelper ((Int
k, a
x):[(Int, a)]
xs) [(Int, a)]
ys = do
  (Int
l, [(Int, a)]
ys') <- [(Int, a)] -> m (Int, [(Int, a)])
forall {m :: * -> *} {a}.
MonadThrow m =>
[(a, a)] -> m (a, [(a, a)])
getFirstIn [(Int, a)]
ys
  ((Int
k, Int
l) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:) ([(Int, Int)] -> [(Int, Int)]) -> m [(Int, Int)] -> m [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, a)] -> [(Int, a)] -> m [(Int, Int)]
forall a (m :: * -> *).
(Eq a, MonadThrow m) =>
[(Int, a)] -> [(Int, a)] -> m [(Int, Int)]
mapIndicesToHelper [(Int, a)]
xs [(Int, a)]
ys'
  where
    getFirstIn :: [(a, a)] -> m (a, [(a, a)])
getFirstIn [] = MatchListsException -> m (a, [(a, a)])
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MatchListsException
ListsDoNotContainSameElements
    getFirstIn ((a
l, a
y) : [(a, a)]
ys')
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = (a, [(a, a)]) -> m (a, [(a, a)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
l, [(a, a)]
ys')
      | Bool
otherwise = ([(a, a)] -> [(a, a)]) -> (a, [(a, a)]) -> (a, [(a, a)])
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a
l, a
y) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:) ((a, [(a, a)]) -> (a, [(a, a)]))
-> m (a, [(a, a)]) -> m (a, [(a, a)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a)] -> m (a, [(a, a)])
getFirstIn [(a, a)]
ys'

newtype ShuffleExcept g a = ShuffleExcept {
  forall g a. ShuffleExcept g a -> RandT g (Either SomeException) a
unShuffleExcept :: RandT g (Either SomeException) a
  }
  deriving (Functor (ShuffleExcept g)
Functor (ShuffleExcept g)
-> (forall a. a -> ShuffleExcept g a)
-> (forall a b.
    ShuffleExcept g (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b)
-> (forall a b c.
    (a -> b -> c)
    -> ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g c)
-> (forall a b.
    ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b)
-> (forall a b.
    ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g a)
-> Applicative (ShuffleExcept g)
forall {g}. Functor (ShuffleExcept g)
forall a. a -> ShuffleExcept g a
forall g a. a -> ShuffleExcept g a
forall a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g a
forall a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
forall a b.
ShuffleExcept g (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
forall g a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g a
forall g a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
forall g a b.
ShuffleExcept g (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
forall a b c.
(a -> b -> c)
-> ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g c
forall g a b c.
(a -> b -> c)
-> ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall g a. a -> ShuffleExcept g a
pure :: forall a. a -> ShuffleExcept g a
$c<*> :: forall g a b.
ShuffleExcept g (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
<*> :: forall a b.
ShuffleExcept g (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
$cliftA2 :: forall g a b c.
(a -> b -> c)
-> ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g c
liftA2 :: forall a b c.
(a -> b -> c)
-> ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g c
$c*> :: forall g a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
*> :: forall a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
$c<* :: forall g a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g a
<* :: forall a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g a
Applicative, (forall a b. (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b)
-> (forall a b. a -> ShuffleExcept g b -> ShuffleExcept g a)
-> Functor (ShuffleExcept g)
forall a b. a -> ShuffleExcept g b -> ShuffleExcept g a
forall a b. (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
forall g a b. a -> ShuffleExcept g b -> ShuffleExcept g a
forall g a b. (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall g a b. (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
fmap :: forall a b. (a -> b) -> ShuffleExcept g a -> ShuffleExcept g b
$c<$ :: forall g a b. a -> ShuffleExcept g b -> ShuffleExcept g a
<$ :: forall a b. a -> ShuffleExcept g b -> ShuffleExcept g a
Functor, Applicative (ShuffleExcept g)
Applicative (ShuffleExcept g)
-> (forall a b.
    ShuffleExcept g a -> (a -> ShuffleExcept g b) -> ShuffleExcept g b)
-> (forall a b.
    ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b)
-> (forall a. a -> ShuffleExcept g a)
-> Monad (ShuffleExcept g)
forall g. Applicative (ShuffleExcept g)
forall a. a -> ShuffleExcept g a
forall g a. a -> ShuffleExcept g a
forall a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
forall a b.
ShuffleExcept g a -> (a -> ShuffleExcept g b) -> ShuffleExcept g b
forall g a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
forall g a b.
ShuffleExcept g a -> (a -> ShuffleExcept g b) -> ShuffleExcept g b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall g a b.
ShuffleExcept g a -> (a -> ShuffleExcept g b) -> ShuffleExcept g b
>>= :: forall a b.
ShuffleExcept g a -> (a -> ShuffleExcept g b) -> ShuffleExcept g b
$c>> :: forall g a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
>> :: forall a b.
ShuffleExcept g a -> ShuffleExcept g b -> ShuffleExcept g b
$creturn :: forall g a. a -> ShuffleExcept g a
return :: forall a. a -> ShuffleExcept g a
Monad, Monad (ShuffleExcept g)
Monad (ShuffleExcept g)
-> (forall a. Random a => (a, a) -> ShuffleExcept g a)
-> (forall a. Random a => ShuffleExcept g a)
-> (forall a. Random a => (a, a) -> ShuffleExcept g [a])
-> (forall a. Random a => ShuffleExcept g [a])
-> MonadRandom (ShuffleExcept g)
forall {g}. RandomGen g => Monad (ShuffleExcept g)
forall g a. (RandomGen g, Random a) => ShuffleExcept g a
forall g a. (RandomGen g, Random a) => ShuffleExcept g [a]
forall g a. (RandomGen g, Random a) => (a, a) -> ShuffleExcept g a
forall g a.
(RandomGen g, Random a) =>
(a, a) -> ShuffleExcept g [a]
forall a. Random a => ShuffleExcept g a
forall a. Random a => ShuffleExcept g [a]
forall a. Random a => (a, a) -> ShuffleExcept g a
forall a. Random a => (a, a) -> ShuffleExcept g [a]
forall (m :: * -> *).
Monad m
-> (forall a. Random a => (a, a) -> m a)
-> (forall a. Random a => m a)
-> (forall a. Random a => (a, a) -> m [a])
-> (forall a. Random a => m [a])
-> MonadRandom m
$cgetRandomR :: forall g a. (RandomGen g, Random a) => (a, a) -> ShuffleExcept g a
getRandomR :: forall a. Random a => (a, a) -> ShuffleExcept g a
$cgetRandom :: forall g a. (RandomGen g, Random a) => ShuffleExcept g a
getRandom :: forall a. Random a => ShuffleExcept g a
$cgetRandomRs :: forall g a.
(RandomGen g, Random a) =>
(a, a) -> ShuffleExcept g [a]
getRandomRs :: forall a. Random a => (a, a) -> ShuffleExcept g [a]
$cgetRandoms :: forall g a. (RandomGen g, Random a) => ShuffleExcept g [a]
getRandoms :: forall a. Random a => ShuffleExcept g [a]
MonadRandom)

instance MonadThrow (ShuffleExcept g) where
  throwM :: forall e a. Exception e => e -> ShuffleExcept g a
throwM = RandT g (Either SomeException) a -> ShuffleExcept g a
forall g a. RandT g (Either SomeException) a -> ShuffleExcept g a
ShuffleExcept (RandT g (Either SomeException) a -> ShuffleExcept g a)
-> (e -> RandT g (Either SomeException) a)
-> e
-> ShuffleExcept g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException a -> RandT g (Either SomeException) a
forall (m :: * -> *) a. Monad m => m a -> RandT g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either SomeException a -> RandT g (Either SomeException) a)
-> (e -> Either SomeException a)
-> e
-> RandT g (Either SomeException) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either SomeException a
forall e a. Exception e => e -> Either SomeException a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

{-|
The class of types that allow some form of randomisation.
-}
class Randomise a where
  -- | Shuffles every component without affecting basic overall properties
  randomise :: (MonadRandom m, MonadThrow m) => a -> m a

  -- | Checks the randomisability of the given value
  --     * returns Nothing, if it is randomisable
  --     * returns Just the explanation why not, otherwise
  isRandomisable :: a -> Maybe String
  isRandomisable a
_ = Maybe String
forall a. Maybe a
Nothing

{-|
The class of types that allow changing its layout randomly.
-}
class RandomiseLayout a where
  {-
  Shuffles the structure of every component
  without affecting its content and basic overall properties
  but by (maybe) affecting its layout.

  For a graph, for example, by changing the order of edges and nodes which affects
  how the used algorithm is laying out the graph.
  -}
  randomiseLayout :: (MonadRandom m, MonadThrow m) => a -> m a

{-|
The class of types that allow swapping (some of) its components names randomly.
-}
class RandomiseNames a where
  -- | Checks the randomisability of names for the given value
  --     * returns Nothing, if it is randomisable
  --     * returns Just the explanation why not, otherwise
  hasRandomisableNames :: a -> Maybe String
  hasRandomisableNames a
_ = Maybe String
forall a. Maybe a
Nothing

  -- | Shuffles the order of names of an instance, swapping names of components
  randomiseNames :: (MonadRandom m, MonadThrow m) => a -> m a

upperToDash :: String -> String
upperToDash :: ShowS
upperToDash [] = []
upperToDash (Char
y:String
ys) = Char -> Char
toLower Char
y Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> ShowS) -> String -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
  (\Char
x String
xs -> if Char -> Bool
isUpper Char
x then Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) String
""
  String
ys

data Object = Object {
  Object -> String
oName :: String,
  Object -> Int
oIndex :: Int
  } deriving (Object -> Object -> Bool
(Object -> Object -> Bool)
-> (Object -> Object -> Bool) -> Eq Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
/= :: Object -> Object -> Bool
Eq, Eq Object
Eq Object
-> (Object -> Object -> Ordering)
-> (Object -> Object -> Bool)
-> (Object -> Object -> Bool)
-> (Object -> Object -> Bool)
-> (Object -> Object -> Bool)
-> (Object -> Object -> Object)
-> (Object -> Object -> Object)
-> Ord Object
Object -> Object -> Bool
Object -> Object -> Ordering
Object -> Object -> Object
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Object -> Object -> Ordering
compare :: Object -> Object -> Ordering
$c< :: Object -> Object -> Bool
< :: Object -> Object -> Bool
$c<= :: Object -> Object -> Bool
<= :: Object -> Object -> Bool
$c> :: Object -> Object -> Bool
> :: Object -> Object -> Bool
$c>= :: Object -> Object -> Bool
>= :: Object -> Object -> Bool
$cmax :: Object -> Object -> Object
max :: Object -> Object -> Object
$cmin :: Object -> Object -> Object
min :: Object -> Object -> Object
Ord, Int -> Object -> ShowS
[Object] -> ShowS
Object -> String
(Int -> Object -> ShowS)
-> (Object -> String) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Object -> ShowS
showsPrec :: Int -> Object -> ShowS
$cshow :: Object -> String
show :: Object -> String
$cshowList :: [Object] -> ShowS
showList :: [Object] -> ShowS
Show)

toMap :: (Ord a, Ord b) => S.Set (a, b) -> M.Map a (S.Set b)
toMap :: forall a b. (Ord a, Ord b) => Set (a, b) -> Map a (Set b)
toMap = ((a, b) -> Map a (Set b) -> Map a (Set b))
-> Map a (Set b) -> Set (a, b) -> Map a (Set b)
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
x, b
y) -> (Set b -> Set b -> Set b)
-> a -> Set b -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
S.union a
x (b -> Set b
forall a. a -> Set a
S.singleton b
y)) Map a (Set b)
forall k a. Map k a
M.empty

oneOf :: MonadRandom m => [a] -> m a
oneOf :: forall (m :: * -> *) a. MonadRandom m => [a] -> m a
oneOf [a]
xs = do
      Int
x <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
x

skipSpaces :: Parser ()
skipSpaces :: Parser ()
skipSpaces = ParsecT String () Identity String -> Parser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String () Identity String -> Parser ())
-> ParsecT String () Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace

parseInt :: Parser Int
parseInt :: Parser Int
parseInt = (Int -> Char -> Int) -> Int -> String -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a Char
i -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
i) Int
0 (String -> Int) -> ParsecT String () Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

lowerFirst :: String -> String
lowerFirst :: ShowS
lowerFirst []     = []
lowerFirst (Char
x:String
xs) = Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

upperFirst :: String -> String
upperFirst :: ShowS
upperFirst []     = []
upperFirst (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

lensRulesL :: LensRules
lensRulesL :: LensRules
lensRulesL = LensRules
lensRules LensRules -> (LensRules -> LensRules) -> LensRules
forall a b. a -> (a -> b) -> b
& (FieldNamer -> Identity FieldNamer)
-> LensRules -> Identity LensRules
Lens' LensRules FieldNamer
lensField ((FieldNamer -> Identity FieldNamer)
 -> LensRules -> Identity LensRules)
-> FieldNamer -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> [String]) -> FieldNamer
mappingNamer (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'l'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
upperFirst)

parseWith :: MonadThrow m => (Int -> Parser a) -> String -> m a
parseWith :: forall (m :: * -> *) a.
MonadThrow m =>
(Int -> Parser a) -> String -> m a
parseWith Int -> Parser a
f = (ParseError -> m a) -> (a -> m a) -> Either ParseError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParsingException -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParsingException -> m a)
-> (ParseError -> ParsingException) -> ParseError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsingException
ParsingException (String -> ParsingException)
-> (ParseError -> String) -> ParseError -> ParsingException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError a -> m a)
-> (String -> Either ParseError a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Int -> Parser a
f Int
0) String
""

newtype ParsingException
  = ParsingException String
  deriving Int -> ParsingException -> ShowS
[ParsingException] -> ShowS
ParsingException -> String
(Int -> ParsingException -> ShowS)
-> (ParsingException -> String)
-> ([ParsingException] -> ShowS)
-> Show ParsingException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParsingException -> ShowS
showsPrec :: Int -> ParsingException -> ShowS
$cshow :: ParsingException -> String
show :: ParsingException -> String
$cshowList :: [ParsingException] -> ShowS
showList :: [ParsingException] -> ShowS
Show

instance Exception ParsingException

data TaskGenerationException =
  NoInstanceAvailable
  deriving Int -> TaskGenerationException -> ShowS
[TaskGenerationException] -> ShowS
TaskGenerationException -> String
(Int -> TaskGenerationException -> ShowS)
-> (TaskGenerationException -> String)
-> ([TaskGenerationException] -> ShowS)
-> Show TaskGenerationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskGenerationException -> ShowS
showsPrec :: Int -> TaskGenerationException -> ShowS
$cshow :: TaskGenerationException -> String
show :: TaskGenerationException -> String
$cshowList :: [TaskGenerationException] -> ShowS
showList :: [TaskGenerationException] -> ShowS
Show

instance Exception TaskGenerationException

getFirstInstance :: MonadThrow m => [a] -> m a
getFirstInstance :: forall (m :: * -> *) a. MonadThrow m => [a] -> m a
getFirstInstance [] = TaskGenerationException -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TaskGenerationException
NoInstanceAvailable
getFirstInstance (a
x:[a]
_) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

{-|
Provides a list of given elements with as many entries as provided predicates
by randomly picking given elements while ensuring as few repetitions
of these elements as possible occur.

Each predicate restricts an element in the resulting list (in order).
That means the resulting list is as long as the predicates list.
'Nothing' will be returned if there is no way to match all the predicates.

This function will attempt to distribute evenly, i.e. if 4 different elements
and 4 predicates are provided and no permutation fits,
'Nothing' will be returned although the predicates might hold for
e.g. choosing one of the elements 4 times.
-}
findFittingRandom
  :: MonadRandom m
  => [a]
  -- ^ elements to choose from
  -> [a -> m Bool]
  -- ^ predicates to satisfy
  -> m (Maybe [a])
findFittingRandom :: forall (m :: * -> *) a.
MonadRandom m =>
[a] -> [a -> m Bool] -> m (Maybe [a])
findFittingRandom [a]
xs [a -> m Bool]
predicates = do
  [a]
xs' <- [a] -> m [a]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate (([a -> m Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a -> m Bool]
predicates Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
  [a -> m Bool] -> ([a] -> [a]) -> [a] -> m (Maybe [a])
forall {f :: * -> *} {a}.
Monad f =>
[a -> f Bool] -> ([a] -> [a]) -> [a] -> f (Maybe [a])
elementsFor [a -> m Bool]
predicates [a] -> [a]
forall a. a -> a
id [a]
xs'
  where
    elementsFor :: [a -> f Bool] -> ([a] -> [a]) -> [a] -> f (Maybe [a])
elementsFor [] [a] -> [a]
_ [a]
_ = Maybe [a] -> f (Maybe [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Maybe [a]
forall a. a -> Maybe a
Just [])
    elementsFor [a -> f Bool]
_ [a] -> [a]
_ [] = Maybe [a] -> f (Maybe [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [a]
forall a. Maybe a
Nothing
    elementsFor (a -> f Bool
p : [a -> f Bool]
ps) [a] -> [a]
prependFailed (a
c : [a]
cs) = do
      let retry :: f (Maybe [a])
retry = [a -> f Bool] -> ([a] -> [a]) -> [a] -> f (Maybe [a])
elementsFor (a -> f Bool
p (a -> f Bool) -> [a -> f Bool] -> [a -> f Bool]
forall a. a -> [a] -> [a]
: [a -> f Bool]
ps) ([a] -> [a]
prependFailed ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
cs
      f Bool -> f (Maybe [a]) -> f (Maybe [a]) -> f (Maybe [a])
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> f Bool
p a
c)
        (f (Maybe [a])
-> ([a] -> f (Maybe [a])) -> f (Maybe [a]) -> f (Maybe [a])
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM f (Maybe [a])
retry (Maybe [a] -> f (Maybe [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [a] -> f (Maybe [a]))
-> ([a] -> Maybe [a]) -> [a] -> f (Maybe [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> ([a] -> [a]) -> [a] -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (f (Maybe [a]) -> f (Maybe [a])) -> f (Maybe [a]) -> f (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [a -> f Bool] -> ([a] -> [a]) -> [a] -> f (Maybe [a])
elementsFor [a -> f Bool]
ps [a] -> [a]
forall a. a -> a
id ([a] -> f (Maybe [a])) -> [a] -> f (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
prependFailed [a]
cs)
        f (Maybe [a])
retry

-- | Find fitting random elements with sophisticated distribution logic
-- Tries valid divisors in descending order with retry mechanism for each divisor
findFittingRandomElements
  :: MonadRandom m
  => Bool
  -- ^ useDifferentElements flag
  -> [a]
  -- ^ available elements
  -> [a -> m Bool]
  -- ^ predicates to satisfy
  -> m (Maybe [a])
findFittingRandomElements :: forall (m :: * -> *) a.
MonadRandom m =>
Bool -> [a] -> [a -> m Bool] -> m (Maybe [a])
findFittingRandomElements Bool
useDifferent [a]
availableElements [a -> m Bool]
predicates
  | Bool
useDifferent =
      let numAvailable :: Int
numAvailable = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
availableElements
          numRequested :: Int
numRequested = [a -> m Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a -> m Bool]
predicates
          validNs :: [Int]
validNs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
n -> Int
numRequested Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [Int
numAvailable, Int
numAvailable Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 .. Int
2]
          tryDivisors :: [Int] -> m (Maybe [a])
tryDivisors [] = [a] -> [a -> m Bool] -> m (Maybe [a])
forall (m :: * -> *) a.
MonadRandom m =>
[a] -> [a -> m Bool] -> m (Maybe [a])
findFittingRandom [a]
availableElements [a -> m Bool]
predicates
          tryDivisors (Int
n:[Int]
ns) = Int -> m (Maybe [a])
forall {t}. (Eq t, Num t) => t -> m (Maybe [a])
tryDivisorWithRetries Int
maxRetries
            where
                maxRetries :: Int
maxRetries = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
10 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
numAvailable Int -> Int -> Int
forall a. Integral a => a -> a -> a
`choose` Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                tryDivisorWithRetries :: t -> m (Maybe [a])
tryDivisorWithRetries t
0 = [Int] -> m (Maybe [a])
tryDivisors [Int]
ns  -- Exhausted retries, try next divisor
                tryDivisorWithRetries t
retries = do
                  [a]
selectedElements <- Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m [a]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [a]
availableElements
                  Maybe [a]
result <- [a] -> [a -> m Bool] -> m (Maybe [a])
forall (m :: * -> *) a.
MonadRandom m =>
[a] -> [a -> m Bool] -> m (Maybe [a])
findFittingRandom [a]
selectedElements [a -> m Bool]
predicates
                  case Maybe [a]
result of
                    Maybe [a]
Nothing -> t -> m (Maybe [a])
tryDivisorWithRetries (t
retries t -> t -> t
forall a. Num a => a -> a -> a
- t
1)  -- Retry with different selection
                    Just [a]
elements -> Maybe [a] -> m (Maybe [a])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
elements)
      in [Int] -> m (Maybe [a])
tryDivisors [Int]
validNs
  | Bool
otherwise = do
      [a]
ds <- [a] -> m [a]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [a]
availableElements
      (a -> m (Maybe [a])) -> [a] -> m (Maybe [a])
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (\a
x -> [a] -> [a -> m Bool] -> m (Maybe [a])
forall (m :: * -> *) a.
MonadRandom m =>
[a] -> [a -> m Bool] -> m (Maybe [a])
findFittingRandom [a
x] [a -> m Bool]
predicates) [a]
ds

{-|
  Shuffle a list of elements from type a based on given weights of type w,
  where higher weight indicates a bigger probability of the element occurring
  at a lower index of the list. The total weight of all elements must not be zero.
-}
weightedShuffle
  :: (MonadRandom m, Eq a, Real w)
  => [(a,w)]
  -> m [a]
weightedShuffle :: forall (m :: * -> *) a w.
(MonadRandom m, Eq a, Real w) =>
[(a, w)] -> m [a]
weightedShuffle [] = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
weightedShuffle [(a, w)]
xs = do
  let rs :: [((a, w), Rational)]
rs = ((a, w) -> ((a, w), Rational)) -> [(a, w)] -> [((a, w), Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a, w)
x -> ((a, w)
x, w -> Rational
forall a. Real a => a -> Rational
toRational (w -> Rational) -> w -> Rational
forall a b. (a -> b) -> a -> b
$ (a, w) -> w
forall a b. (a, b) -> b
snd (a, w)
x)) [(a, w)]
xs
  (a, w)
a <- [((a, w), Rational)] -> m (a, w)
forall (m :: * -> *) a. MonadRandom m => [(a, Rational)] -> m a
fromList [((a, w), Rational)]
rs
  [a]
ys <- [(a, w)] -> m [a]
forall (m :: * -> *) a w.
(MonadRandom m, Eq a, Real w) =>
[(a, w)] -> m [a]
weightedShuffle ((a, w) -> [(a, w)] -> [(a, w)]
forall a. Eq a => a -> [a] -> [a]
delete (a, w)
a [(a, w)]
xs)
  [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, w) -> a
forall a b. (a, b) -> a
fst (a, w)
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)