{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans -Wno-redundant-constraints #-}

{- |
Convenience wrappers around dictionary and collection types and tools
facilitating conversion between them and various map and set types in
common use in the Haskell ecosystem.
-}
module Core.Data.Structures
    ( -- * Map type
      Map
    , emptyMap
    , singletonMap
    , insertKeyValue
    , containsKey
    , lookupKeyValue
    , removeKeyValue

      -- * Conversions
    , Dictionary (K, V, fromMap, intoMap)

      -- * Set type
    , Set
    , emptySet
    , singletonSet
    , insertElement
    , containsElement
    , removeElement

      -- * Conversions
    , Collection (E, fromSet, intoSet)

      -- * Internals
    , Key
    , unMap
    , unSet
    ) where

import Control.Concurrent qualified as Base (ThreadId)
import Core.Text.Bytes (Bytes)
import Core.Text.Rope (Rope)
import Data.Bifoldable (Bifoldable)
import Data.ByteString qualified as B (ByteString)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as HashSet
import Data.Hashable (Hashable)
import Data.Kind (Type)
import Data.Map.Strict qualified as OrdMap
import Data.Set qualified as OrdSet
import Data.Text qualified as T (Text)
import Data.Text.Lazy qualified as U (Text)
import GHC.Exts qualified as Exts (IsList (..))

-- Naming convention used throughout this file is (Thing u) where u is the
-- underlying structure [from unordered-containers] wrapped in the Thing
-- newtype. Leaves p for our Map and s for our Set in tests.

{- |
A mapping from keys to values.

The keys in a map needs to be an instance of the 'Key' typeclass.
Instances are already provided for many common element types.

'Map' implements 'Foldable', 'Monoid', etc so many common operations such
as 'foldr' to reduce the structure with a right fold, 'length' to get the
number of key/value pairs in the dictionary, 'null' to test whether the
map is empty, and ('<>') to join two maps together are available.

To convert to other dictionary types see 'fromMap' below.

(this is a thin wrapper around __unordered-containers__'s
'Data.HashMap.Strict.HashMap', but if you use the conversion functions to
extract the key/value pairs in a list the list will be ordered according to
the keys' 'Ord' instance)
-}
newtype Map κ ν = Map (HashMap.HashMap κ ν)
    deriving (Int -> Map κ ν -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall κ ν. (Show κ, Show ν) => Int -> Map κ ν -> ShowS
forall κ ν. (Show κ, Show ν) => [Map κ ν] -> ShowS
forall κ ν. (Show κ, Show ν) => Map κ ν -> String
showList :: [Map κ ν] -> ShowS
$cshowList :: forall κ ν. (Show κ, Show ν) => [Map κ ν] -> ShowS
show :: Map κ ν -> String
$cshow :: forall κ ν. (Show κ, Show ν) => Map κ ν -> String
showsPrec :: Int -> Map κ ν -> ShowS
$cshowsPrec :: forall κ ν. (Show κ, Show ν) => Int -> Map κ ν -> ShowS
Show, Map κ ν -> Map κ ν -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall κ ν. (Eq κ, Eq ν) => Map κ ν -> Map κ ν -> Bool
/= :: Map κ ν -> Map κ ν -> Bool
$c/= :: forall κ ν. (Eq κ, Eq ν) => Map κ ν -> Map κ ν -> Bool
== :: Map κ ν -> Map κ ν -> Bool
$c== :: forall κ ν. (Eq κ, Eq ν) => Map κ ν -> Map κ ν -> Bool
Eq, forall m. Monoid m => Map m m -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Map a b -> m
forall c a b. (c -> a -> c) -> (c -> b -> c) -> c -> Map a b -> c
forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> Map a b -> c
forall (p :: * -> * -> *).
(forall m. Monoid m => p m m -> m)
-> (forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m)
-> (forall a c b.
    (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c)
-> (forall c a b.
    (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c)
-> Bifoldable p
bifoldl :: forall c a b. (c -> a -> c) -> (c -> b -> c) -> c -> Map a b -> c
$cbifoldl :: forall c a b. (c -> a -> c) -> (c -> b -> c) -> c -> Map a b -> c
bifoldr :: forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> Map a b -> c
$cbifoldr :: forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> Map a b -> c
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Map a b -> m
$cbifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Map a b -> m
bifold :: forall m. Monoid m => Map m m -> m
$cbifold :: forall m. Monoid m => Map m m -> m
Bifoldable)

unMap :: Map κ ν -> HashMap.HashMap κ ν
unMap :: forall κ ν. Map κ ν -> HashMap κ ν
unMap (Map HashMap κ ν
u) = HashMap κ ν
u
{-# INLINE unMap #-}

{- |
Types that can be used as keys in dictionaries or elements in collections.

To be an instance of 'Key' a type must implement both 'Hashable' and 'Ord'.
This requirement means we can subsequently offer easy conversion
between different the dictionary and collection types you might encounter
when interacting with other libraries.

Instances for this library's 'Rope' and 'Bytes' are provided here, along
with many other common types.
-}
class (Hashable κ, Ord κ) => Key κ

instance Key String

instance Key Rope

instance Key Bytes

instance Key T.Text

instance Key U.Text

instance Key Char

instance Key Int

instance Key B.ByteString

instance Key Base.ThreadId

instance Foldable (Map κ) where
    foldr :: forall a b. (a -> b -> b) -> b -> Map κ a -> b
foldr a -> b -> b
f b
start (Map HashMap κ a
u) = forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldr a -> b -> b
f b
start HashMap κ a
u
    null :: forall a. Map κ a -> Bool
null (Map HashMap κ a
u) = forall k v. HashMap k v -> Bool
HashMap.null HashMap κ a
u
    length :: forall a. Map κ a -> Int
length (Map HashMap κ a
u) = forall k v. HashMap k v -> Int
HashMap.size HashMap κ a
u

{- |
 A dictionary with no key/value mappings.
-}
emptyMap :: Map κ ν
emptyMap :: forall κ ν. Map κ ν
emptyMap = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v. HashMap k v
HashMap.empty)

{- |
 Construct a dictionary with only a single key/value pair.
-}
singletonMap :: Key κ => κ -> ν -> Map κ ν
singletonMap :: forall κ ν. Key κ => κ -> ν -> Map κ ν
singletonMap κ
k ν
v = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton κ
k ν
v)

{- |
Insert a key/value pair into the dictionary. If the key is already present
in the dictionary, the old value will be discarded and replaced with the
value supplied here.
-}
insertKeyValue :: Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue :: forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue κ
k ν
v (Map HashMap κ ν
u) = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert κ
k ν
v HashMap κ ν
u)

{- |
If the dictionary contains the specified key, return the value associated
with that key.
-}
lookupKeyValue :: Key κ => κ -> Map κ ν -> Maybe ν
lookupKeyValue :: forall κ ν. Key κ => κ -> Map κ ν -> Maybe ν
lookupKeyValue κ
k (Map HashMap κ ν
u) = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup κ
k HashMap κ ν
u

{- |
Does the dictionary contain the specified key?
-}
containsKey :: Key κ => κ -> Map κ ν -> Bool
containsKey :: forall κ ν. Key κ => κ -> Map κ ν -> Bool
containsKey κ
k (Map HashMap κ ν
u) = forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member κ
k HashMap κ ν
u

{- |
Remove a key/value pair if present in the dictionary.

@since 0.3.7
-}
removeKeyValue :: Key κ => κ -> Map κ ν -> Map κ ν
removeKeyValue :: forall κ ν. Key κ => κ -> Map κ ν -> Map κ ν
removeKeyValue κ
k (Map HashMap κ ν
u) = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete κ
k HashMap κ ν
u)

instance Key κ => Semigroup (Map κ ν) where
    <> :: Map κ ν -> Map κ ν -> Map κ ν
(<>) (Map HashMap κ ν
u1) (Map HashMap κ ν
u2) = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union HashMap κ ν
u1 HashMap κ ν
u2)

