-- | Transform lists of bounded enumerables into an index. A version for lists
-- of different sizes exists as well.

module Data.Ix.List where

import Control.Exception (assert)


-- | transform a list of bounded enumerables into an integer index. the first
-- character will be least significant, the last most significant

list2idx :: (Enum a, Bounded a) => [a] -> Int
list2idx xs = assert (not $ null xs) l2i 1 xs where
  l2i k [x]    = k * fromEnum x
  l2i k (x:xs) = k * fromEnum x + l2i (k * c) xs where
    c = fromEnum (maxBound `asTypeOf` x) - fromEnum (minBound `asTypeOf` x) + 1
{-# INLINE list2idx #-}

-- | Version for lists of different sizes.

listAll2idx :: (Enum a, Bounded a) => [a] -> Int
listAll2idx [] = 0
listAll2idx xs = l2i 1 xs where
  l2i k [x]    = k * (fromEnum x +1)
  l2i k (x:xs) = k * (fromEnum x +1) + l2i (k * c) xs where
    c = fromEnum (maxBound `asTypeOf` x) - fromEnum (minBound `asTypeOf` x) + 2
{-# INLINE listAll2idx #-}





-- | same as above, but now the list is bounded (hence _b_oundedlist) by the
-- user.

-- TODO maybe assert that (fromEnum x >= emin) && (fromEnum x <= emax)

blist2idx :: (Enum a, Bounded a) => (a,a) -> [a] -> Int
blist2idx (bmin,bmax) xs = assert (not $ null xs) $ l2i 1 xs where
  l2i k [x]    = k * (fromEnum x - emin)
  l2i k (x:xs) = k * (fromEnum x - emin) + l2i (k*c) xs where
    c = emax - emin + 1
  emin = fromEnum bmin
  emax = fromEnum bmax
{-# INLINE blist2idx #-}