{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-}
module Data.AssocList.ListLike.Equivalence
(
lookupFirst
, lookupAll
, removeFirst
, removeAll
, mapFirst
, mapAll
, alterFirst
, alterAll
, partition
, break
, breakPartition
) where
import Data.AssocList.ListLike.Concept
import Control.Exception (throw)
import Prelude (Eq (..), Maybe (..), maybe, error, otherwise, (<$>))
import Data.Functor.Contravariant (Equivalence (..))
import Data.ListLike (cons, uncons)
import qualified Data.ListLike as LL
lookupFirst :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> Maybe b
lookupFirst :: Equivalence a -> a -> l -> Maybe b
lookupFirst Equivalence a
_eq a
_key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Maybe ((a, b), l)
Nothing) = Maybe b
forall a. Maybe a
Nothing
lookupFirst Equivalence a
eq a
key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Just ((a
x, b
y), l
xys))
| Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x = b -> Maybe b
forall a. a -> Maybe a
Just b
y
| Bool
otherwise = Equivalence a -> a -> l -> Maybe b
forall l a b. AssocList l a b => Equivalence a -> a -> l -> Maybe b
lookupFirst Equivalence a
eq a
key l
xys
lookupAll :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> [b]
lookupAll :: Equivalence a -> a -> l -> [b]
lookupAll Equivalence a
_eq a
_key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Maybe ((a, b), l)
Nothing) = []
lookupAll Equivalence a
eq a
key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Just ((a
x, b
y), l
xys))
| Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x = b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Equivalence a -> a -> l -> [b]
forall l a b. AssocList l a b => Equivalence a -> a -> l -> [b]
lookupAll Equivalence a
eq a
key l
xys
| Bool
otherwise = Equivalence a -> a -> l -> [b]
forall l a b. AssocList l a b => Equivalence a -> a -> l -> [b]
lookupAll Equivalence a
eq a
key l
xys
removeFirst :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> l
removeFirst :: Equivalence a -> a -> l -> l
removeFirst Equivalence a
_eq a
_key l :: l
l@(l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Maybe ((a, b), l)
Nothing) = l
l
removeFirst Equivalence a
eq a
key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Just (xy :: (a, b)
xy@(a
x, b
y), l
xys))
| Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x = l
xys
| Bool
otherwise = (a, b) -> l -> l
forall full item. ListLike full item => item -> full -> full
cons (a, b)
xy (Equivalence a -> a -> l -> l
forall l a b. AssocList l a b => Equivalence a -> a -> l -> l
removeFirst Equivalence a
eq a
key l
xys)
removeAll :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> l
removeAll :: Equivalence a -> a -> l -> l
removeAll Equivalence a
_eq a
_key l :: l
l@(l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Maybe ((a, b), l)
Nothing) = l
l
removeAll Equivalence a
eq a
key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Just (xy :: (a, b)
xy@(a
x, b
y), l
xys))
| Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x = Equivalence a -> a -> l -> l
forall l a b. AssocList l a b => Equivalence a -> a -> l -> l
removeAll Equivalence a
eq a
key l
xys
| Bool
otherwise = (a, b) -> l -> l
forall full item. ListLike full item => item -> full -> full
cons (a, b)
xy (Equivalence a -> a -> l -> l
forall l a b. AssocList l a b => Equivalence a -> a -> l -> l
removeAll Equivalence a
eq a
key l
xys)
partition :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> ([b], l)
partition :: Equivalence a -> a -> l -> ([b], l)
partition Equivalence a
_eq a
_key l :: l
l@(l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Maybe ((a, b), l)
Nothing) = ([], l
l)
partition Equivalence a
eq a
key (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons -> Just (xy :: (a, b)
xy@(a
x, b
y), l
xys))
| Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x = (b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
yes , l
no)
| Bool
otherwise = ( [b]
yes , (a, b) -> l -> l
forall full item. ListLike full item => item -> full -> full
cons (a, b)
xy l
no)
where
([b]
yes, l
no) = Equivalence a -> a -> l -> ([b], l)
forall l a b.
AssocList l a b =>
Equivalence a -> a -> l -> ([b], l)
partition Equivalence a
eq a
key l
xys
break :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> (l, l)
break :: Equivalence a -> a -> l -> (l, l)
break Equivalence a
eq a
key = ((a, b) -> Bool) -> l -> (l, l)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
LL.break (\(a
x, b
y) -> Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x)
breakPartition :: forall l a b. AssocList l a b
=> Equivalence a -> a -> l -> (l, [b], l)
breakPartition :: Equivalence a -> a -> l -> (l, [b], l)
breakPartition Equivalence a
eq a
key l
l =
let
(l
before, l
l') = Equivalence a -> a -> l -> (l, l)
forall l a b. AssocList l a b => Equivalence a -> a -> l -> (l, l)
break Equivalence a
eq a
key l
l
([b]
xs, l
after) = Equivalence a -> a -> l -> ([b], l)
forall l a b.
AssocList l a b =>
Equivalence a -> a -> l -> ([b], l)
partition Equivalence a
eq a
key l
l'
in
(l
before, [b]
xs, l
after)
mapFirst :: forall l a b. AssocList l a b
=> Equivalence a -> a -> (b -> b) -> l -> l
mapFirst :: Equivalence a -> a -> (b -> b) -> l -> l
mapFirst Equivalence a
eq a
key b -> b
f l
l =
let
(l
before, l
l') = Equivalence a -> a -> l -> (l, l)
forall l a b. AssocList l a b => Equivalence a -> a -> l -> (l, l)
break Equivalence a
eq a
key l
l
in
l
before l -> l -> l
forall full item. ListLike full item => full -> full -> full
`LL.append`
case (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons l
l') of
Maybe ((a, b), l)
Nothing -> l
l'
Just ((a
x, b
y), l
after) -> (a, b) -> l -> l
forall full item. ListLike full item => item -> full -> full
cons (a
x, b -> b
f b
y) l
after
mapAll :: forall l a b. AssocList l a b
=> Equivalence a -> a -> (b -> b) -> l -> l
mapAll :: Equivalence a -> a -> (b -> b) -> l -> l
mapAll Equivalence a
eq a
key b -> b
f =
((a, b) -> (a, b)) -> l -> l
forall full item full' item'.
(ListLike full item, ListLike full' item') =>
(item -> item') -> full -> full'
LL.map (a, b) -> (a, b)
g
where
g :: (a, b) -> (a, b)
g xy :: (a, b)
xy@(a
x, b
y)
| Equivalence a -> a -> a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence Equivalence a
eq a
key a
x = (a
x, b -> b
f b
y)
| Bool
otherwise = (a, b)
xy
alterFirst :: forall l a b. AssocList l a b
=> Equivalence a -> a -> (Maybe b -> Maybe b)
-> l -> l
alterFirst :: Equivalence a -> a -> (Maybe b -> Maybe b) -> l -> l
alterFirst Equivalence a
eq a
key Maybe b -> Maybe b
f l
l =
let (l
before, l
l') = Equivalence a -> a -> l -> (l, l)
forall l a b. AssocList l a b => Equivalence a -> a -> l -> (l, l)
break Equivalence a
eq a
key l
l
in l
before l -> l -> l
forall full item. ListLike full item => full -> full -> full
`LL.append`
case (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons l
l') of
Maybe ((a, b), l)
Nothing -> l -> ((a, b) -> l) -> Maybe (a, b) -> l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l
forall full item. ListLike full item => full
LL.empty (a, b) -> l
forall full item. ListLike full item => item -> full
LL.singleton ((,) a
key (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b -> Maybe b
f Maybe b
forall a. Maybe a
Nothing)
Just ((a
x, b
y), l
after) -> l -> ((a, b) -> l) -> Maybe (a, b) -> l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l
forall full item. ListLike full item => full
LL.empty (a, b) -> l
forall full item. ListLike full item => item -> full
LL.singleton ((,) a
x (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b -> Maybe b
f (b -> Maybe b
forall a. a -> Maybe a
Just b
y))
l -> l -> l
forall full item. ListLike full item => full -> full -> full
`LL.append` l
after
alterAll :: forall l a b. AssocList l a b
=> Equivalence a -> a -> ([b] -> [b])
-> l -> l
alterAll :: Equivalence a -> a -> ([b] -> [b]) -> l -> l
alterAll Equivalence a
eq a
key [b] -> [b]
f l
l =
let (l
before, l
l') = Equivalence a -> a -> l -> (l, l)
forall l a b. AssocList l a b => Equivalence a -> a -> l -> (l, l)
break Equivalence a
eq a
key l
l
in l
before l -> l -> l
forall full item. ListLike full item => full -> full -> full
`LL.append`
case (l -> Maybe ((a, b), l)
forall full item. ListLike full item => full -> Maybe (item, full)
uncons l
l') of
Maybe ((a, b), l)
Nothing -> [Item l] -> l
forall l. IsList l => [Item l] -> l
LL.fromList ((,) a
key (b -> (a, b)) -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b] -> [b]
f [])
Maybe ((a, b), l)
_ -> let ([b]
ys, l
after) = Equivalence a -> a -> l -> ([b], l)
forall l a b.
AssocList l a b =>
Equivalence a -> a -> l -> ([b], l)
partition Equivalence a
eq a
key l
l'
in [Item l] -> l
forall l. IsList l => [Item l] -> l
LL.fromList ((,) a
key (b -> (a, b)) -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b] -> [b]
f [b]
ys) l -> l -> l
forall full item. ListLike full item => full -> full -> full
`LL.append` l
after