-- |
--   Module      :  Data.Edison.Seq.ListSeq
--   Copyright   :  Copyright (c) 1998 Chris Okasaki
--   License     :  MIT; see COPYRIGHT file for terms and conditions
--
--   Maintainer  :  robdockins AT fastmail DOT fm
--   Stability   :  stable
--   Portability :  GHC, Hugs (MPTC and FD)
--
--   This module packages the standard prelude list type as a
--   sequence.  This is the baseline sequence implementation and
--   all methods have the default running times listed in
--   "Data.Edison.Seq", except for the following two trivial operations:
--
--   * toList, fromList     @O( 1 )@
--
module Data.Edison.Seq.ListSeq (
    -- * Sequence Type
    Seq,

    -- * Sequence Operations
    empty,singleton,lcons,rcons,append,lview,lhead,lheadM,ltail,ltailM,
    rview,rhead,rheadM,rtail,rtailM,
    null,size,concat,reverse,reverseOnto,fromList,toList,map,concatMap,
    fold,fold',fold1,fold1',foldr,foldr',foldl,foldl',foldr1,foldr1',foldl1,foldl1',
    reducer,reducer',reducel,reducel',reduce1,reduce1',
    copy,inBounds,lookup,lookupM,lookupWithDefault,update,adjust,
    mapWithIndex,foldrWithIndex,foldrWithIndex',foldlWithIndex,foldlWithIndex',
    take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile,
    zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3,
    strict,strictWith,

    -- * Unit testing
    structuralInvariant,

    -- * Documentation
    moduleName
) where

import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1,
                       filter,takeWhile,dropWhile,lookup,take,drop,splitAt,
                       zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
import qualified Control.Monad.Identity as ID
import qualified Prelude
import Data.Edison.Prelude
import qualified Data.List
import Data.Monoid
import qualified Data.Edison.Seq as S ( Sequence(..) ) 

-- signatures for exported functions
moduleName     :: String
empty          :: [a]
singleton      :: a -> [a]
lcons          :: a -> [a] -> [a]
rcons          :: a -> [a] -> [a]
append         :: [a] -> [a] -> [a]
lview          :: (Monad rm) => [a] -> rm (a, [a])
lhead          :: [a] -> a
lheadM         :: (Monad rm) => [a] -> rm a
ltail          :: [a] -> [a]
ltailM         :: (Monad rm) => [a] -> rm [a]
rview          :: (Monad rm) => [a] -> rm (a, [a])
rhead          :: [a] -> a
rheadM         :: (Monad rm) => [a] -> rm a
rtail          :: [a] -> [a]
rtailM         :: (Monad rm) => [a] -> rm [a]
null           :: [a] -> Bool
size           :: [a] -> Int
concat         :: [[a]] -> [a]
reverse        :: [a] -> [a]
reverseOnto    :: [a] -> [a] -> [a]
fromList       :: [a] -> [a]
toList         :: [a] -> [a]
map            :: (a -> b) -> [a] -> [b]
concatMap      :: (a -> [b]) -> [a] -> [b]
fold           :: (a -> b -> b) -> b -> [a] -> b
fold'          :: (a -> b -> b) -> b -> [a] -> b
fold1          :: (a -> a -> a) -> [a] -> a
fold1'         :: (a -> a -> a) -> [a] -> a
foldr          :: (a -> b -> b) -> b -> [a] -> b
foldl          :: (b -> a -> b) -> b -> [a] -> b
foldr1         :: (a -> a -> a) -> [a] -> a
foldl1         :: (a -> a -> a) -> [a] -> a
reducer        :: (a -> a -> a) -> a -> [a] -> a
reducel        :: (a -> a -> a) -> a -> [a] -> a
reduce1        :: (a -> a -> a) -> [a] -> a
foldl'         :: (b -> a -> b) -> b -> [a] -> b
foldl1'        :: (a -> a -> a) -> [a] -> a
reducer'       :: (a -> a -> a) -> a -> [a] -> a
reducel'       :: (a -> a -> a) -> a -> [a] -> a
reduce1'       :: (a -> a -> a) -> [a] -> a
copy           :: Int -> a -> [a]
inBounds       :: Int -> [a] -> Bool
lookup         :: Int -> [a] -> a
lookupM        :: (Monad m) => Int -> [a] -> m a
lookupWithDefault :: a -> Int -> [a] -> a
update         :: Int -> a -> [a] -> [a]
adjust         :: (a -> a) -> Int -> [a] -> [a]
mapWithIndex   :: (Int -> a -> b) -> [a] -> [b]
foldrWithIndex :: (Int -> a -> b -> b) -> b -> [a] -> b
foldlWithIndex :: (b -> Int -> a -> b) -> b -> [a] -> b
foldlWithIndex' :: (b -> Int -> a -> b) -> b -> [a] -> b
take           :: Int -> [a] -> [a]
drop           :: Int -> [a] -> [a]
splitAt        :: Int -> [a] -> ([a], [a])
subseq         :: Int -> Int -> [a] -> [a]
filter         :: (a -> Bool) -> [a] -> [a]
partition      :: (a -> Bool) -> [a] -> ([a], [a])
takeWhile      :: (a -> Bool) -> [a] -> [a]
dropWhile      :: (a -> Bool) -> [a] -> [a]
splitWhile     :: (a -> Bool) -> [a] -> ([a], [a])
zip            :: [a] -> [b] -> [(a,b)]
zip3           :: [a] -> [b] -> [c] -> [(a,b,c)]
zipWith        :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith3       :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
unzip          :: [(a,b)] -> ([a], [b])
unzip3         :: [(a,b,c)] -> ([a], [b], [c])
unzipWith      :: (a -> b) -> (a -> c) -> [a] -> ([b], [c])
unzipWith3     :: (a -> b) -> (a -> c) -> (a -> d) -> [a] -> ([b], [c], [d])
strict         :: [a] -> [a]
strictWith     :: (a -> b) -> [a] -> [a]
structuralInvariant :: [a] -> Bool

