content: -- |
  --   Module      :  Data.Edison.Seq.Defaults
  --   Copyright   :  Copyright (c) 1998, 2008 Chris Okasaki
  --   License     :  MIT; see COPYRIGHT file for terms and conditions
  --
  --   Maintainer  :  robdockins AT fastmail DOT fm
  --   Stability   :  internal (unstable)
  --   Portability :  GHC, Hugs (MPTC and FD)
  --
  --   This module provides default implementations of many of
  --   the sequence operations.  It is used to fill in implementations
  --   and is not intended for end users.
  
  module Data.Edison.Seq.Defaults where
  
  import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1,foldl',
                         filter,takeWhile,dropWhile,lookup,take,drop,splitAt,
                         zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
  
  import qualified Control.Monad.Fail as Fail
  import Control.Monad
  import Data.Char (isSpace)
  
  import Data.Edison.Prelude ( runFail_ )
  import Data.Edison.Seq
  import qualified Data.Edison.Seq.ListSeq as L
  
  rconsUsingAppend :: Sequence s => a -> s a -> s a
  rconsUsingAppend x s = append s (singleton x)
  
  rconsUsingFoldr :: Sequence s => a -> s a -> s a
  rconsUsingFoldr x s = foldr lcons (singleton x) s
  
  appendUsingFoldr :: Sequence s => s a -> s a -> s a
  appendUsingFoldr s t | null t = s
                              | otherwise = foldr lcons t s
  
  rviewDefault :: (Fail.MonadFail m, Sequence s) => s a -> m (a, s a)
  rviewDefault xs
    | null xs   = fail $ instanceName xs ++ ".rview: empty sequence"
    | otherwise = return (rhead xs, rtail xs)
  
  
  rtailUsingLview :: (Sequence s) => s a -> s a
  rtailUsingLview xs =
      case lview xs of
        Nothing      -> error $ instanceName xs ++ ".rtail: empty sequence"
        Just (x, xs) -> rt x xs
    where rt x xs =
            case lview xs of
              Nothing      -> empty
              Just (y, ys) -> lcons x (rt y ys)
  
  rtailMUsingLview :: (Fail.MonadFail m, Sequence s) => s a -> m (s a)
  rtailMUsingLview xs =
      case lview xs of
        Nothing      -> fail $ instanceName xs ++ ".rtailM: empty sequence"
        Just (x, xs) -> return (rt x xs)
    where rt x xs =
            case lview xs of
              Nothing      -> empty
              Just (y, ys) -> lcons x (rt y ys)
  
  
  
  concatUsingFoldr :: Sequence s => s (s a) -> s a
  concatUsingFoldr = foldr append empty
  
  reverseUsingReverseOnto :: Sequence s => s a -> s a
  reverseUsingReverseOnto s = reverseOnto s empty
  
  reverseUsingLists :: Sequence s => s a -> s a
  reverseUsingLists = fromList . L.reverse . toList
  
  reverseOntoUsingFoldl :: Sequence s => s a -> s a -> s a
  reverseOntoUsingFoldl xs ys = foldl (flip lcons) ys xs
  
  reverseOntoUsingReverse :: Sequence s => s a -> s a -> s a
  reverseOntoUsingReverse = append . reverse
  
  fromListUsingCons :: Sequence s => [a] -> s a
  fromListUsingCons = L.foldr lcons empty
  
  toListUsingFoldr :: Sequence s => s a -> [a]
  toListUsingFoldr = foldr (:) []
  
  mapUsingFoldr :: Sequence s => (a -> b) -> s a -> s b
  mapUsingFoldr f = foldr (lcons . f) empty
  
  concatMapUsingFoldr :: Sequence s => (a -> s b) -> s a -> s b
  concatMapUsingFoldr f = foldr (append . f) empty
  
  foldrUsingLists :: Sequence s => (a -> b -> b) -> b -> s a -> b
  foldrUsingLists f e xs = L.foldr f e (toList xs)
  
  foldr'UsingLists :: Sequence s => (a -> b -> b) -> b -> s a -> b
  foldr'UsingLists f e xs = L.foldr' f e (toList xs)
  
  foldlUsingLists :: Sequence s => (b -> a -> b) -> b -> s a -> b
  foldlUsingLists f e xs = L.foldl f e (toList xs)
  
  foldl'UsingLists :: Sequence s => (b -> a -> b) -> b -> s a -> b
  foldl'UsingLists f e xs = L.foldl' f e (toList xs)
  
  foldr1UsingLists :: Sequence s => (a -> a -> a) -> s a -> a
  foldr1UsingLists f xs = L.foldr1 f (toList xs)
  
  foldr1'UsingLists :: Sequence s => (a -> a -> a) -> s a -> a
  foldr1'UsingLists f xs = L.foldr1' f (toList xs)
  
  foldl1UsingLists :: Sequence s => (a -> a -> a) -> s a -> a
  foldl1UsingLists f xs = L.foldl1 f (toList xs)
  
  foldl1'UsingLists :: Sequence s => (a -> a -> a) -> s a -> a
  foldl1'UsingLists f xs = L.foldl1' f (toList xs)
  
  fold1UsingFold :: Sequence s => (a -> a -> a) -> s a -> a
  fold1UsingFold f xs =
      case lview xs of
        Nothing      -> error $ instanceName xs ++ ".fold1: empty sequence"
        Just (x, xs) -> fold f x xs
  
  fold1'UsingFold' :: Sequence s => (a -> a -> a) -> s a -> a
  fold1'UsingFold' f xs =
      case lview xs of
        Nothing      -> error $ instanceName xs ++ ".fold1': empty sequence"
        Just (x, xs) -> fold' f x xs
  
  foldr1UsingLview :: Sequence s => (a -> a -> a) -> s a -> a
  foldr1UsingLview f xs =
      case lview xs of
        Nothing      -> error $ instanceName xs ++ ".foldr1: empty sequence"
        Just (x, xs) -> fr1 x xs
    where fr1 x xs =
            case lview xs of
              Nothing     -> x
              Just (y,ys) -> f x (fr1 y ys)
  
  foldr1'UsingLview :: Sequence s => (a -> a -> a) -> s a -> a
  foldr1'UsingLview f xs =
       case lview xs of
          Nothing     -> error $ instanceName xs ++ ".foldr1': empty sequence"
          Just (x,xs) -> fr1 x xs
    where fr1 x xs =
            case lview xs of
               Nothing     -> x
               Just (y,ys) -> f x $! (fr1 y ys)
  
  foldl1UsingFoldl :: Sequence s => (a -> a -> a) -> s a -> a
  foldl1UsingFoldl f xs =
      case lview xs of
        Nothing     -> error $ instanceName xs ++ ".foldl1: empty sequence"
        Just (x,xs) -> foldl f x xs
  
  foldl1'UsingFoldl' :: Sequence s => (a -> a -> a) -> s a -> a
  foldl1'UsingFoldl' f xs =
      case lview xs of
        Nothing     -> error $ instanceName xs ++ ".foldl1': empty sequence"
        Just (x,xs) -> foldl' f x xs
  
  reducerUsingReduce1 :: Sequence s => (a -> a -> a) -> a -> s a -> a
  reducerUsingReduce1 f e s
    | null s = e
    | otherwise = f (reduce1 f s) e
  
  reducer'UsingReduce1' :: Sequence s => (a -> a -> a) -> a -> s a -> a
  reducer'UsingReduce1' f e s
    | null s = e
    | otherwise = f (reduce1' f s) e
  
  reducelUsingReduce1 :: Sequence s => (a -> a -> a) -> a -> s a -> a
  reducelUsingReduce1 f e s
    | null s = e
    | otherwise = f e (reduce1 f s)
  
  reducel'UsingReduce1' :: Sequence s => (a -> a -> a) -> a -> s a -> a
  reducel'UsingReduce1' f e s
    | null s = e
    | otherwise = f e (reduce1' f s)
  
  reduce1UsingLists :: Sequence s => (a -> a -> a) -> s a -> a
  reduce1UsingLists f s = L.reduce1 f (toList s)
  
  reduce1'UsingLists :: Sequence s => (a -> a -> a) -> s a -> a
  reduce1'UsingLists f s = L.reduce1' f (toList s)
  
  copyUsingLists :: Sequence s => Int -> a -> s a
  copyUsingLists n x = fromList (L.copy n x)
  
  
  inBoundsUsingDrop :: Sequence s => Int -> s a -> Bool
  inBoundsUsingDrop i s =
    i >= 0 && not (null (drop i s))
  
  inBoundsUsingLookupM :: Sequence s => Int -> s a -> Bool
  inBoundsUsingLookupM i s =
    case lookupM i s of
      Just _  -> True
      Nothing -> False
  
  inBoundsUsingSize :: Sequence s => Int -> s a -> Bool
  inBoundsUsingSize i s = i >= 0 && i < size s
  
  lookupUsingLookupM :: Sequence s => Int -> s a -> a
  lookupUsingLookupM i s = runFail_ (lookupM i s)
  
  lookupUsingDrop :: Sequence s => Int -> s a -> a
  lookupUsingDrop i s
    | i < 0 || null s' = error $ instanceName s ++ ".lookup: bad subscript"
    | otherwise = lhead s'
    where s' = drop i s
  
  lookupWithDefaultUsingLookupM :: Sequence s => a -> Int -> s a -> a
  lookupWithDefaultUsingLookupM d i s =
    case lookupM i s of
      Nothing -> d
      Just x  -> x
  
  lookupWithDefaultUsingDrop :: Sequence s => a -> Int -> s a -> a
  lookupWithDefaultUsingDrop d i s
    | i < 0 || null s' = d
    | otherwise = lhead s'
    where s' = drop i s
  
  lookupMUsingDrop :: (Fail.MonadFail m, Sequence s) => Int -> s a -> m a
  lookupMUsingDrop i s
    -- XXX better error message!
    | i < 0 || null s' = fail $ instanceName s
                          ++ ".lookupMUsingDrop: empty sequence"
    | otherwise        = return (lhead s')
    where s' = drop i s
  
  filterUsingLview :: Sequence s => (a -> Bool) -> s a -> s a
  filterUsingLview p xs =
    case lview xs of
      Nothing     -> empty
      Just (x,xs) -> if p x then lcons x (filter p xs) else filter p xs
  
  filterUsingLists :: Sequence s => (a -> Bool) -> s a -> s a
  filterUsingLists p xs =
    fromList (L.filter p (toList xs))
  
  filterUsingFoldr :: Sequence s => (a -> Bool) -> s a -> s a
  filterUsingFoldr p = foldr pcons empty
    where pcons x xs = if p x then lcons x xs else xs
  
  partitionUsingLists :: Sequence s => (a -> Bool) -> s a -> (s a, s a)
  partitionUsingLists p xs =
    let (ys,zs) = L.partition p (toList xs)
    in (fromList ys, fromList zs)
  
  partitionUsingFoldr :: Sequence s => (a -> Bool) -> s a -> (s a, s a)
  partitionUsingFoldr p = foldr pcons (empty, empty)
    where pcons x (xs, xs') = if p x then (lcons x xs, xs') else (xs, lcons x xs')
  
  updateUsingAdjust :: Sequence s => Int -> a -> s a -> s a
  updateUsingAdjust i y = adjust (const y) i
  
  updateUsingSplitAt :: Sequence s => Int -> a -> s a -> s a
  updateUsingSplitAt i x xs
    | i < 0 = xs
    | otherwise = let (ys,zs) = splitAt i xs
                  in if null zs then xs else append ys (lcons x (ltail zs))
  
  adjustUsingLists :: Sequence s => (a -> a) -> Int -> s a -> s a
  adjustUsingLists f i xs = fromList (L.adjust f i (toList xs))
  
  adjustUsingSplitAt :: Sequence s => (a -> a) -> Int -> s a -> s a
  adjustUsingSplitAt f i xs
    | i < 0 = xs
    | otherwise = let (ys,zs) = splitAt i xs
                  in case lview zs of
                       Nothing      -> xs
                       Just (z,zs') -> append ys (lcons (f z) zs')
  
  {-
  insertAtUsingLists :: Sequence s => Int -> a -> s a -> s a
  insertAtUsingLists i x xs =
    fromList (L.insertAt i x (toList xs))
  
  insertAtUsingSplitAt :: Sequence s => Int -> a -> s a -> s a
  insertAtUsingSplitAt i x xs
    | (xs_before, xs_after) <- splitAt i xs =
        append xs_before (lcons x xs_after)
  
  deleteAtUsingLists :: Sequence s => Int -> s a -> s a
  deleteAtUsingLists i xs = fromList (L.deleteAt i (toList xs))
  
  deleteAtUsingSplitAt :: Sequence s => Int -> s a -> s a
  deleteAtUsingSplitAt i xs
    | (xs_before, xs_after) <- splitAt i xs =
        append xs_before (ltail xs_after)
  -}
  
  mapWithIndexUsingLists :: Sequence s => (Int -> a -> b) -> s a -> s b
  mapWithIndexUsingLists f xs = fromList (L.mapWithIndex f (toList xs))
  
  foldrWithIndexUsingLists ::
    Sequence s => (Int -> a -> b -> b) -> b -> s a -> b
  foldrWithIndexUsingLists f e xs = L.foldrWithIndex f e (toList xs)
  
  foldrWithIndex'UsingLists ::
    Sequence s => (Int -> a -> b -> b) -> b -> s a -> b
  foldrWithIndex'UsingLists f e xs = L.foldrWithIndex' f e (toList xs)
  
  foldlWithIndexUsingLists ::
    Sequence s => (b -> Int -> a -> b) -> b -> s a -> b
  foldlWithIndexUsingLists f e xs = L.foldlWithIndex f e (toList xs)
  
  foldlWithIndex'UsingLists ::
    Sequence s => (b -> Int -> a -> b) -> b -> s a -> b
  foldlWithIndex'UsingLists f e xs = L.foldlWithIndex' f e (toList xs)
  
  takeUsingLists :: Sequence s => Int -> s a -> s a
  takeUsingLists i s = fromList (L.take i (toList s))
  
  takeUsingLview :: Sequence s => Int -> s a -> s a
  takeUsingLview i xs
    | i <= 0 = empty
    | otherwise = case lview xs of
                    Nothing -> empty
                    Just (x,xs') -> lcons x (take (i-1) xs')
  
  dropUsingLists :: Sequence s => Int -> s a -> s a
  dropUsingLists i s = fromList (L.drop i (toList s))
  
  dropUsingLtail :: Sequence s => Int -> s a -> s a
  dropUsingLtail i xs
    | i <= 0 || null xs = xs
    | otherwise = dropUsingLtail (i-1) (ltail xs)
  
  splitAtDefault :: Sequence s => Int -> s a -> (s a, s a)
  splitAtDefault i s = (take i s, drop i s)
  
  splitAtUsingLview :: Sequence s => Int -> s a -> (s a, s a)
  splitAtUsingLview i xs
    | i <= 0 = (empty,xs)
    | otherwise = case lview xs of
                    Nothing      -> (empty,empty)
                    Just (x,xs') -> (lcons x ys,zs)
                      where (ys,zs) = splitAtUsingLview (i-1) xs'
  
  subseqDefault :: Sequence s => Int -> Int -> s a -> s a
  subseqDefault i len xs = take len (drop i xs)
  
  takeWhileUsingLview :: Sequence s => (a -> Bool) -> s a -> s a
  takeWhileUsingLview p xs =
    case lview xs of
      Just (x,xs') | p x -> lcons x (takeWhileUsingLview p xs')
      _                  -> empty
  
  dropWhileUsingLview :: Sequence s => (a -> Bool) -> s a -> s a
  dropWhileUsingLview p xs =
    case lview xs of
      Just (x,xs') | p x -> dropWhileUsingLview p xs'
      _                  -> xs
  
  splitWhileUsingLview :: Sequence s => (a -> Bool) -> s a -> (s a, s a)
  splitWhileUsingLview p xs =
    case lview xs of
      Just (x,xs') | p x -> let (front, back) = splitWhileUsingLview p xs'
                            in (lcons x front, back)
      _                  -> (empty, xs)
  
  zipUsingLview :: Sequence s => s a -> s b -> s (a,b)
  zipUsingLview xs ys =
    case lview xs of
      Nothing -> empty
      Just (x,xs') ->
        case lview ys of
          Nothing -> empty
          Just (y,ys') -> lcons (x,y) (zipUsingLview xs' ys')
  
  zip3UsingLview :: Sequence s => s a -> s b -> s c -> s (a,b,c)
  zip3UsingLview xs ys zs =
    case lview xs of
      Nothing -> empty
      Just (x,xs') ->
        case lview ys of
          Nothing -> empty
          Just (y,ys') ->
            case lview zs of
              Nothing -> empty
              Just (z,zs') -> lcons (x,y,z) (zip3UsingLview xs' ys' zs')
  
  zipWithUsingLview :: Sequence s => (a -> b -> c) -> s a -> s b -> s c
  zipWithUsingLview f xs ys =
    case lview xs of
      Nothing -> empty
      Just (x,xs') ->
        case lview ys of
          Nothing -> empty
          Just (y,ys') -> lcons (f x y) (zipWithUsingLview f xs' ys')
  
  zipWith3UsingLview ::
    Sequence s => (a -> b -> c -> d) -> s a -> s b -> s c -> s d
  zipWith3UsingLview f xs ys zs =
    case lview xs of
      Nothing -> empty
      Just (x,xs') ->
        case lview ys of
          Nothing -> empty
          Just (y,ys') ->
            case lview zs of
              Nothing -> empty
              Just (z,zs') -> lcons (f x y z) (zipWith3UsingLview f xs' ys' zs')
  
  zipUsingLists :: Sequence s => s a -> s b -> s (a,b)
  zipUsingLists xs ys = fromList (L.zip (toList xs) (toList ys))
  
  zip3UsingLists :: Sequence s => s a -> s b -> s c -> s (a,b,c)
  zip3UsingLists xs ys zs =
    fromList (L.zip3 (toList xs) (toList ys) (toList zs))
  
  zipWithUsingLists :: Sequence s => (a -> b -> c) -> s a -> s b -> s c
  zipWithUsingLists f xs ys =
    fromList (L.zipWith f (toList xs) (toList ys))
  
  zipWith3UsingLists ::
    Sequence s => (a -> b -> c -> d) -> s a -> s b -> s c -> s d
  zipWith3UsingLists f xs ys zs =
    fromList (L.zipWith3 f (toList xs) (toList ys) (toList zs))
  
  unzipUsingLists :: Sequence s => s (a,b) -> (s a, s b)
  unzipUsingLists xys =
    case L.unzip (toList xys) of
      (xs, ys) -> (fromList xs, fromList ys)
  
  unzipUsingFoldr :: Sequence s => s (a,b) -> (s a, s b)
  unzipUsingFoldr = foldr pcons (empty,empty)
    where pcons (x,y) (xs,ys) = (lcons x xs, lcons y ys)
  
  unzip3UsingLists :: Sequence s => s (a,b,c) -> (s a, s b, s c)
  unzip3UsingLists xyzs =
    case L.unzip3 (toList xyzs) of
      (xs, ys, zs) -> (fromList xs, fromList ys, fromList zs)
  
  unzip3UsingFoldr :: Sequence s => s (a,b,c) -> (s a, s b, s c)
  unzip3UsingFoldr = foldr tcons (empty,empty,empty)
    where tcons (x,y,z) (xs,ys,zs) = (lcons x xs, lcons y ys, lcons z zs)
  
  unzipWithUsingLists ::
    Sequence s => (a -> b) -> (a -> c) -> s a -> (s b, s c)
  unzipWithUsingLists f g xys =
    case L.unzipWith f g (toList xys) of
      (xs, ys) -> (fromList xs, fromList ys)
  
  unzipWithUsingFoldr ::
    Sequence s => (a -> b) -> (a -> c) -> s a -> (s b, s c)
  unzipWithUsingFoldr f g = foldr pcons (empty,empty)
    where pcons e (xs,ys) = (lcons (f e) xs, lcons (g e) ys)
  
  unzipWith3UsingLists ::
    Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d)
  unzipWith3UsingLists f g h xyzs =
    case L.unzipWith3 f g h (toList xyzs) of
      (xs, ys, zs) -> (fromList xs, fromList ys, fromList zs)
  
  unzipWith3UsingFoldr ::
    Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d)
  unzipWith3UsingFoldr f g h = foldr tcons (empty,empty,empty)
    where tcons e (xs,ys,zs) = (lcons (f e) xs, lcons (g e) ys, lcons (h e) zs)
  
  showsPrecUsingToList :: (Show a,Sequence s) => Int -> s a -> ShowS
  showsPrecUsingToList i xs rest
     | i == 0    = concat [    instanceName xs,".fromList "] ++ showsPrec 10 (toList xs) rest
     | otherwise = concat ["(",instanceName xs,".fromList "] ++ showsPrec 10 (toList xs) (')':rest)
  
  readsPrecUsingFromList :: (Read a,Sequence s) => Int -> ReadS (s a)
  readsPrecUsingFromList _ xs =
     let result = maybeParens p xs
         p xs = tokenMatch ((instanceName x)++".fromList") xs
                  >>= readsPrec 10
                  >>= \(l,rest) -> return (fromList l,rest)
  
         -- play games with the typechecker so we don't have to use
         -- extensions for scoped type variables
         ~[(x,_)] = result
  
     in result
  
  defaultCompare :: (Ord a, Sequence s) => s a -> s a -> Ordering
  defaultCompare a b =
     case (lview a, lview b) of
       (Nothing, Nothing) -> EQ
       (Nothing, _      ) -> LT
       (_      , Nothing) -> GT
       (Just (x,xs), Just (y,ys)) ->
          case compare x y of
             EQ -> defaultCompare xs ys
             c -> c
  
  
  dropMatch :: (Eq a,MonadPlus m) => [a] -> [a] -> m [a]
  dropMatch [] ys = return ys
  dropMatch (x:xs) (y:ys)
      | x == y    = dropMatch xs ys
      | otherwise = mzero
  dropMatch _ _   = mzero
  
  tokenMatch :: MonadPlus m => String -> String -> m String
  tokenMatch token str = dropMatch token (munch str) >>= return . munch
     where munch = dropWhile isSpace
  
  readSParens :: ReadS a -> ReadS a
  readSParens p xs = return xs
       >>= tokenMatch "("
       >>= p
       >>= \(x,xs') -> return xs'
       >>= tokenMatch ")"
       >>= \rest -> return (x,rest)
  
  maybeParens :: ReadS a -> ReadS a
  maybeParens p xs = readSParens p xs `mplus` p xs
  