{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Copyright: © 2022–2024 Jonathan Knowles
-- License: Apache-2.0
--
-- An ordinary left-biased map similar to 'Map', implemented in terms of
-- 'MonoidMap'.
--
module Examples.RecoveredMap where

import Prelude hiding
    ( map )

import Control.DeepSeq
    ( NFData )
import Data.Coerce
    ( coerce )
import Data.Maybe
    ( mapMaybe )
import Data.Monoid
    ( First (..) )
import Data.MonoidMap
    ( MonoidMap )
import Data.Semigroup
    ( Semigroup (stimes), stimesIdempotentMonoid )
import Data.Set
    ( Set )

import qualified Data.MonoidMap as MonoidMap

newtype Map k v = Map
    --  'First' is used to mimic the left-biased nature of 'Data.Map':
    {forall k v. Map k v -> MonoidMap k (First v)
unMap :: MonoidMap k (First v)}
    deriving newtype (Map k v -> Map k v -> Bool
(Map k v -> Map k v -> Bool)
-> (Map k v -> Map k v -> Bool) -> Eq (Map k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Map k v -> Map k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => Map k v -> Map k v -> Bool
== :: Map k v -> Map k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => Map k v -> Map k v -> Bool
/= :: Map k v -> Map k v -> Bool
Eq, Map k v -> ()
(Map k v -> ()) -> NFData (Map k v)
forall a. (a -> ()) -> NFData a
forall k v. (NFData k, NFData v) => Map k v -> ()
$crnf :: forall k v. (NFData k, NFData v) => Map k v -> ()
rnf :: Map k v -> ()
NFData, Semigroup (Map k v)
Map k v
Semigroup (Map k v) =>
Map k v
-> (Map k v -> Map k v -> Map k v)
-> ([Map k v] -> Map k v)
-> Monoid (Map k v)
[Map k v] -> Map k v
Map k v -> Map k v -> Map k v
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall k v. Ord k => Semigroup (Map k v)
forall k v. Ord k => Map k v
forall k v. Ord k => [Map k v] -> Map k v
forall k v. Ord k => Map k v -> Map k v -> Map k v
$cmempty :: forall k v. Ord k => Map k v
mempty :: Map k v
$cmappend :: forall k v. Ord k => Map k v -> Map k v -> Map k v
mappend :: Map k v -> Map k v -> Map k v
$cmconcat :: forall k v. Ord k => [Map k v] -> Map k v
mconcat :: [Map k v] -> Map k v
Monoid)

instance Ord k => Semigroup (Map k v) where
    <> :: Map k v -> Map k v -> Map k v
(<>) = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(MonoidMap k (First v) -> _ -> _) MonoidMap k (First v)
-> MonoidMap k (First v) -> MonoidMap k (First v)
forall a. Semigroup a => a -> a -> a
(<>)
    stimes :: forall b. Integral b => b -> Map k v -> Map k v
stimes = b -> Map k v -> Map k v
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid

instance (Show k, Show v) => Show (Map k v) where
    show :: Map k v -> String
show = (String
"fromList " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Map k v -> String) -> Map k v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> String
forall a. Show a => a -> String
show ([(k, v)] -> String) -> (Map k v -> [(k, v)]) -> Map k v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k v. Map k v -> [(k, v)]
toList

instance Functor (Map k) where
    fmap :: forall a b. (a -> b) -> Map k a -> Map k b
fmap = (a -> b) -> Map k a -> Map k b
forall v1 v2 k. (v1 -> v2) -> Map k v1 -> Map k v2
map

empty :: Map k v
empty :: forall k v. Map k v
empty = MonoidMap k (First v) -> Map k v
forall k v. MonoidMap k (First v) -> Map k v
Map MonoidMap k (First v)
forall k v. MonoidMap k v
MonoidMap.empty

singleton :: Ord k => k -> v -> Map k v
singleton :: forall k v. Ord k => k -> v -> Map k v
singleton k
k = MonoidMap k (First v) -> Map k v
forall k v. MonoidMap k (First v) -> Map k v
Map (MonoidMap k (First v) -> Map k v)
-> (v -> MonoidMap k (First v)) -> v -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> First v -> MonoidMap k (First v)
forall k v. (Ord k, MonoidNull v) => k -> v -> MonoidMap k v
MonoidMap.singleton k
k (First v -> MonoidMap k (First v))
-> (v -> First v) -> v -> MonoidMap k (First v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> First v
forall a. a -> First a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

fromList :: Ord k => [(k, v)] -> Map k v
fromList :: forall k v. Ord k => [(k, v)] -> Map k v
fromList = MonoidMap k (First v) -> Map k v
forall k v. MonoidMap k (First v) -> Map k v
Map (MonoidMap k (First v) -> Map k v)
-> ([(k, v)] -> MonoidMap k (First v)) -> [(k, v)] -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (First v -> First v -> First v)
-> [(k, First v)] -> MonoidMap k (First v)
forall k v.
(Ord k, MonoidNull v) =>
(v -> v -> v) -> [(k, v)] -> MonoidMap k v
MonoidMap.fromListWith ((First v -> First v) -> First v -> First v -> First v
forall a b. a -> b -> a
const First v -> First v
forall a. a -> a
id) ([(k, First v)] -> MonoidMap k (First v))
-> ([(k, v)] -> [(k, First v)])
-> [(k, v)]
-> MonoidMap k (First v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, First v)) -> [(k, v)] -> [(k, First v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> First v) -> (k, v) -> (k, First v)
forall a b. (a -> b) -> (k, a) -> (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> First v
forall a. a -> First a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

toList :: Map k v -> [(k, v)]
toList :: forall k v. Map k v -> [(k, v)]
toList = ((k, First v) -> Maybe (k, v)) -> [(k, First v)] -> [(k, v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (First (k, v) -> Maybe (k, v)
forall a. First a -> Maybe a
getFirst (First (k, v) -> Maybe (k, v))
-> ((k, First v) -> First (k, v)) -> (k, First v) -> Maybe (k, v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, First v) -> First (k, v)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => (k, f a) -> f (k, a)
sequenceA) ([(k, First v)] -> [(k, v)])
-> (Map k v -> [(k, First v)]) -> Map k v -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidMap k (First v) -> [(k, First v)]
forall k v. MonoidMap k v -> [(k, v)]
MonoidMap.toList (MonoidMap k (First v) -> [(k, First v)])
-> (Map k v -> MonoidMap k (First v)) -> Map k v -> [(k, First v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MonoidMap k (First v)
forall k v. Map k v -> MonoidMap k (First v)
unMap

delete :: Ord k => k -> Map k v -> Map k v
delete :: forall k v. Ord k => k -> Map k v -> Map k v
delete k
k = MonoidMap k (First v) -> Map k v
forall k v. MonoidMap k (First v) -> Map k v
Map (MonoidMap k (First v) -> Map k v)
-> (Map k v -> MonoidMap k (First v)) -> Map k v -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> MonoidMap k (First v) -> MonoidMap k (First v)
forall k v. Ord k => k -> MonoidMap k v -> MonoidMap k v
MonoidMap.nullify k
k (MonoidMap k (First v) -> MonoidMap k (First v))
-> (Map k v -> MonoidMap k (First v))
-> Map k v
-> MonoidMap k (First v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MonoidMap k (First v)
forall k v. Map k v -> MonoidMap k (First v)
unMap

insert :: Ord k => k -> v -> Map k v -> Map k v
insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v
insert k
k v
v = MonoidMap k (First v) -> Map k v
forall k v. MonoidMap k (First v) -> Map k v
Map (MonoidMap k (First v) -> Map k v)
-> (Map k v -> MonoidMap k (First v)) -> Map k v -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> First v -> MonoidMap k (First v) -> MonoidMap k (First v)
forall k v.
(Ord k, MonoidNull v) =>
k -> v -> MonoidMap k v -> MonoidMap k v
MonoidMap.set k
k (v -> First v
forall a. a -> First a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v) (MonoidMap k (First v) -> MonoidMap k (First v))
-> (Map k v -> MonoidMap k (First v))
-> Map k v
-> MonoidMap k (First v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MonoidMap k (First v)
forall k v. Map k v -> MonoidMap k (First v)
unMap

keysSet :: Map k v -> Set k
keysSet :: forall k v. Map k v -> Set k
keysSet = MonoidMap k (First v) -> Set k
forall k v. MonoidMap k v -> Set k
MonoidMap.nonNullKeys (MonoidMap k (First v) -> Set k)
-> (Map k v -> MonoidMap k (First v)) -> Map k v -> Set k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MonoidMap k (First v)
forall k v. Map k v -> MonoidMap k (First v)
unMap

lookup :: Ord k => k -> Map k v -> Maybe v
lookup :: forall k v. Ord k => k -> Map k v -> Maybe v
lookup k
k = First v -> Maybe v
forall a. First a -> Maybe a
getFirst (First v -> Maybe v) -> (Map k v -> First v) -> Map k v -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> MonoidMap k (First v) -> First v
forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MonoidMap.get k
k (MonoidMap k (First v) -> First v)
-> (Map k v -> MonoidMap k (First v)) -> Map k v -> First v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MonoidMap k (First v)
forall k v. Map k v -> MonoidMap k (First v)
unMap

member :: Ord k => k -> Map k v -> Bool
member :: forall k v. Ord k => k -> Map k v -> Bool
member k
k = k -> MonoidMap k (First v) -> Bool
forall k v. Ord k => k -> MonoidMap k v -> Bool
MonoidMap.nonNullKey k
k (MonoidMap k (First v) -> Bool)
-> (Map k v -> MonoidMap k (First v)) -> Map k v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MonoidMap k (First v)
forall k v. Map k v -> MonoidMap k (First v)
unMap

map :: (v1 -> v2) -> Map k v1 -> Map k v2
map :: forall v1 v2 k. (v1 -> v2) -> Map k v1 -> Map k v2
map v1 -> v2
f = MonoidMap k (First v2) -> Map k v2
forall k v. MonoidMap k (First v) -> Map k v
Map (MonoidMap k (First v2) -> Map k v2)
-> (Map k v1 -> MonoidMap k (First v2)) -> Map k v1 -> Map k v2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (First v1 -> First v2)
-> MonoidMap k (First v1) -> MonoidMap k (First v2)
forall v2 v1 k.
MonoidNull v2 =>
(v1 -> v2) -> MonoidMap k v1 -> MonoidMap k v2
MonoidMap.map ((v1 -> v2) -> First v1 -> First v2
forall a b. (a -> b) -> First a -> First b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v1 -> v2
f) (MonoidMap k (First v1) -> MonoidMap k (First v2))
-> (Map k v1 -> MonoidMap k (First v1))
-> Map k v1
-> MonoidMap k (First v2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v1 -> MonoidMap k (First v1)
forall k v. Map k v -> MonoidMap k (First v)
unMap