Robot.hs

module Robot (Robot, robotName, mkRobot, resetName) where
import Control.Concurrent.MVar (MVar, newEmptyMVar, tryTakeMVar, putMVar)
import System.Random (StdGen, getStdRandom, randomR)
import Data.Maybe (fromMaybe)
import Control.Applicative ((<$>))
import Control.Arrow (first)
import Control.Monad (void)

type Name = String
newtype Robot = Robot (MVar Name)

mkRobot :: IO Robot
mkRobot = Robot <$> newEmptyMVar

resetName :: Robot -> IO ()
resetName (Robot nameMVar) = void $ tryTakeMVar nameMVar

robotName :: Robot -> IO Name
robotName (Robot nameMVar) = do
    maybeName <- tryTakeMVar nameMVar
    case maybeName of
        Just name -> return name  -- leaves nameMVar empty
        Nothing   -> do
            name <- generateName
            putMVar nameMVar name
            return name

generateName :: IO Name
generateName = getStdRandom randomName

randomName :: StdGen -> (Name, StdGen)
randomName = randomChooses pattern where
    pattern = [letter, letter, digit, digit, digit]
    letter  = ['A' .. 'Z']
    digit   = ['0' .. '9']

randomChooses :: [[a]] -> StdGen -> ([a], StdGen)
randomChooses xss gen = foldr go ([], gen) xss where
    go xs (rest, g) = first (: rest) $ randomChoose xs g

randomChoose :: [a] -> StdGen -> (a, StdGen)
randomChoose xs = first (xs !!) . randomR (0, length xs - 1)