{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
#define USE_MAGIC_PROXY 1
#endif
#if USE_MAGIC_PROXY
{-# LANGUAGE MagicHash #-}
#endif
#include "containers.h"
module Data.IntMap.Merge.Strict (
SimpleWhenMissing
, SimpleWhenMatched
, merge
, zipWithMaybeMatched
, zipWithMatched
, mapMaybeMissing
, dropMissing
, preserveMissing
, mapMissing
, filterMissing
, WhenMissing
, WhenMatched
, mergeA
, zipWithMaybeAMatched
, zipWithAMatched
, traverseMaybeMissing
, traverseMissing
, filterAMissing
, mapWhenMissing
, mapWhenMatched
, runWhenMatched
, runWhenMissing
) where
import Data.IntMap.Internal
( SimpleWhenMissing
, SimpleWhenMatched
, merge
, dropMissing
, preserveMissing
, filterMissing
, WhenMissing (..)
, WhenMatched (..)
, mergeA
, filterAMissing
, runWhenMatched
, runWhenMissing
)
import Data.IntMap.Strict.Internal
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
#endif
import Prelude hiding (filter, map, foldl, foldr)
mapWhenMissing :: Functor f => (a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapWhenMissing :: forall (f :: * -> *) a b x.
Functor f =>
(a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapWhenMissing a -> b
f WhenMissing f x a
q = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap b)
missingSubtree = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> IntMap a -> IntMap b
map a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree WhenMissing f x a
q
, missingKey :: Key -> x -> f (Maybe b)
missingKey = \Key
k x
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Maybe a -> Maybe a
forceMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) x y.
WhenMissing f x y -> Key -> x -> f (Maybe y)
missingKey WhenMissing f x a
q Key
k x
x}
mapWhenMatched :: Functor f => (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapWhenMatched :: forall (f :: * -> *) a b x y.
Functor f =>
(a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapWhenMatched a -> b
f WhenMatched f x y a
q = WhenMatched
{ matchedKey :: Key -> x -> y -> f (Maybe b)
matchedKey = \Key
k x
x y
y -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Maybe a -> Maybe a
forceMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) x y z.
WhenMatched f x y z -> Key -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x y a
q Key
k x
x y
y }
zipWithMaybeMatched :: Applicative f
=> (Key -> x -> y -> Maybe z)
-> WhenMatched f x y z
zipWithMaybeMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Key -> x -> y -> Maybe z) -> WhenMatched f x y z
zipWithMaybeMatched Key -> x -> y -> Maybe z
f = forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
\Key
k x
x y
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Maybe a -> Maybe a
forceMaybe forall a b. (a -> b) -> a -> b
$! Key -> x -> y -> Maybe z
f Key
k x
x y
y
{-# INLINE zipWithMaybeMatched #-}
zipWithMaybeAMatched :: Applicative f
=> (Key -> x -> y -> f (Maybe z))
-> WhenMatched f x y z
zipWithMaybeAMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched Key -> x -> y -> f (Maybe z)
f = forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
\ Key
k x
x y
y -> forall a. Maybe a -> Maybe a
forceMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> x -> y -> f (Maybe z)
f Key
k x
x y
y
{-# INLINE zipWithMaybeAMatched #-}
zipWithAMatched :: Applicative f
=> (Key -> x -> y -> f z)
-> WhenMatched f x y z
zipWithAMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Key -> x -> y -> f z) -> WhenMatched f x y z
zipWithAMatched Key -> x -> y -> f z
f = forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
\ Key
k x
x y
y -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> x -> y -> f z
f Key
k x
x y
y
{-# INLINE zipWithAMatched #-}
zipWithMatched :: Applicative f
=> (Key -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Key -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched Key -> x -> y -> z
f = forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
\Key
k x
x y
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Key -> x -> y -> z
f Key
k x
x y
y
{-# INLINE zipWithMatched #-}
mapMaybeMissing :: Applicative f => (Key -> x -> Maybe y) -> WhenMissing f x y
mapMaybeMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Key -> x -> Maybe y) -> WhenMissing f x y
mapMaybeMissing Key -> x -> Maybe y
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Key -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey Key -> x -> Maybe y
f IntMap x
m
, missingKey :: Key -> x -> f (Maybe y)
missingKey = \Key
k x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Maybe a -> Maybe a
forceMaybe forall a b. (a -> b) -> a -> b
$! Key -> x -> Maybe y
f Key
k x
x }
{-# INLINE mapMaybeMissing #-}
mapMissing :: Applicative f => (Key -> x -> y) -> WhenMissing f x y
mapMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Key -> x -> y) -> WhenMissing f x y
mapMissing Key -> x -> y
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Key -> a -> b) -> IntMap a -> IntMap b
mapWithKey Key -> x -> y
f IntMap x
m
, missingKey :: Key -> x -> f (Maybe y)
missingKey = \Key
k x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Key -> x -> y
f Key
k x
x }
{-# INLINE mapMissing #-}
traverseMaybeMissing :: Applicative f
=> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Key -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing Key -> x -> f (Maybe y)
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = forall (f :: * -> *) a b.
Applicative f =>
(Key -> a -> f (Maybe b)) -> IntMap a -> f (IntMap b)
traverseMaybeWithKey Key -> x -> f (Maybe y)
f
, missingKey :: Key -> x -> f (Maybe y)
missingKey = \Key
k x
x -> forall a. Maybe a -> Maybe a
forceMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> x -> f (Maybe y)
f Key
k x
x }
{-# INLINE traverseMaybeMissing #-}
traverseMissing :: Applicative f
=> (Key -> x -> f y) -> WhenMissing f x y
traverseMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Key -> x -> f y) -> WhenMissing f x y
traverseMissing Key -> x -> f y
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = forall (t :: * -> *) a b.
Applicative t =>
(Key -> a -> t b) -> IntMap a -> t (IntMap b)
traverseWithKey Key -> x -> f y
f
, missingKey :: Key -> x -> f (Maybe y)
missingKey = \Key
k x
x -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> x -> f y
f Key
k x
x }
{-# INLINE traverseMissing #-}
forceMaybe :: Maybe a -> Maybe a
forceMaybe :: forall a. Maybe a -> Maybe a
forceMaybe Maybe a
Nothing = forall a. Maybe a
Nothing
forceMaybe m :: Maybe a
m@(Just !a
_) = Maybe a
m
{-# INLINE forceMaybe #-}