instance Key κ => Monoid (Map κ ν) where
    mempty :: Map κ ν
mempty = forall κ ν. Map κ ν
emptyMap
    mappend :: Map κ ν -> Map κ ν -> Map κ ν
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Key κ => Exts.IsList (Map κ ν) where
    type Item (Map κ ν) = (κ, ν)
    fromList :: [Item (Map κ ν)] -> Map κ ν
fromList [Item (Map κ ν)]
pairs = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [Item (Map κ ν)]
pairs)
    toList :: Map κ ν -> [Item (Map κ ν)]
toList (Map HashMap κ ν
u) = forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap κ ν
u

{- |
Types that represent key/value pairs that can be converted to 'Map's.
Haskell's ecosystem has several such. This typeclass provides an adaptor to
get between them. It also allows you to serialize out to an association
list.

For example, to convert a 'Map' to an \"association list\" of key/value
pairs, use 'fromMap':

@
    answers :: 'Map' 'Rope' 'Int'
    answers = 'singletonMap' \"Life, The Universe, and Everything\" 42

    list :: [('Rope','Int')]
    list = 'fromMap' answers
@

Instances are provided for __containers__'s 'Data.Map.Strict.Map' and
__unordered-containers__'s 'Data.HashMap.Strict.HashMap' in addition to the
instance for @[(κ,ν)]@ lists shown above.
-}

