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

-- |
-- Copyright: © 2022–2023 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.Maybe
    ( mapMaybe )
import Data.Monoid
    ( First (..) )
import Data.MonoidMap
    ( MonoidMap )
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall k v. (Eq k, Eq v) => Map k v -> Map k v -> Bool
Eq, Map k v -> ()
forall a. (a -> ()) -> NFData a
forall k v. (NFData k, NFData v) => Map k v -> ()
rnf :: Map k v -> ()
$crnf :: forall k v. (NFData k, NFData v) => Map k v -> ()
NFData, NonEmpty (Map k v) -> Map k v
Map k v -> Map k v -> Map k v
forall b. Integral b => b -> Map k v -> Map k v
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k v. Ord k => NonEmpty (Map k v) -> Map k v
forall k v. Ord k => Map k v -> Map k v -> Map k v
forall k v b. (Ord k, Integral b) => b -> Map k v -> Map k v
stimes :: forall b. Integral b => b -> Map k v -> Map k v
$cstimes :: forall k v b. (Ord k, Integral b) => b -> Map k v -> Map k v
sconcat :: NonEmpty (Map k v) -> Map k v
$csconcat :: forall k v. Ord k => NonEmpty (Map k v) -> Map k v
<> :: Map k v -> Map k v -> Map k v
$c<> :: forall k v. Ord k => Map k v -> 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
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
mconcat :: [Map k v] -> Map k v
$cmconcat :: forall k v. Ord k => [Map k v] -> Map k v
mappend :: Map k v -> Map k v -> Map k v
$cmappend :: forall k v. Ord k => Map k v -> Map k v -> Map k v
mempty :: Map k v
$cmempty :: forall k v. Ord k => Map k v
Monoid)

instance (Show k, Show v) => Show (Map k v) where
    show :: Map k v -> String
show = (String
"fromList " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall k v. MonoidMap k (First v) -> Map k v
Map 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 = forall k v. MonoidMap k (First v) -> Map k v
Map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, MonoidNull v) => k -> v -> MonoidMap k v
MonoidMap.singleton k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. MonoidMap k (First v) -> Map k v
Map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Ord k, MonoidNull v) =>
(v -> v -> v) -> [(k, v)] -> MonoidMap k v
MonoidMap.fromListWith (forall a b. a -> b -> a
const forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. MonoidMap k v -> [(k, v)]
MonoidMap.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. MonoidMap k (First v) -> Map k v
Map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => k -> MonoidMap k v -> MonoidMap k v
MonoidMap.nullify k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. MonoidMap k (First v) -> Map k v
Map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Ord k, MonoidNull v) =>
k -> v -> MonoidMap k v -> MonoidMap k v
MonoidMap.set k
k (forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. MonoidMap k v -> Set k
MonoidMap.nonNullKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MonoidMap.get k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. Ord k => k -> MonoidMap k v -> Bool
MonoidMap.nonNullKey k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. MonoidMap k (First v) -> Map k v
Map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v2 v1 k.
MonoidNull v2 =>
(v1 -> v2) -> MonoidMap k v1 -> MonoidMap k v2
MonoidMap.map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v1 -> v2
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Map k v -> MonoidMap k (First v)
unMap