夏ゼミ順番

gistfile1.hs

module Main where

import Control.Monad
import Data.Array.IO
import System.Random

type Name = String

-- 通常
participants :: [Name]
participants =
    [ "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    , "dummy"
    ]

-- 遅れる人、後のほうにしてほしい人
lateParticipants :: [Name]
lateParticipants = []

terms :: (Int, Int, Int)
terms = (4, 3, 5)

shuffle :: [a] -> IO [a]
shuffle xs = do
    arr <- newIOArray n xs
    forM [1..n] $ \i -> do
        j <- randomRIO (i, n)
        ei <- readArray arr i
        ej <- readArray arr j
        writeArray arr j ei
        return ej
  where
    n = length xs
    newIOArray :: Int -> [a] -> IO (IOArray Int a)
    newIOArray n' xs' = newListArray (1, n') xs'

splitToTerms :: [Name] -> ([Name], [Name], [Name])
splitToTerms l = (l1, l2, l3)
  where
    (n1, n2, _) = terms
    (l1, l1') = splitAt n1 l
    (l2, l3) = splitAt n2 l1'

calc :: IO ([Name], [Name], [Name])
calc = do
    l1 <- shuffle participants
    l2 <- shuffle lateParticipants
    return $ splitToTerms $ l1 ++ l2

printTerms :: ([Name], [Name], [Name]) -> IO ()
printTerms (l1, l2, l3) = do
    putStrLn "(敬称略)"
    putStrLn "[9/1 午後]"
    printWithIndex l1
    putStrLn "[9/2 午前]"
    printWithIndex l2
    putStrLn "[9/2 午後]"
    printWithIndex l3
  where
    printWithIndex l = do
        forM_ (zip [1..] l) $ \(i, n) -> do
            putStrLn $ show (i :: Int) ++ " " ++ n

main :: IO ()
main = do
    t <- calc
    printTerms t