--
-- Getting an instance for [(κ,ν)] was very difficult. The approach
-- implemented below was suggested by Xia Li-yao, @Lysxia was to use
-- type families.
--
-- >   "Maybe you can change your type class to be indexed by the fully
-- >   applied dictionary type, instead of a type constructor * -> * -> *"
--
-- https://stackoverflow.com/questions/53554687/list-instances-for-higher-kinded-types/53556313
--
-- Many thanks for an elegant solution to the problem.
--
class Dictionary α where
    type K α :: Type
    type V α :: Type
    fromMap :: Map (K α) (V α) -> α
    intoMap :: α -> Map (K α) (V α)

instance Key κ => Dictionary (Map κ ν) where
    type K (Map κ ν) = κ
    type V (Map κ ν) = ν
    fromMap :: Map (K (Map κ ν)) (V (Map κ ν)) -> Map κ ν
fromMap = forall a. a -> a
id
    intoMap :: Map κ ν -> Map (K (Map κ ν)) (V (Map κ ν))
intoMap = forall a. a -> a
id

-- | from "Data.HashMap.Strict" (and .Lazy)
instance Key κ => Dictionary (HashMap.HashMap κ ν) where
    type K (HashMap.HashMap κ ν) = κ
    type V (HashMap.HashMap κ ν) = ν
    fromMap :: Map (K (HashMap κ ν)) (V (HashMap κ ν)) -> HashMap κ ν
fromMap (Map HashMap (K (HashMap κ ν)) (V (HashMap κ ν))
u) = HashMap (K (HashMap κ ν)) (V (HashMap κ ν))
u
    intoMap :: HashMap κ ν -> Map (K (HashMap κ ν)) (V (HashMap κ ν))
intoMap HashMap κ ν
u = forall κ ν. HashMap κ ν -> Map κ ν
Map HashMap κ ν
u

-- | from "Data.Map.Strict" (and .Lazy)
instance Key κ => Dictionary (OrdMap.Map κ ν) where
    type K (OrdMap.Map κ ν) = κ
    type V (OrdMap.Map κ ν) = ν
    fromMap :: Map (K (Map κ ν)) (V (Map κ ν)) -> Map κ ν
fromMap (Map HashMap (K (Map κ ν)) (V (Map κ ν))
u) = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey forall k a. Ord k => k -> a -> Map k a -> Map k a
OrdMap.insert forall k a. Map k a
OrdMap.empty HashMap (K (Map κ ν)) (V (Map κ ν))
u
    intoMap :: Map κ ν -> Map (K (Map κ ν)) (V (Map κ ν))
intoMap Map κ ν
o = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
OrdMap.foldrWithKey forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert forall k v. HashMap k v
HashMap.empty Map κ ν
o)

instance Key κ => Dictionary [(κ, ν)] where
    type K [(κ, ν)] = κ
    type V [(κ, ν)] = ν
    fromMap :: Map (K [(κ, ν)]) (V [(κ, ν)]) -> [(κ, ν)]
