import System.Random


data Direction = Up | Down deriving (Eq)


main :: IO ()
main = do
  let layers = 4
      tries = 10000000

  rs <- (getStdGen >>= (\g -> return $ randomRs (1,10) g)) :: IO [Int]

  let through = main' rs layers tries 0
  putStrLn $ "Through: " ++ show ( fromIntegral through / fromIntegral tries )


main'                      :: (Integral a) => [a] -> a -> a -> a -> a
main' rs layers tries through
  | tries == 0 = through
  | otherwise =
       if (movePhoton rs layers $ (0, Down))
          then main' (tail rs) layers (tries - 1) (through + 1)
          else main' (tail rs) layers (tries - 1) through


movePhoton               :: (Integral a) => [a] -> a -> (a, Direction) -> Bool
movePhoton rs layers photon =
  let position   = fst photon
      direction  = snd photon
  in

    if head rs == 1 then -- reflection
         if position == 0 && direction == Down
            then False
         else
            if direction == Up
               then movePhoton (tail rs) layers (position + 1, Down)
               else movePhoton (tail rs) layers (position - 1, Up)

       else -- pass through
         if position == 0 && direction == Up
            then False
         else if position == layers - 1 && direction == Down
            then True
         else
            if direction == Up
               then movePhoton (tail rs) layers (position - 1, Up)
               else movePhoton (tail rs) layers (position + 1, Down)