{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-|
Provides an interface to shuffle a 'taskInstance'
by providing a 'ShuffleInstance' datatype.

This module provides all means of shuffling.
-}
module Modelling.Auxiliary.Shuffle.All (
  ShuffleInstance (..),
  shuffleEverything,
  shuffleInstance,
  shuffleInstanceWith,
  ) where

import Modelling.Auxiliary.Common (
  RandomiseNames (randomiseNames),
  RandomiseLayout (randomiseLayout),
  Randomise (randomise),
  ShuffleExcept (unShuffleExcept),
  )

import Control.Exception                (SomeException)
import Control.Monad                    ((>=>))
import Control.Monad.Catch              (MonadThrow)
import Control.Monad.Random             (MonadRandom, RandomGen, evalRandT)
import GHC.Generics                     (Generic)

-- | A datatype that allows setting all available shuffling methods
data ShuffleInstance a = ShuffleInstance {
  -- | The task instance to shuffle
  forall a. ShuffleInstance a -> a
taskInstance :: !a,
  -- | If layout mangling should be permitted (affects graphics)
  forall a. ShuffleInstance a -> Bool
allowLayoutMangling :: !Bool,
  -- | If names should be shuffled (affects component names)
  forall a. ShuffleInstance a -> Bool
shuffleNames :: !Bool,
  -- | If available options should be shuffled (affects task description/answers)
  forall a. ShuffleInstance a -> Bool
shuffleOptions :: !Bool
  } deriving (ShuffleInstance a -> ShuffleInstance a -> Bool
(ShuffleInstance a -> ShuffleInstance a -> Bool)
-> (ShuffleInstance a -> ShuffleInstance a -> Bool)
-> Eq (ShuffleInstance a)
forall a. Eq a => ShuffleInstance a -> ShuffleInstance a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ShuffleInstance a -> ShuffleInstance a -> Bool
== :: ShuffleInstance a -> ShuffleInstance a -> Bool
$c/= :: forall a. Eq a => ShuffleInstance a -> ShuffleInstance a -> Bool
/= :: ShuffleInstance a -> ShuffleInstance a -> Bool
Eq, (forall x. ShuffleInstance a -> Rep (ShuffleInstance a) x)
-> (forall x. Rep (ShuffleInstance a) x -> ShuffleInstance a)
-> Generic (ShuffleInstance a)
forall x. Rep (ShuffleInstance a) x -> ShuffleInstance a
forall x. ShuffleInstance a -> Rep (ShuffleInstance a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ShuffleInstance a) x -> ShuffleInstance a
forall a x. ShuffleInstance a -> Rep (ShuffleInstance a) x
$cfrom :: forall a x. ShuffleInstance a -> Rep (ShuffleInstance a) x
from :: forall x. ShuffleInstance a -> Rep (ShuffleInstance a) x
$cto :: forall a x. Rep (ShuffleInstance a) x -> ShuffleInstance a
to :: forall x. Rep (ShuffleInstance a) x -> ShuffleInstance a
Generic, ReadPrec [ShuffleInstance a]
ReadPrec (ShuffleInstance a)
Int -> ReadS (ShuffleInstance a)
ReadS [ShuffleInstance a]
(Int -> ReadS (ShuffleInstance a))
-> ReadS [ShuffleInstance a]
-> ReadPrec (ShuffleInstance a)
-> ReadPrec [ShuffleInstance a]
-> Read (ShuffleInstance a)
forall a. Read a => ReadPrec [ShuffleInstance a]
forall a. Read a => ReadPrec (ShuffleInstance a)
forall a. Read a => Int -> ReadS (ShuffleInstance a)
forall a. Read a => ReadS [ShuffleInstance a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ShuffleInstance a)
readsPrec :: Int -> ReadS (ShuffleInstance a)
$creadList :: forall a. Read a => ReadS [ShuffleInstance a]
readList :: ReadS [ShuffleInstance a]
$creadPrec :: forall a. Read a => ReadPrec (ShuffleInstance a)
readPrec :: ReadPrec (ShuffleInstance a)
$creadListPrec :: forall a. Read a => ReadPrec [ShuffleInstance a]
readListPrec :: ReadPrec [ShuffleInstance a]
Read, Int -> ShuffleInstance a -> ShowS
[ShuffleInstance a] -> ShowS
ShuffleInstance a -> String
(Int -> ShuffleInstance a -> ShowS)
-> (ShuffleInstance a -> String)
-> ([ShuffleInstance a] -> ShowS)
-> Show (ShuffleInstance a)
forall a. Show a => Int -> ShuffleInstance a -> ShowS
forall a. Show a => [ShuffleInstance a] -> ShowS
forall a. Show a => ShuffleInstance a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ShuffleInstance a -> ShowS
showsPrec :: Int -> ShuffleInstance a -> ShowS
$cshow :: forall a. Show a => ShuffleInstance a -> String
show :: ShuffleInstance a -> String
$cshowList :: forall a. Show a => [ShuffleInstance a] -> ShowS
showList :: [ShuffleInstance a] -> ShowS
Show)