fromMap (Map HashMap (K [(κ, ν)]) (V [(κ, ν)])
u) = forall k a. Map k a -> [(k, a)]
OrdMap.toList (forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey forall k a. Ord k => k -> a -> Map k a -> Map k a
OrdMap.insert forall k a. Map k a
OrdMap.empty HashMap (K [(κ, ν)]) (V [(κ, ν)])
u)
    intoMap :: [(κ, ν)] -> Map (K [(κ, ν)]) (V [(κ, ν)])
intoMap [(κ, ν)]
kvs = forall κ ν. HashMap κ ν -> Map κ ν
Map (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(κ, ν)]
kvs)

{- |
A set of unique elements.

The element type needs to be an instance of the same 'Key' typeclass that
is used for keys in the 'Map' type above. Instances are already provided
for many common element types.

'Set' implements 'Foldable', 'Monoid', etc so many common operations such
as 'foldr' to walk the elements and reduce them, 'length' to return the
size of the collection, 'null' to test whether is empty, and ('<>') to take
the union of two sets are available.

To convert to other collection types see 'fromSet' below.

(this is a thin wrapper around __unordered-containers__'s
'Data.HashSet.HashSet', but if you use the conversion functions to extract
a list the list will be ordered according to the elements' 'Ord' instance)
-}
newtype Set ε = Set (HashSet.HashSet ε)
    deriving (Int -> Set ε -> ShowS
forall ε. Show ε => Int -> Set ε -> ShowS
forall ε. Show ε => [Set ε] -> ShowS
forall ε. Show ε => Set ε -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Set ε] -> ShowS
$cshowList :: forall ε. Show ε => [Set ε] -> ShowS
show :: Set ε -> String
$cshow :: forall ε. Show ε => Set ε -> String
showsPrec :: Int -> Set ε -> ShowS
$cshowsPrec :: forall ε. Show ε => Int -> Set ε -> ShowS
Show, Set ε -> Set ε -> Bool
forall ε. Eq ε => Set ε -> Set ε -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Set ε -> Set ε -> Bool
$c/= :: forall ε. Eq ε => Set ε -> Set ε -> Bool
== :: Set ε -> Set ε -> Bool
$c== :: forall ε. Eq ε => Set ε -> Set ε -> Bool
Eq)

