module DeckHandling where
import Data.Random
import Lens.Micro.Platform
import States
import Types

doRandomization :: GlobalState -> [a] -> IO [a]
doRandomization :: GlobalState -> [a] -> IO [a]
doRandomization GlobalState
gs [a]
cards = 
  let n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cards in do
    [a]
cards' <- if GlobalState
gsGlobalState -> Getting Bool GlobalState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(Parameters -> Const Bool Parameters)
-> GlobalState -> Const Bool GlobalState
Lens' GlobalState Parameters
parameters((Parameters -> Const Bool Parameters)
 -> GlobalState -> Const Bool GlobalState)
-> ((Bool -> Const Bool Bool)
    -> Parameters -> Const Bool Parameters)
-> Getting Bool GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Parameters -> Const Bool Parameters
Lens' Parameters Bool
pShuffle then Gen RealWorld -> RVarT Identity [a] -> IO [a]
forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom (GlobalState
gsGlobalState
-> Getting (Gen RealWorld) GlobalState (Gen RealWorld)
-> Gen RealWorld
forall s a. s -> Getting a s a -> a
^.Getting (Gen RealWorld) GlobalState (Gen RealWorld)
Lens' GlobalState GenIO
mwc) (Int -> [a] -> RVarT Identity [a]
forall a. Int -> [a] -> RVar [a]
shuffleN Int
n [a]
cards) else [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
cards
    [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ [a] -> (Int -> [a]) -> Maybe Int -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
cards' (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
`take` [a]
cards') (GlobalState
gsGlobalState
-> Getting (Maybe Int) GlobalState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(Parameters -> Const (Maybe Int) Parameters)
-> GlobalState -> Const (Maybe Int) GlobalState
Lens' GlobalState Parameters
parameters((Parameters -> Const (Maybe Int) Parameters)
 -> GlobalState -> Const (Maybe Int) GlobalState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> Parameters -> Const (Maybe Int) Parameters)
-> Getting (Maybe Int) GlobalState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> Parameters -> Const (Maybe Int) Parameters
Lens' Parameters (Maybe Int)
pSubset)

doChunking :: Chunk -> [a] -> [a]
doChunking :: Chunk -> [a] -> [a]
doChunking (Chunk Int
i Int
n) [a]
cards = 
  Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
splitIntoNChunks Int
n [a]
cards [[a]] -> Int -> [a]
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall 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 :: Int -> [a] -> [[a]]
splitIntoNChunks Int
n [a]
xs =
  let (Int
q, Int
r) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
n
      qs :: [Int]
qs = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n Int
q
      rs :: [Int]
rs = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
r Int
1 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0
      chunkSizes :: [Int]
chunkSizes = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [Int]
qs [Int]
rs
  in [Int] -> [a] -> [[a]]
forall a. [Int] -> [a] -> [[a]]
makeChunksOfSizes [Int]
chunkSizes [a]
xs

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