{-# LANGUAGE TypeOperators #-}
import Data.List
import Data.Pseudo (Pseudo, (:->),randomDelayList,merger,probe,embedPseudo)
data Colleague = Elf Int
| Reindeer Int deriving (Eq,Show)
elf :: Int -> [Colleague] -> [Colleague]
elf n (x:xs) = case x of
Elf m | n == m -> randomDelayList (Elf n: elf n xs)
_ -> elf n xs
reindeer :: Int -> [Colleague] -> [Colleague]
reindeer n (x:xs) = case x of
Reindeer m | n == m -> randomDelayList (Reindeer n: reindeer n xs)
_ -> reindeer n xs
colleagues :: [Colleague] -> ([Colleague] :-> [Colleague])
colleagues rrs@(r:rs)
= merger $ [elf i rrs | i <- [1..10]] ++ [reindeer i rrs| i<-[1..9]]
santa :: [Colleague] -> ([[Colleague]] :-> [Colleague])
santa cs@(_:_) = case partition isElf cs of
(es,rs) -> concat . map (probe task) . merger [waiting 3 es, waiting 9 rs]
where
isElf (Elf _) = True
isElf _ = False
waiting :: Int -> [Colleague] -> [[Colleague]]
waiting = splits
task :: [Colleague] -> String
task cs = concat $ intersperse "\n" $ (greeting ++ msg (head cs)) : map show cs
where
greeting = "----------\nHo! Ho! Ho! let's "
msg (Elf _) = "meet in my study"
msg _ = "deliver toys"
ini :: [Colleague]
ini = [Elf i | i <- [1..10]] ++ [Reindeer i | i <- [1..9]]
company :: ([Colleague] -> ([[Colleague]] :-> [Colleague]))
-> ([Colleague] -> ([Colleague] :-> [Colleague]))
-> (([[Colleague]],[Colleague]) :-> ([Colleague],[Colleague]))
company santa colleagues oracles
= case embedPseudo oracles of
(css,cs) -> (comings, returnings)
where
returnings = santa comings css
comings = colleagues (ini++returnings) cs
pmain :: ([[Colleague]],[Colleague]) :-> ([Colleague],[Colleague])
pmain = company santa colleagues
main :: IO ()
main = mapM_ return $ snd $ pmain oracle
oracle :: Pseudo ([[Colleague]],[Colleague])
oracle = undefined
splits :: Int -> [a] -> [[a]]
splits n = unfoldr phi
where
phi [] = Nothing
phi xs = Just $ splitAt n xs