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 :: Double )


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 []     _      _                     = True
movePhoton (r:rs) layers (position, direction)
  | r == 1 && position == 0          && direction == Down = False
  | r /= 1 && position == 0          && direction == Up   = False
  | r /= 1 && position == layers - 1 && direction == Down = True

  -- reflection
  | r == 1 = if direction == Up
                     then movePhoton rs layers (position + 1, Down)
                     else movePhoton rs layers (position - 1, Up)
  -- pass through
  | otherwise = if direction == Up
                   then movePhoton rs layers (position - 1, Up)
                   else movePhoton rs layers (position + 1, Down)