module DeckHandling where
import Control.Monad (forM)
import qualified Data.List.NonEmpty as NE
import Data.Random
import Lens.Micro.Platform
import States
import Types

doRandomization :: GlobalState -> Bool -> [Card] -> IO ([Int], [Card])
doRandomization :: GlobalState -> Bool -> [Card] -> IO ([Int], [Card])
doRandomization GlobalState
gs Bool
shuffleAnswers [Card]
cards = do
    let ixs :: [Int]
ixs = [Int
0..forall (t :: * -> *) a. Foldable t => t a -> Int
length [Card]
cards forall a. Num a => a -> a -> a
- Int
1]
    [Int]
shuffledIxs <- if GlobalState
gsforall s a. s -> Getting a s a -> a
^.Lens' GlobalState Parameters
parametersforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Parameters Bool
pShuffle then forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom (GlobalState
gsforall s a. s -> Getting a s a -> a
^.Lens' GlobalState GenIO
mwc) (forall a. [a] -> RVar [a]
shuffle [Int]
ixs) else forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
ixs
    let cards' :: [Card]
cards' = forall a b. (a -> b) -> [a] -> [b]
map ([Card]
cards forall a. [a] -> Int -> a
!!) [Int]
shuffledIxs
    [Card]
cards'' <- if Bool
shuffleAnswers
      then forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom (GlobalState
gsforall s a. s -> Getting a s a -> a
^.Lens' GlobalState GenIO
mwc) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Card -> RVar Card
shuffleCard [Card]
cards'
      else forall (m :: * -> *) a. Monad m => a -> m a
return [Card]
cards'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([Int]
shuffledIxs, [Card]
cards'')

shuffleCard :: Card -> RVar Card
shuffleCard :: Card -> RVar Card
shuffleCard (c :: Card
c@MultipleAnswer{}) = do
  [Option]
shuffledOptions <- forall a. [a] -> RVar [a]
shuffle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ Card -> NonEmpty Option
options Card
c
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Card
c { options :: NonEmpty Option
options = forall a. [a] -> NonEmpty a
NE.fromList [Option]
shuffledOptions }
shuffleCard (c :: Card
c@MultipleChoice{}) = do
  let CorrectOption Int
ic String
sc = Card -> CorrectOption
correct Card
c
      ixs :: [Int]
ixs = [Int
0..forall (t :: * -> *) a. Foldable t => t a -> Int
length (Card -> [IncorrectOption]
incorrects Card
c)]
  [Int]
shuffledIxs <- forall a. [a] -> RVar [a]
shuffle [Int]
ixs
  let ic' :: Int
ic' = [Int]
shuffledIxs forall a. [a] -> Int -> a
!! Int
ic
      corrOpt :: CorrectOption
corrOpt = Int -> String -> CorrectOption
CorrectOption Int
ic' String
sc
      incOpts :: [IncorrectOption]
incOpts = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Card -> [IncorrectOption]
incorrects Card
c forall a. [a] -> Int -> a
!!) forall a b. (a -> b) -> a -> b
$ if Int
i forall a. Ord a => a -> a -> Bool
> Int
ic' then Int
i forall a. Num a => a -> a -> a
- Int
1 else Int
i) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Int
ic') [Int]
shuffledIxs)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Card
c { correct :: CorrectOption
correct = CorrectOption
corrOpt, incorrects :: [IncorrectOption]
incorrects = [IncorrectOption]
incOpts } 
shuffleCard Card
c = forall (m :: * -> *) a. Monad m => a -> m a
return Card
c

doChunking :: Chunk -> [a] -> [a]
doChunking :: forall a. Chunk -> [a] -> [a]
doChunking (Chunk Int
i Int
n) [a]
cards = 
  forall a. Int -> [a] -> [[a]]
splitIntoNChunks Int
n [a]
cards forall a. [a] -> Int -> a
!! (Int
iforall a. Num a => a -> a -> a
-Int
1)

-- Split into chunks that differ a maximum of 1 in size;

-- the larger chunks are all at the front.

splitIntoNChunks :: Int -> [a] -> [[a]]
splitIntoNChunks :: forall a. Int -> [a] -> [[a]]
splitIntoNChunks Int
n [a]
xs =
  let (Int
q, Int
r) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
n
      qs :: [Int]
qs = forall a. Int -> a -> [a]
replicate Int
n Int
q
      rs :: [Int]
rs = forall a. Int -> a -> [a]
replicate Int
r Int
1 forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0
      chunkSizes :: [Int]
chunkSizes = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Int]
qs [Int]
rs
  in forall a. [Int] -> [a] -> [[a]]
makeChunksOfSizes [Int]
chunkSizes [a]
xs

makeChunksOfSizes :: [Int] -> [a] -> [[a]]
makeChunksOfSizes :: forall a. [Int] -> [a] -> [[a]]
makeChunksOfSizes [] [a]
_ = []
makeChunksOfSizes (Int
n:[Int]
ns) [a]
xs = 
  let ([a]
chunk, [a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
  in [a]
chunk forall a. a -> [a] -> [a]
: forall a. [Int] -> [a] -> [[a]]
makeChunksOfSizes [Int]
ns [a]
rest