{-|
Set all shuffling methods of 'ShuffleInstance' to enabled.
-}
shuffleEverything
  :: (MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a, RandomiseNames a)
  => a
  -> m a
shuffleEverything :: forall (m :: * -> *) a.
(MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a,
 RandomiseNames a) =>
a -> m a
shuffleEverything a
inst = ShuffleInstance a -> m a
forall (m :: * -> *) a.
(MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a,
 RandomiseNames a) =>
ShuffleInstance a -> m a
shuffleInstance ShuffleInstance {
  taskInstance :: a
taskInstance = a
inst,
  allowLayoutMangling :: Bool
allowLayoutMangling = Bool
True,
  shuffleNames :: Bool
shuffleNames = Bool
True,
  shuffleOptions :: Bool
shuffleOptions = Bool
True
  }

{-|
Shuffle a 'taskInstance' based on enabled shuffling methods.
-}
shuffleInstance
  :: (MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a, RandomiseNames a)
  => ShuffleInstance a
  -> m a
shuffleInstance :: forall (m :: * -> *) a.
(MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a,
 RandomiseNames a) =>
ShuffleInstance a -> m a
shuffleInstance ShuffleInstance {a
Bool
taskInstance :: forall a. ShuffleInstance a -> a
allowLayoutMangling :: forall a. ShuffleInstance a -> Bool
shuffleNames :: forall a. ShuffleInstance a -> Bool
shuffleOptions :: forall a. ShuffleInstance a -> Bool
taskInstance :: a
allowLayoutMangling :: Bool
shuffleNames :: Bool
shuffleOptions :: Bool
..} =
  Bool -> (a -> m a) -> a -> m a
forall {m :: * -> *} {a}. Monad m => Bool -> (a -> m a) -> a -> m a
whenM Bool
shuffleNames a -> m a
forall a (m :: * -> *).
(RandomiseNames a, MonadRandom m, MonadThrow m) =>
a -> m a
forall (m :: * -> *). (MonadRandom m, MonadThrow m) => a -> m a
randomiseNames
  (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> (a -> m a) -> a -> m a
forall {m :: * -> *} {a}. Monad m => Bool -> (a -> m a) -> a -> m a
whenM Bool
shuffleOptions a -> m a
forall a (m :: * -> *).
(Randomise a, MonadRandom m, MonadThrow m) =>
a -> m a
forall (m :: * -> *). (MonadRandom m, MonadThrow m) => a -> m a
randomise
  (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> (a -> m a) -> a -> m a
forall {m :: * -> *} {a}. Monad m => Bool -> (a -> m a) -> a -> m a
whenM Bool
allowLayoutMangling a -> m a
forall a (m :: * -> *).
(RandomiseLayout a, MonadRandom m, MonadThrow m) =>
a -> m a
forall (m :: * -> *). (MonadRandom m, MonadThrow m) => a -> m a
randomiseLayout
  (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
taskInstance
  where
    whenM :: Bool -> (a -> m a) -> a -> m a
whenM Bool
p a -> m a
x = if Bool
p then a -> m a
x else a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

{-|
Shuffle a 'taskInstance' using 'shuffleInstance' and catch exceptions.
-}
shuffleInstanceWith
  :: (RandomGen g, Randomise a, RandomiseLayout a, RandomiseNames a)
  => ShuffleInstance a
  -> g
  -> Either SomeException a
shuffleInstanceWith :: forall g a.
(RandomGen g, Randomise a, RandomiseLayout a, RandomiseNames a) =>
ShuffleInstance a -> g -> Either SomeException a
shuffleInstanceWith ShuffleInstance a
x = RandT g (Either SomeException) a -> g -> Either SomeException a
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT (ShuffleExcept g a -> RandT g (Either SomeException) a
forall g a. ShuffleExcept g a -> RandT g (Either SomeException) a
unShuffleExcept (ShuffleExcept g a -> RandT g (Either SomeException) a)
-> ShuffleExcept g a -> RandT g (Either SomeException) a
forall a b. (a -> b) -> a -> b
$ ShuffleInstance a -> ShuffleExcept g a
forall (m :: * -> *) a.
(MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a,
 RandomiseNames a) =>
ShuffleInstance a -> m a
shuffleInstance ShuffleInstance a
x)