content: -- |
  --   Module      :  Data.Edison.Coll.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 collection methods.  The functions
  --   in this module are used to fill out collection implementations and are not intended to be
  --   used directly by end users.
  
  module Data.Edison.Coll.Defaults where
  
  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,foldl',lookup,filter)
  import qualified Control.Monad.Fail as Fail
  
  import Data.Edison.Prelude ( runFail_ )
  import Data.Edison.Coll
  import qualified Data.Edison.Seq as S
  import qualified Data.Edison.Seq.ListSeq as L
  import Data.Edison.Seq.Defaults (tokenMatch,maybeParens)
  
  insertSeqUsingUnion :: (CollX c a,S.Sequence seq) => seq a -> c -> c
  insertSeqUsingUnion xs c = union (fromSeq xs) c
  
  insertSeqUsingFoldr :: (CollX c a,S.Sequence seq) => seq a -> c -> c
  insertSeqUsingFoldr xs c = S.foldr insert c xs
  
  memberUsingFold :: Coll c a => c -> a -> Bool
  memberUsingFold h x = fold (\y ans -> (x == y) || ans) False h
  
  countUsingMember :: SetX c a => a -> c -> Int
  countUsingMember x xs = if member x xs then 1 else 0
  
  lookupAllUsingLookupM :: (Set c a,S.Sequence seq) => a -> c -> seq a
  lookupAllUsingLookupM x xs =
    case lookupM x xs of
      Nothing -> S.empty
      Just y  -> S.singleton y
  
  deleteSeqUsingDelete :: (CollX c a,S.Sequence seq) => seq a -> c -> c
  deleteSeqUsingDelete xs c = S.foldr delete c xs
  
  unionSeqUsingFoldl :: (CollX c a,S.Sequence seq) => seq c -> c
  unionSeqUsingFoldl = S.foldl union empty
  
  unionSeqUsingFoldl' :: (CollX c a,S.Sequence seq) => seq c -> c
  unionSeqUsingFoldl' = S.foldl' union empty
  
  unionSeqUsingReduce :: (CollX c a,S.Sequence seq) => seq c -> c
  unionSeqUsingReduce = S.reducel union empty
  
  fromSeqUsingFoldr :: (CollX c a,S.Sequence seq) => seq a -> c
  fromSeqUsingFoldr = S.foldr insert empty
  
  fromSeqUsingUnionSeq :: (CollX c a,S.Sequence seq) => seq a -> c
  fromSeqUsingUnionSeq = unionList . S.foldl singleCons []
    where singleCons xs x = S.lcons (singleton x) xs
  
  toSeqUsingFold :: (Coll c a,S.Sequence seq) => c -> seq a
  toSeqUsingFold = fold S.lcons S.empty
  
  unsafeInsertMaxUsingUnsafeAppend :: OrdCollX c a => a -> c -> c
  unsafeInsertMaxUsingUnsafeAppend x c = unsafeAppend c (singleton x)
  
  toOrdSeqUsingFoldr :: (OrdColl c a,S.Sequence seq) => c -> seq a
  toOrdSeqUsingFoldr = foldr S.lcons S.empty
  
  unsafeFromOrdSeqUsingUnsafeInsertMin ::
      (OrdCollX c a,S.Sequence seq) => seq a -> c
  unsafeFromOrdSeqUsingUnsafeInsertMin = S.foldr unsafeInsertMin empty
  
  disjointUsingToOrdList :: OrdColl c a => c -> c -> Bool
  disjointUsingToOrdList xs ys = disj (toOrdList xs) (toOrdList ys)
    where disj a@(c:cs) b@(d:ds) =
            case compare c d of
              LT -> disj cs b
              EQ -> False
              GT -> disj a ds
          disj _ _ = True
  
  intersectWitnessUsingToOrdList ::
          (OrdColl c a, Fail.MonadFail m) => c -> c -> m (a,a)
  intersectWitnessUsingToOrdList as bs = witness (toOrdList as) (toOrdList bs)
    where witness a@(x:xs) b@(y:ys) =
            case compare x y of
              LT -> witness xs b
              EQ -> return (x, y)
              GT -> witness a ys
          -- XXX
          witness _ _ = fail $ instanceName as ++ ".intersect: failed"
  
  lookupUsingLookupM :: Coll c a => a -> c -> a
  lookupUsingLookupM x ys = runFail_ (lookupM x ys)
  
  lookupUsingLookupAll :: Coll c a => a -> c -> a
  lookupUsingLookupAll x ys =
    case lookupAll x ys of
      (y:_) -> y
      [] -> error $ instanceName ys ++ ".lookup: lookup failed"
  
  lookupMUsingLookupAll :: (Coll c a, Fail.MonadFail m) => a -> c -> m a
  lookupMUsingLookupAll x ys =
    case lookupAll x ys of
      (y:_) -> return y
      []    -> fail $ instanceName ys ++ ".lookupM: lookup failed"
  
  lookupWithDefaultUsingLookupAll :: Coll c a => a -> a -> c -> a
  lookupWithDefaultUsingLookupAll dflt x ys =
    case lookupAll x ys of
      (y:_) -> y
      [] -> dflt
  
  lookupWithDefaultUsingLookupM :: Coll c a => a -> a -> c -> a
  lookupWithDefaultUsingLookupM dflt x ys =
    case lookupM x ys of
      Just y  -> y
      Nothing -> dflt
  
  deleteMaxUsingMaxView :: OrdColl c a => c -> c
  deleteMaxUsingMaxView c =
    case maxView c of
      Just (_,c') -> c'
      Nothing     -> c
  
  fromSeqWithUsingInsertWith :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq a -> c
  fromSeqWithUsingInsertWith c = S.foldr (insertWith c) empty
  
  insertUsingInsertWith :: Set c a => a -> c -> c
  insertUsingInsertWith = insertWith (\x _ -> x)
  
  unionUsingUnionWith :: Set c a => c -> c -> c
  unionUsingUnionWith = unionWith (\x _ -> x)
  
  filterUsingOrdLists :: OrdColl c a => (a -> Bool) -> c -> c
  filterUsingOrdLists p = unsafeFromOrdList . L.filter p . toOrdList
  
  partitionUsingOrdLists :: OrdColl c a => (a -> Bool) -> c -> (c,c)
  partitionUsingOrdLists p xs = (unsafeFromOrdList ys,unsafeFromOrdList zs)
    where (ys,zs) = L.partition p (toOrdList xs)
  
  intersectionUsingIntersectionWith :: Set c a => c -> c -> c
  intersectionUsingIntersectionWith = intersectionWith (\x _ -> x)
  
  differenceUsingOrdLists :: OrdSet c a => c -> c -> c
  differenceUsingOrdLists as bs = unsafeFromOrdList $ diff (toOrdList as) (toOrdList bs)
    where diff a@(x:xs) b@(y:ys) =
            case compare x y of
              LT -> x : diff xs b
              EQ -> diff xs ys
              GT -> diff a ys
          diff a _ = a
  
  symmetricDifferenceUsingDifference :: SetX c a => c -> c -> c
  symmetricDifferenceUsingDifference xs ys = union (difference xs ys) (difference ys xs)
  
  properSubsetUsingOrdLists :: OrdSet c a => c -> c -> Bool
  properSubsetUsingOrdLists xs ys = properSubsetOnOrdLists (toOrdList xs) (toOrdList ys)
  
  subsetUsingOrdLists :: OrdSet c a => c -> c -> Bool
  subsetUsingOrdLists xs ys = subsetOnOrdLists (toOrdList xs) (toOrdList ys)
  
  properSubsetOnOrdLists :: (Ord t) => [t] -> [t] -> Bool
  properSubsetOnOrdLists [] [] = False
  properSubsetOnOrdLists [] (_:_) = True
  properSubsetOnOrdLists (_:_) [] = False
  properSubsetOnOrdLists a@(x:xs) (y:ys) =
    case compare x y of
      LT -> False
      EQ -> properSubsetOnOrdLists xs ys
      GT -> subsetOnOrdLists a ys
  
  subsetOnOrdLists :: (Ord t) => [t] -> [t] -> Bool
  subsetOnOrdLists [] _ = True
  subsetOnOrdLists (_:_) [] = False
  subsetOnOrdLists a@(x:xs) (y:ys) =
    case compare x y of
      LT -> False
      EQ -> subsetOnOrdLists xs ys
      GT -> subsetOnOrdLists a ys
  
  insertSeqWithUsingInsertWith :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq a -> c -> c
  insertSeqWithUsingInsertWith c xs s = S.foldr (insertWith c) s xs
  
  unionlUsingUnionWith :: Set c a => c -> c -> c
  unionlUsingUnionWith xs ys = unionWith (\x _ -> x) xs ys
  
  unionrUsingUnionWith :: Set c a => c -> c -> c
  unionrUsingUnionWith xs ys = unionWith (\_ y -> y) xs ys
  
  unionWithUsingOrdLists :: OrdSet c a => (a -> a -> a) -> c -> c -> c
  unionWithUsingOrdLists c as bs = unsafeFromOrdList $ merge (toOrdList as) (toOrdList bs)
    where merge a@(x:xs) b@(y:ys) =
            case compare x y of
              LT -> x : merge xs b
              EQ -> c x y : merge xs ys
              GT -> y : merge a ys
          merge a [] = a
          merge [] b = b
  
  unionSeqWithUsingReducer :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq c -> c
  unionSeqWithUsingReducer c = S.reducer (unionWith c) empty
  
  intersectionWithUsingOrdLists :: OrdSet c a => (a -> a -> a) -> c -> c -> c
  intersectionWithUsingOrdLists c as bs = unsafeFromOrdList $ inter (toOrdList as) (toOrdList bs)
    where inter a@(x:xs) b@(y:ys) =
            case compare x y of
              LT -> inter xs b
              EQ -> c x y : inter xs ys
              GT -> inter a ys
          inter _ _ = []
  
  
  unsafeMapMonotonicUsingFoldr :: (OrdColl cin a, OrdCollX cout b) => (a -> b) -> (cin -> cout)
  unsafeMapMonotonicUsingFoldr f xs = foldr (unsafeInsertMin . f) empty xs
  
  showsPrecUsingToList :: (Coll c a,Show a) => Int -> c -> ShowS
  showsPrecUsingToList i xs rest
    | i == 0    = concat [    instanceName xs,".fromSeq ",showsPrec 10 (toList xs) rest]
    | otherwise = concat ["(",instanceName xs,".fromSeq ",showsPrec 10 (toList xs) (')':rest)]
  
  readsPrecUsingFromList :: (Coll c a, Read a) => Int -> ReadS c
  readsPrecUsingFromList _ xs =
      let result = maybeParens p xs
          p ys = tokenMatch ((instanceName x) ++ ".fromSeq") ys
                   >>= 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
  
  compareUsingToOrdList :: OrdColl c a => c -> c -> Ordering
  compareUsingToOrdList as bs = cmp (toOrdList as) (toOrdList bs)
   where
    cmp [] [] = EQ
    cmp [] _  = LT
    cmp _  [] = GT
    cmp (x:xs) (y:ys) =
        case compare x y of
           EQ -> cmp xs ys
           c -> c
  
  