{-# 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.Strict.IntMap.Autogen.Merge.Strict
-- Copyright   :  (c) wren romano 2016
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- This module defines an API for writing functions that merge two
-- maps. The key functions are 'merge' and 'mergeA'.
-- Each of these can be used with several different \"merge tactics\".
--
-- The 'merge' and 'mergeA' functions are shared by
-- the lazy and strict modules. Only the choice of merge tactics
-- determines strictness. If you use 'Data.Map.Merge.Strict.mapMissing'
-- from this module then the results will be forced before they are
-- inserted. If you use 'Data.Map.Merge.Lazy.mapMissing' from
-- "Data.Map.Merge.Lazy" then they will not.
--
-- == Efficiency note
--
-- The 'Control.Category.Category', 'Applicative', and 'Monad' instances for
-- 'WhenMissing' tactics are included because they are valid. However, they are
-- inefficient in many cases and should usually be avoided. The instances
-- for 'WhenMatched' tactics should not pose any major efficiency problems.
--
-- @since 0.5.9

module Data.Strict.IntMap.Autogen.Merge.Strict (
    -- ** Simple merge tactic types
      SimpleWhenMissing
    , SimpleWhenMatched

    -- ** General combining function
    , merge

    -- *** @WhenMatched@ tactics
    , zipWithMaybeMatched
    , zipWithMatched

    -- *** @WhenMissing@ tactics
    , mapMaybeMissing
    , dropMissing
    , preserveMissing
    , mapMissing
    , filterMissing

    -- ** Applicative merge tactic types
    , WhenMissing
    , WhenMatched

    -- ** Applicative general combining function
    , mergeA

    -- *** @WhenMatched@ tactics
    -- | The tactics described for 'merge' work for
    -- 'mergeA' as well. Furthermore, the following
    -- are available.
    , zipWithMaybeAMatched
    , zipWithAMatched

    -- *** @WhenMissing@ tactics
    -- | The tactics described for 'merge' work for
    -- 'mergeA' as well. Furthermore, the following
    -- are available.
    , traverseMaybeMissing
    , traverseMissing
    , filterAMissing

    -- ** Covariant maps for tactics
    , mapWhenMissing
    , mapWhenMatched

    -- ** Miscellaneous functions on tactics

    , runWhenMatched
    , runWhenMissing
    ) where

import Data.Strict.IntMap.Autogen.Internal
  ( SimpleWhenMissing
  , SimpleWhenMatched
  , merge
  , dropMissing
  , preserveMissing
  , filterMissing
  , WhenMissing (..)
  , WhenMatched (..)
  , mergeA
  , filterAMissing
  , runWhenMatched
  , runWhenMissing
  )
import Data.Strict.IntMap.Autogen.Strict.Internal
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
#endif
import Prelude hiding (filter, map, foldl, foldr)

-- | Map covariantly over a @'WhenMissing' f k x@.
mapWhenMissing :: Functor f => (a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapWhenMissing :: (a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapWhenMissing a -> b
f WhenMissing f x a
q = WhenMissing :: forall (f :: * -> *) x y.
(IntMap x -> f (IntMap y))
-> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
WhenMissing
  { missingSubtree :: IntMap x -> f (IntMap b)
missingSubtree = (IntMap a -> IntMap b) -> f (IntMap a) -> f (IntMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> IntMap a -> IntMap b
forall a b. (a -> b) -> IntMap a -> IntMap b
map a -> b
f) (f (IntMap a) -> f (IntMap b))
-> (IntMap x -> f (IntMap a)) -> IntMap x -> f (IntMap b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhenMissing f x a -> IntMap x -> f (IntMap a)
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 -> (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe b -> Maybe b
forall a. Maybe a -> Maybe a
forceMaybe (Maybe b -> Maybe b) -> (Maybe a -> Maybe b) -> Maybe a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (f (Maybe a) -> f (Maybe b)) -> f (Maybe a) -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$ WhenMissing f x a -> Key -> x -> f (Maybe a)
forall (f :: * -> *) x y.
WhenMissing f x y -> Key -> x -> f (Maybe y)
missingKey WhenMissing f x a
q Key
k x
x}

-- | Map covariantly over a @'WhenMatched' f k x y@.
mapWhenMatched :: Functor f => (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapWhenMatched :: (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapWhenMatched a -> b
f WhenMatched f x y a
q = WhenMatched :: forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched
  { matchedKey :: Key -> x -> y -> f (Maybe b)
matchedKey = \Key
k x
x y
y -> (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe b -> Maybe b
forall a. Maybe a -> Maybe a
forceMaybe (Maybe b -> Maybe b) -> (Maybe a -> Maybe b) -> Maybe a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (f (Maybe a) -> f (Maybe b)) -> f (Maybe a) -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$ WhenMatched f x y a -> Key -> x -> y -> f (Maybe a)
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 }

-- | When a key is found in both maps, apply a function to the
-- key and values and maybe use the result in the merged map.
--
-- @
-- zipWithMaybeMatched :: (k -> x -> y -> Maybe z)
--                     -> SimpleWhenMatched k x y z
-- @
zipWithMaybeMatched :: Applicative f
                    => (Key -> x -> y -> Maybe z)
                    -> WhenMatched f x y z
zipWithMaybeMatched :: (Key -> x -> y -> Maybe z) -> WhenMatched f x y z
zipWithMaybeMatched Key -> x -> y -> Maybe z
f = (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$
  \Key
k x
x y
y -> Maybe z -> f (Maybe z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe z -> f (Maybe z)) -> Maybe z -> f (Maybe z)
forall a b. (a -> b) -> a -> b
$! Maybe z -> Maybe z
forall a. Maybe a -> Maybe a
forceMaybe (Maybe z -> Maybe z) -> Maybe z -> Maybe z
forall a b. (a -> b) -> a -> b
$! Key -> x -> y -> Maybe z
f Key
k x
x y
y
{-# INLINE zipWithMaybeMatched #-}

-- | When a key is found in both maps, apply a function to the
-- key and values, perform the resulting action, and maybe use
-- the result in the merged map.
--
-- This is the fundamental 'WhenMatched' tactic.
zipWithMaybeAMatched :: Applicative f
                     => (Key -> x -> y -> f (Maybe z))
                     -> WhenMatched f x y z
zipWithMaybeAMatched :: (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched Key -> x -> y -> f (Maybe z)
f = (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$
  \ Key
k x
x y
y -> Maybe z -> Maybe z
forall a. Maybe a -> Maybe a
forceMaybe (Maybe z -> Maybe z) -> f (Maybe z) -> f (Maybe z)
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 #-}

-- | When a key is found in both maps, apply a function to the
-- key and values to produce an action and use its result in the merged map.
zipWithAMatched :: Applicative f
                => (Key -> x -> y -> f z)
                -> WhenMatched f x y z
zipWithAMatched :: (Key -> x -> y -> f z) -> WhenMatched f x y z
zipWithAMatched Key -> x -> y -> f z
f = (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$
  \ Key
k x
x y
y -> (z -> Maybe z
forall a. a -> Maybe a
Just (z -> Maybe z) -> z -> Maybe z
forall a b. (a -> b) -> a -> b
$!) (z -> Maybe z) -> f z -> f (Maybe z)
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 #-}

-- | When a key is found in both maps, apply a function to the
-- key and values and use the result in the merged map.
--
-- @
-- zipWithMatched :: (k -> x -> y -> z)
--                -> SimpleWhenMatched k x y z
-- @
zipWithMatched :: Applicative f
               => (Key -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched :: (Key -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched Key -> x -> y -> z
f = (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$
  \Key
k x
x y
y -> Maybe z -> f (Maybe z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe z -> f (Maybe z)) -> Maybe z -> f (Maybe z)
forall a b. (a -> b) -> a -> b
$! z -> Maybe z
forall a. a -> Maybe a
Just (z -> Maybe z) -> z -> Maybe z
forall a b. (a -> b) -> a -> b
$! Key -> x -> y -> z
f Key
k x
x y
y
{-# INLINE zipWithMatched #-}

-- | Map over the entries whose keys are missing from the other map,
-- optionally removing some. This is the most powerful 'SimpleWhenMissing'
-- tactic, but others are usually more efficient.
--
-- @
-- mapMaybeMissing :: (k -> x -> Maybe y) -> SimpleWhenMissing k x y
-- @
--
-- prop> mapMaybeMissing f = traverseMaybeMissing (\k x -> pure (f k x))
--
-- but @mapMaybeMissing@ uses fewer unnecessary 'Applicative' operations.
mapMaybeMissing :: Applicative f => (Key -> x -> Maybe y) -> WhenMissing f x y
mapMaybeMissing :: (Key -> x -> Maybe y) -> WhenMissing f x y
mapMaybeMissing Key -> x -> Maybe y
f = WhenMissing :: forall (f :: * -> *) x y.
(IntMap x -> f (IntMap y))
-> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
WhenMissing
  { missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = \IntMap x
m -> IntMap y -> f (IntMap y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap y -> f (IntMap y)) -> IntMap y -> f (IntMap y)
forall a b. (a -> b) -> a -> b
$! (Key -> x -> Maybe y) -> IntMap x -> IntMap y
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 -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe y -> f (Maybe y)) -> Maybe y -> f (Maybe y)
forall a b. (a -> b) -> a -> b
$! Maybe y -> Maybe y
forall a. Maybe a -> Maybe a
forceMaybe (Maybe y -> Maybe y) -> Maybe y -> Maybe y
forall a b. (a -> b) -> a -> b
$! Key -> x -> Maybe y
f Key
k x
x }
{-# INLINE mapMaybeMissing #-}

-- | Map over the entries whose keys are missing from the other map.
--
-- @
-- mapMissing :: (k -> x -> y) -> SimpleWhenMissing k x y
-- @
--
-- prop> mapMissing f = mapMaybeMissing (\k x -> Just $ f k x)
--
-- but @mapMissing@ is somewhat faster.
mapMissing :: Applicative f => (Key -> x -> y) -> WhenMissing f x y
mapMissing :: (Key -> x -> y) -> WhenMissing f x y
mapMissing Key -> x -> y
f = WhenMissing :: forall (f :: * -> *) x y.
(IntMap x -> f (IntMap y))
-> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
WhenMissing
  { missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = \IntMap x
m -> IntMap y -> f (IntMap y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap y -> f (IntMap y)) -> IntMap y -> f (IntMap y)
forall a b. (a -> b) -> a -> b
$! (Key -> x -> y) -> IntMap x -> IntMap y
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 -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe y -> f (Maybe y)) -> Maybe y -> f (Maybe y)
forall a b. (a -> b) -> a -> b
$! y -> Maybe y
forall a. a -> Maybe a
Just (y -> Maybe y) -> y -> Maybe y
forall a b. (a -> b) -> a -> b
$! Key -> x -> y
f Key
k x
x }
{-# INLINE mapMissing #-}

-- | Traverse over the entries whose keys are missing from the other map,
-- optionally producing values to put in the result.
-- This is the most powerful 'WhenMissing' tactic, but others are usually
-- more efficient.
traverseMaybeMissing :: Applicative f
                     => (Key -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing :: (Key -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing Key -> x -> f (Maybe y)
f = WhenMissing :: forall (f :: * -> *) x y.
(IntMap x -> f (IntMap y))
-> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
WhenMissing
  { missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = (Key -> x -> f (Maybe y)) -> IntMap x -> f (IntMap y)
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 -> Maybe y -> Maybe y
forall a. Maybe a -> Maybe a
forceMaybe (Maybe y -> Maybe y) -> f (Maybe y) -> f (Maybe y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> x -> f (Maybe y)
f Key
k x
x }
{-# INLINE traverseMaybeMissing #-}

-- | Traverse over the entries whose keys are missing from the other map.
traverseMissing :: Applicative f
                     => (Key -> x -> f y) -> WhenMissing f x y
traverseMissing :: (Key -> x -> f y) -> WhenMissing f x y
traverseMissing Key -> x -> f y
f = WhenMissing :: forall (f :: * -> *) x y.
(IntMap x -> f (IntMap y))
-> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
WhenMissing
  { missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = (Key -> x -> f y) -> IntMap x -> f (IntMap y)
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 -> (y -> Maybe y
forall a. a -> Maybe a
Just (y -> Maybe y) -> y -> Maybe y
forall a b. (a -> b) -> a -> b
$!) (y -> Maybe y) -> f y -> f (Maybe y)
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 :: Maybe a -> Maybe a
forceMaybe Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
forceMaybe m :: Maybe a
m@(Just !a
_) = Maybe a
m
{-# INLINE forceMaybe #-}