moduleName = "Data.Edison.Seq.ListSeq"

type Seq a = [a]

empty = []
singleton x = [x]
lcons = (:)
rcons x s = s ++ [x]
append = (++)

lview [] = fail "ListSeq.lview: empty sequence"
lview (x:xs) = return (x, xs)

lheadM [] = fail "ListSeq.lheadM: empty sequence"
lheadM (x:xs) = return x

lhead [] = error "ListSeq.lhead: empty sequence"
lhead (x:xs) = x

ltailM [] = fail "ListSeq.ltailM: empty sequence"
ltailM (x:xs) = return xs

ltail [] = error "ListSeq.ltail: empty sequence"
ltail (x:xs) = xs

rview [] = fail "ListSeq.rview: empty sequence"
rview xs = return (rhead xs, rtail xs)

rheadM [] = fail "ListSeq.rheadM: empty sequence"
rheadM (x:xs) = rh x xs
  where rh y [] = return y
        rh y (x:xs) = rh x xs

rhead [] = error "ListSeq.rhead: empty sequence"
rhead (x:xs) = rh x xs
  where rh y [] = y
        rh y (x:xs) = rh x xs

rtailM [] = fail "ListSeq.rtailM: empty sequence"
rtailM (x:xs) = return (rt x xs)
  where rt y [] = []
        rt y (x:xs) = y : rt x xs

rtail [] = error "ListSeq.rtail: empty sequence"
rtail (x:xs) = rt x xs
  where rt y [] = []
        rt y (x:xs) = y : rt x xs

null = Prelude.null
size = length
concat = foldr append empty
reverse = Prelude.reverse

reverseOnto [] ys = ys
reverseOnto (x:xs) ys = reverseOnto xs (x:ys)

fromList xs = xs
toList xs = xs
map = Data.List.map

concatMap = Data.List.concatMap

fold  = foldr
fold' f = foldl' (flip f)

fold1 f []      = error "ListSeq.fold1: empty sequence"
fold1 f (x:xs)  = foldr f x xs

fold1' f []     = error "ListSeq.fold1': empty sequence"
fold1' f (x:xs) = foldl' f x xs

foldr = Data.List.foldr
foldl = Data.List.foldl

foldr' f e [] = e
foldr' f e (x:xs) = f x $! foldr' f e xs

foldl' f e [] = e
foldl' f e (x:xs) = e `seq` foldl' f (f e x) xs

foldr1 f [] = error "ListSeq.foldr1: empty sequence"
foldr1 f xs = fr xs
  where fr [x]    = x
        fr (x:xs) = f x $ fr xs
        fr _ = error "ListSeq.foldr1: bug!"

foldr1' f [] = error "ListSeq.foldr1': empty sequence"
foldr1' f xs = fr xs
  where fr [x]    = x
        fr (x:xs) = f x $! fr xs
        fr _  = error "ListSeq.foldr1': bug!"

foldl1 f [] = error "ListSeq.foldl1: empty sequence"
foldl1 f (x:xs) = foldl f x xs

foldl1' f [] = error "ListSeq.foldl1': empty sequence"
foldl1' f (x:xs) = foldl' f x xs

reducer f e [] = e
reducer f e xs = f (reduce1 f xs) e

reducer' f e [] = e
reducer' f e xs = (f $! (reduce1' f xs)) $! e

reducel f e [] = e
reducel f e xs = f e (reduce1 f xs)

reducel' f e [] = e
reducel' f e xs = (f $! e) $! (reduce1' f xs)

reduce1 f [] = error "ListSeq.reduce1: empty sequence"
reduce1 f [x] = x
reduce1 f (x1 : x2 : xs) = reduce1 f (f x1 x2 : pairup xs)
  where pairup (x1 : x2 : xs) = f x1 x2 : pairup xs
        pairup xs = xs
  -- can be improved using a counter and bit ops!