unSet :: Set ε -> HashSet.HashSet ε
unSet :: forall ε. Set ε -> HashSet ε
unSet (Set HashSet ε
u) = HashSet ε
u
{-# INLINE unSet #-}

instance Foldable Set where
    foldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr a -> b -> b
f b
start (Set HashSet a
u) = forall b a. (b -> a -> a) -> a -> HashSet b -> a
HashSet.foldr a -> b -> b
f b
start HashSet a
u
    null :: forall a. Set a -> Bool
null (Set HashSet a
u) = forall a. HashSet a -> Bool
HashSet.null HashSet a
u
    length :: forall a. Set a -> Int
length (Set HashSet a
u) = forall a. HashSet a -> Int
HashSet.size HashSet a
u

instance Key ε => Semigroup (Set ε) where
    <> :: Set ε -> Set ε -> Set ε
(<>) (Set HashSet ε
u1) (Set HashSet ε
u2) = forall ε. HashSet ε -> Set ε
Set (forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet ε
u1 HashSet ε
u2)

instance Key ε => Monoid (Set ε) where
    mempty :: Set ε
mempty = forall ε. Key ε => Set ε
emptySet
    mappend :: Set ε -> Set ε -> Set ε
mappend = forall a. Semigroup a => a -> a -> a
(<>)

{- |
An empty collection. This is used for example as an inital value when
building up a 'Set' using a fold.
-}
emptySet :: Key ε => Set ε
emptySet :: forall ε. Key ε => Set ε
emptySet = forall ε. HashSet ε -> Set ε
Set (forall a. HashSet a
HashSet.empty)

{- |
Construct a collection comprising only the supplied element.
-}
singletonSet :: Key ε => ε -> Set ε
singletonSet :: forall ε. Key ε => ε -> Set ε
singletonSet ε
e = forall ε. HashSet ε -> Set ε
Set (forall a. Hashable a => a -> HashSet a
HashSet.singleton ε
e)

{- |
Insert a new element into the collection. Since the 'Set' type does not
allow duplicates, inserting an element already in the collection has no
effect.
-}
insertElement :: Key ε => ε -> Set ε -> Set ε
insertElement :: forall ε. Key ε => ε -> Set ε -> Set ε
insertElement ε
e (Set HashSet ε
u) = forall ε. HashSet ε -> Set ε
Set (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert ε
e HashSet ε
u)

{- |
Does the collection contain the specified element?
-}
containsElement :: Key ε => ε -> Set ε -> Bool
containsElement :: forall ε. Key ε => ε -> Set ε -> Bool
containsElement ε
e (Set HashSet ε
u) = forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member ε
e HashSet ε
u

{- |
Remove an element from the collection if present.

@since 0.3.7
-}
removeElement :: Key ε => ε -> Set ε -> Set ε
removeElement :: forall ε. Key ε => ε -> Set ε -> Set ε
removeElement ε
e (Set HashSet ε
u) = forall ε. HashSet ε -> Set ε
Set (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete ε
e HashSet ε
u)

{- |
Types that represent collections of elements that can be converted to
'Set's.  Haskell's ecosystem has several such. This typeclass provides an
adaptor to convert between them.

This typeclass also provides a mechanism to serialize a 'Set' out to a
Haskell list. The list will be ordered according to the 'Ord' instance of
the element type.

Instances are provided for __containers__'s 'Data.Set.Set' and
__unordered-containers__'s 'Data.HashSet.HashSet' in addition to the
instance for @[ε]@ lists described above.
-}
class Collection α where
    type E α :: Type
    fromSet :: Set (E α) -> α
    intoSet :: α -> Set (E α)

instance Key ε => Collection (Set ε) where
    type E (Set ε) = ε
    fromSet :: Set (E (Set ε)) -> Set ε
fromSet = forall a. a -> a
id
    intoSet :: Set ε -> Set (E (Set ε))
intoSet = forall a. a -> a
id

-- | from "Data.HashSet"
instance Key ε => Collection (HashSet.HashSet ε) where
    type E (HashSet.HashSet ε) = ε
    fromSet :: Set (E (HashSet ε)) -> HashSet ε
fromSet (Set HashSet (E (HashSet ε))
u) = HashSet (E (HashSet ε))
u
    intoSet :: HashSet ε -> Set (E (HashSet ε))
intoSet HashSet ε
u = forall ε. HashSet ε -> Set ε
Set HashSet ε
u

-- | from "Data.Set"
instance Key ε => Collection (OrdSet.Set ε) where
    type E (OrdSet.Set ε) = ε
    fromSet :: Set (E (Set ε)) -> Set ε
fromSet (Set HashSet (E (Set ε))
u) = forall b a. (b -> a -> a) -> a -> HashSet b -> a
HashSet.foldr forall a. Ord a => a -> Set a -> Set a
OrdSet.insert forall a. Set a
OrdSet.empty HashSet (E (Set ε))
u
    intoSet :: Set ε -> Set (E (Set ε))
intoSet Set ε
u = forall ε. HashSet ε -> Set ε
Set (forall a b. (a -> b -> b) -> b -> Set a -> b
OrdSet.foldr forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert forall a. HashSet a
HashSet.empty Set ε
u)

instance Key ε => Collection [ε] where
    type E [ε] = ε
    fromSet :: Set (E [ε]) -> [ε]
fromSet (Set HashSet (E [ε])
u) = forall a. Set a -> [a]
OrdSet.toList (forall b a. (b -> a -> a) -> a -> HashSet b -> a
HashSet.foldr forall a. Ord a => a -> Set a -> Set a
OrdSet.insert forall a. Set a
OrdSet.empty HashSet (E [ε])
u)
    intoSet :: [ε] -> Set (E [ε])
intoSet [ε]
es = forall ε. HashSet ε -> Set ε
Set (forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [ε]
es)