```----------------------------------------------
-- |
-- Copyright : (c) Luke Palmer 2008
--
-- Maintainer : Luke Palmer <lrpalmer@gmail.com>
-- Stability : experimental
-- Portability : portable
--
--
-- It addresses the problem seen when trying to generate
-- the list of all pairs of naturals with
-- @[ (x,y) | x <- [0..], y <- [0..] ]@, which is broken
-- since the first element of every reachable pair will
-- be 0.
--
-- Using Omega this can be written
--
-- > pairs = runOmega \$ do
-- >     x <- each [0..]
-- >     y <- each [0..]
-- >     return (x,y)
--
-- More precisely, if @x@ appears at a finite index in
-- @xs@, and @y@ appears at a finite index in @f x@,
-- then @y@ will appear at a finite index in
-- @each xs >>= f@.
----------------------------------------------

(diagonal, Omega, runOmega, each)
where

import qualified Control.Applicative as Applicative
import qualified Data.Foldable as Foldable
import qualified Data.Traversable as Traversable

-- | This is the hinge algorithm of the Omega monad,
-- exposed because it can be useful on its own.  Joins
-- a list of lists with the property that for every x y
-- there is an n such that @xs !! x !! y == diagonal xs !! n@.
diagonal :: [[a]] -> [a]
diagonal = diagonal' 0
where
diagonal' _ [] = []
diagonal' n xss =
let (str, xss') = stripe n xss
in str ++ diagonal' (n+1) xss'

stripe 0 xss          = ([],xss)
stripe n []           = ([],[])
stripe n ([]:xss)     = stripe n xss
stripe n ((x:xs):xss) =
let (nstripe, nlists) = stripe (n-1) xss
in (x:nstripe, xs:nlists)

newtype Omega a = Omega { runOmega :: [a] }

each :: [a] -> Omega a
each = Omega

instance Functor Omega where
fmap f (Omega xs) = Omega (map f xs)

return x = Omega [x]
Omega m >>= f = Omega \$ diagonal \$ map (runOmega . f) m
fail _ = Omega []

instance Applicative.Applicative Omega where
pure = return