-- inspired by total-map
module Data.Graph.Comfort.TotalMap where

import Control.Applicative (Applicative, pure, (<*>))

import qualified Data.Map as Map
import Data.Map (Map)
import Data.Monoid ((<>))


data TotalMap k a = TotalMap {TotalMap k a -> a
deflt :: a, TotalMap k a -> Map k a
core :: Map k a}

cons :: a -> Map k a -> TotalMap k a
cons :: a -> Map k a -> TotalMap k a
cons = a -> Map k a -> TotalMap k a
forall k a. a -> Map k a -> TotalMap k a
TotalMap


instance Functor (TotalMap k) where
   fmap :: (a -> b) -> TotalMap k a -> TotalMap k b
fmap a -> b
f (TotalMap a
d Map k a
m) = b -> Map k b -> TotalMap k b
forall k a. a -> Map k a -> TotalMap k a
TotalMap (a -> b
f a
d) ((a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Map k a
m)

instance (Ord k) => Applicative (TotalMap k) where
   pure :: a -> TotalMap k a
pure a
a = a -> Map k a -> TotalMap k a
forall k a. a -> Map k a -> TotalMap k a
TotalMap a
a Map k a
forall k a. Map k a
Map.empty
   TotalMap a -> b
fd Map k (a -> b)
fm <*> :: TotalMap k (a -> b) -> TotalMap k a -> TotalMap k b
<*> TotalMap a
ad Map k a
am =
      b -> Map k b -> TotalMap k b
forall k a. a -> Map k a -> TotalMap k a
TotalMap (a -> b
fd a
ad) (Map k b -> TotalMap k b) -> Map k b -> TotalMap k b
forall a b. (a -> b) -> a -> b
$
         ((a -> b) -> b) -> Map k (a -> b) -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$a
ad) (Map k (a -> b) -> Map k a -> Map k (a -> b)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map k (a -> b)
fm Map k a
am) Map k b -> Map k b -> Map k b
forall a. Semigroup a => a -> a -> a
<>
         (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
fd(a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$) (Map k a -> Map k (a -> b) -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map k a
am Map k (a -> b)
fm) Map k b -> Map k b -> Map k b
forall a. Semigroup a => a -> a -> a
<>
         ((a -> b) -> a -> b) -> Map k (a -> b) -> Map k a -> Map k b
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) Map k (a -> b)
fm Map k a
am

intersectionPartialWith ::
   (Ord k) =>
   (a -> b -> c) -> TotalMap k a -> Map k b -> Map k c
intersectionPartialWith :: (a -> b -> c) -> TotalMap k a -> Map k b -> Map k c
intersectionPartialWith a -> b -> c
f (TotalMap a
ad Map k a
am) Map k b
bm =
   (a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith a -> b -> c
f Map k a
am Map k b
bm
   Map k c -> Map k c -> Map k c
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union`
   (b -> c) -> Map k b -> Map k c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
ad) Map k b
bm