module Data.Edison.Coll.Defaults where
import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)
import Control.Monad.Identity
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, Monad 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
witness _ _ = fail $ instanceName as ++ ".intersect: failed"
lookupUsingLookupM :: Coll c a => a -> c -> a
lookupUsingLookupM x ys = runIdentity (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, Monad 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)
~[(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