reduce1' f [] = error "ListSeq.reduce1': empty sequence"
reduce1' f [x] = x
reduce1' f (x1 : x2 : xs) = x1 `seq` x2 `seq` reduce1' f (f x1 x2 : pairup xs)
  where pairup (x1 : x2 : xs) = x1 `seq` x2 `seq` (f x1 x2 : pairup xs)
        pairup xs = xs

copy n x | n <= 0 = []
         | otherwise = x : copy (n-1) x
  -- depends on n to be unboxed, should test this!

inBounds i xs
  | i >= 0    = not (null (drop i xs))
  | otherwise = False

lookup i xs = ID.runIdentity (lookupM i xs)

lookupM i xs
  | i < 0 = fail "ListSeq.lookup: not found"
  | otherwise = case drop i xs of
                  [] -> fail "ListSeq.lookup: not found"
                  (x:_) -> return x

lookupWithDefault d i xs
  | i < 0 = d
  | otherwise = case drop i xs of
                  [] -> d
                  (x:_) -> x

update i y xs 
    | i < 0     = xs
    | otherwise = upd i xs
  where upd _ [] = []
        upd i (x:xs)
          | i > 0     = x : upd (i - 1) xs
          | otherwise = y : xs

adjust f i xs 
    | i < 0     = xs
    | otherwise = adj i xs
  where adj _ [] = []
        adj i (x:xs)
          | i > 0     = x : adj (i - 1) xs
          | otherwise = f x : xs

mapWithIndex f = mapi 0
  where mapi i [] = []
        mapi i (x:xs) = f i x : mapi (succ i) xs

foldrWithIndex f e = foldi 0
  where foldi i [] = e
        foldi i (x:xs) = f i x (foldi (succ i) xs)

foldrWithIndex' f e = foldi 0
  where foldi i [] = e
        foldi i (x:xs) = f i x $! (foldi (succ i) xs)

foldlWithIndex f = foldi 0
  where foldi i e [] = e
        foldi i e (x:xs) = foldi (succ i) (f e i x) xs

foldlWithIndex' f = foldi 0
  where foldi i e [] = e
        foldi i e (x:xs) = e `seq` foldi (succ i) (f e i x) xs


take i xs | i <= 0 = []
          | otherwise = Data.List.take i xs

drop i xs | i <= 0 = xs
          | otherwise = Data.List.drop i xs

splitAt i xs | i <= 0 = ([], xs)
             | otherwise = Data.List.splitAt i xs

subseq i len xs = take len (drop i xs)
        
strict l@[] = l
strict l@(_:xs) = strict xs `seq` l

strictWith f l@[] = l
strictWith f l@(x:xs) = f x `seq` strictWith f xs `seq` l

filter = Data.List.filter
partition = Data.List.partition
takeWhile = Data.List.takeWhile
dropWhile = Data.List.dropWhile
splitWhile = Data.List.span

zip = Data.List.zip
zip3 = Data.List.zip3
zipWith = Data.List.zipWith
zipWith3 = Data.List.zipWith3
unzip = Data.List.unzip
unzip3 = Data.List.unzip3

unzipWith f g = foldr consfg ([], [])
  where consfg a (bs, cs) = (f a : bs, g a : cs)
  -- could put ~ on tuple

unzipWith3 f g h = foldr consfgh ([], [], [])
  where consfgh a (bs, cs, ds) = (f a : bs, g a : cs, h a : ds)
  -- could put ~ on tuple

-- no invariants
structuralInvariant = const True

-- declare the instance

instance S.Sequence [] where
  {lcons = lcons; rcons = rcons; null = null;
   lview = lview; lhead = lhead; ltail = ltail;
   lheadM = lheadM; ltailM = ltailM;
   rview = rview; rhead = rhead; rtail = rtail;
   rheadM = rheadM; rtailM = rtailM;
   size = size; concat = concat; reverse = reverse;
   reverseOnto = reverseOnto; fromList = fromList; toList = toList;
   fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';
   foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';
   foldr1 = foldr1; foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1';
   reducer = reducer; reducel = reducel; reduce1 = reduce1;
   reducel' = reducel'; reducer' = reducer'; reduce1' = reduce1';
   copy = copy; inBounds = inBounds; lookup = lookup;
   lookupM = lookupM; lookupWithDefault = lookupWithDefault;
   update = update; adjust = adjust; mapWithIndex = mapWithIndex; 
   foldrWithIndex = foldrWithIndex; foldrWithIndex' = foldrWithIndex';
   foldlWithIndex = foldlWithIndex; foldlWithIndex' = foldlWithIndex';
   take = take; drop = drop; splitAt = splitAt; subseq = subseq;
   filter = filter; partition = partition; takeWhile = takeWhile;
   dropWhile = dropWhile; splitWhile = splitWhile; zip = zip;
   zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;
   unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;
   strict = strict; strictWith = strictWith;
   structuralInvariant = structuralInvariant; instanceName s = moduleName}