Haskell Quiz/Fuzzy Time/Solution Dolio

module Main where
import Control.Arrow
import Control.Monad.Writer
import Control.Monad.State
import System
import System.Random
import MonadRandom
 
newtype Time = T (Int, Int) deriving (Eq)
newtype Fuzzy = F (Int, Int) deriving (Eq)
 
type FuzzyClock a = WriterT String (StateT (Time, Fuzzy) (Rand StdGen)) a
 
instance Show Time where
    show (T (h, m))
        | m < 10 = show h ++ ":0" ++ show m
        | otherwise = show h ++ ":" ++ show m
 
instance Read Time where
    readsPrec n s = do (h, c:s') <- readsPrec n s
                       guard (c == ':')
                       (m, s'') <- readsPrec n s'
                       return (time h m, s'')
 
instance Show Fuzzy where
    show (F (h, m)) = show h ++ ":" ++ show m ++ "-"
 
-- A safe constructor for time values
time :: Int -> Int -> Time
time hour min
    | hour < 1 || hour > 12 = error "Invalid hour."
    | min < 0  || min > 59  = error "Invalid minute."
    | otherwise             = T (hour, min)
 
-- Modifies a time value by adding n minutes (negative n tick backwards)
tickT :: Int -> Time -> Time
tickT n (T (hour, min)) = time h m
 where (d, m) = divMod (min + n) 60
       h = (hour + d - 1) `mod` 12 + 1
 
-- Modifies a fuzzy time value by adding 10n minutes (negative ...)
tickF :: Int -> Fuzzy -> Fuzzy
tickF n (F (hour, min)) = F (h, m)
 where (d, m) = divMod (min + n) 6
       h = (hour + d - 1) `mod` 12 + 1
 
-- Constructs a fuzzy time value from a regular time value
toFuzzy :: Time -> Fuzzy
toFuzzy (T (h, m)) = F (h, m `div` 10)
 
-- Given a time t, computes a random fuzzy time within a 10-minute range of t
fuzz :: MonadRandom m => Time -> m Fuzzy
fuzz t = do off <- getRandomR (-5, 5)
            return . toFuzzy $ tickT off t
 
-- Ticks off a minute on the fuzzy clock, reporting the current fuzzy time
tick :: FuzzyClock ()
tick = do (t, f) <- fmap (first $ tickT 1) get
          g <- fuzz t
          let h = if g == tickF (-1) f then f else g
          tell $ show t ++ "\t" ++ show h ++ "\n"
          put (t, h)
 
main = do [time, mins] <- getArgs
          let t = read time
              m = read mins
          f <- evalRandIO $ fuzz t
          l <- evalRandIO . flip evalStateT (t, f) 
                          . execWriterT $ replicateM_ m tick
          putStr l