content: {-# LANGUAGE TypeSynonymInstances #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE DefaultSignatures #-}
  
  module Enum where
  
  
  import GHC.Generics
  
  
  -----------------------------------------------------------------------------
  -- Utility functions for Enum'
  -----------------------------------------------------------------------------
  
  infixr 5 |||
  
  -- | Interleave elements from two lists. Similar to (++), but swap left and
  -- right arguments on every recursive application.
  --
  -- From Mark Jones' talk at AFP2008
  (|||) :: [a] -> [a] -> [a]
  []     ||| ys = ys
  (x:xs) ||| ys = x : ys ||| xs
  
  -- | Diagonalization of nested lists. Ensure that some elements from every
  -- sublist will be included. Handles infinite sublists.
  --
  -- From Mark Jones' talk at AFP2008
  diag :: [[a]] -> [a]
  diag = concat . foldr skew [] . map (map (\x -> [x]))
  
  skew :: [[a]] -> [[a]] -> [[a]]
  skew []     ys = ys
  skew (x:xs) ys = x : combine (++) xs ys
  
  combine :: (a -> a -> a) -> [a] -> [a] -> [a]
  combine _ xs     []     = xs
  combine _ []     ys     = ys
  combine f (x:xs) (y:ys) = f x y : combine f xs ys
  
  findIndex :: (a -> Bool) -> [a] -> Maybe Int
  findIndex p xs = let l = [ i | (y,i) <- zip xs [(0::Int)..], p y]
                   in if (null l)
                      then Nothing
                      else Just (head l)
  
  --------------------------------------------------------------------------------
  -- Generic enum
  --------------------------------------------------------------------------------
  
  class Enum' f where
    enum' :: [f a]
  
  instance Enum' U1 where
    enum' = [U1]
  
  instance (GEnum c) => Enum' (K1 i c) where
    enum' = map K1 genum
  
  instance (Enum' f) => Enum' (M1 i c f) where
    enum' = map M1 enum'
  
  instance (Enum' f, Enum' g) => Enum' (f :+: g) where
    enum' = map L1 enum' ||| map R1 enum'
  
  instance (Enum' f, Enum' g) => Enum' (f :*: g) where
    enum' = diag [ [ x :*: y | y <- enum' ] | x <- enum' ]
  
  instance (GEnum a) => GEnum (Maybe a)
  instance (GEnum a) => GEnum [a]
  
  
  genumDefault :: (Generic a, Enum' (Rep a)) => [a]
  genumDefault = map to enum'
  
  class GEnum a where
    genum :: [a]
  
    default genum :: (Generic a, Enum' (Rep a)) => [a]
    genum = genumDefault
  
  instance GEnum Int where
    genum = [0..] ||| (neg 0) where
      neg n = (n-1) : neg (n-1)
  