{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- 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,

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

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

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

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

import Core.Text.Bytes (Bytes)
import Core.Text.Rope (Rope)
import qualified Data.ByteString as B (ByteString)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import Data.Hashable (Hashable)
import qualified Data.Map.Strict as OrdMap
import qualified Data.Set as OrdSet
import qualified Data.Text as T (Text)
import qualified Data.Text.Lazy as U (Text)
import qualified GHC.Exts 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
[Map κ ν] -> ShowS
Map κ ν -> String
(Int -> Map κ ν -> ShowS)
-> (Map κ ν -> String) -> ([Map κ ν] -> ShowS) -> Show (Map κ ν)
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
(Map κ ν -> Map κ ν -> Bool)
-> (Map κ ν -> Map κ ν -> Bool) -> Eq (Map κ ν)
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)

unMap :: Map κ ν -> HashMap.HashMap κ ν
unMap :: 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 Foldable (Map κ) where
  foldr :: (a -> b -> b) -> b -> Map κ a -> b
foldr a -> b -> b
f b
start (Map HashMap κ a
u) = (a -> b -> b) -> b -> HashMap κ a -> b
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldr a -> b -> b
f b
start HashMap κ a
u
  null :: Map κ a -> Bool
null (Map HashMap κ a
u) = HashMap κ a -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap κ a
u
  length :: Map κ a -> Int
length (Map HashMap κ a
u) = HashMap κ a -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap κ a
u

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

-- |
-- Construct a dictionary with only a single key/value pair.
singletonMap :: Key κ => κ -> ν -> Map κ ν
singletonMap :: κ -> ν -> Map κ ν
singletonMap κ
k ν
v = HashMap κ ν -> Map κ ν
forall κ ν. HashMap κ ν -> Map κ ν
Map (κ -> ν -> HashMap κ ν
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 :: κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue κ
k ν
v (Map HashMap κ ν
u) = HashMap κ ν -> Map κ ν
forall κ ν. HashMap κ ν -> Map κ ν
Map (κ -> ν -> HashMap κ ν -> HashMap κ ν
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 :: κ -> Map κ ν -> Maybe ν
lookupKeyValue κ
k (Map HashMap κ ν
u) = κ -> HashMap κ ν -> Maybe ν
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 :: κ -> Map κ ν -> Bool
containsKey κ
k (Map HashMap κ ν
u) = κ -> HashMap κ ν -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member κ
k HashMap κ ν
u

-- |
instance Key κ => Semigroup (Map κ ν) where
  <> :: Map κ ν -> Map κ ν -> Map κ ν
(<>) (Map HashMap κ ν
u1) (Map HashMap κ ν
u2) = HashMap κ ν -> Map κ ν
forall κ ν. HashMap κ ν -> Map κ ν
Map (HashMap κ ν -> HashMap κ ν -> HashMap κ ν
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 = Map κ ν
forall κ ν. Map κ ν
emptyMap
  mappend :: Map κ ν -> Map κ ν -> Map κ ν
mappend = Map κ ν -> Map κ ν -> Map κ ν
forall a. Semigroup a => a -> a -> a
(<>)

instance Key κ => Exts.IsList (Map κ ν) where
  type Item (Map κ ν) = (κ, ν)
  fromList :: [Item (Map κ ν)] -> Map κ ν
fromList [Item (Map κ ν)]
pairs = HashMap κ ν -> Map κ ν
forall κ ν. HashMap κ ν -> Map κ ν
Map ([(κ, ν)] -> HashMap κ ν
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) = HashMap κ ν -> [(κ, ν)]
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 V α :: *
  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 = Map (K (Map κ ν)) (V (Map κ ν)) -> Map κ ν
forall a. a -> a
id
  intoMap :: Map κ ν -> Map (K (Map κ ν)) (V (Map κ ν))
intoMap = Map κ ν -> Map (K (Map κ ν)) (V (Map κ ν))
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 κ ν
HashMap (K (HashMap κ ν)) (V (HashMap κ ν))
u
  intoMap :: HashMap κ ν -> Map (K (HashMap κ ν)) (V (HashMap κ ν))
intoMap HashMap κ ν
u = HashMap κ ν -> Map κ ν
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) = (κ -> ν -> Map κ ν -> Map κ ν) -> Map κ ν -> HashMap κ ν -> Map κ ν
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey κ -> ν -> Map κ ν -> Map κ ν
forall k a. Ord k => k -> a -> Map k a -> Map k a
OrdMap.insert Map κ ν
forall k a. Map k a
OrdMap.empty HashMap κ ν
HashMap (K (Map κ ν)) (V (Map κ ν))
u
  intoMap :: Map κ ν -> Map (K (Map κ ν)) (V (Map κ ν))
intoMap Map κ ν
o = HashMap κ ν -> Map κ ν
forall κ ν. HashMap κ ν -> Map κ ν
Map ((κ -> ν -> HashMap κ ν -> HashMap κ ν)
-> HashMap κ ν -> Map κ ν -> HashMap κ ν
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
OrdMap.foldrWithKey κ -> ν -> HashMap κ ν -> HashMap κ ν
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert HashMap κ ν
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) = Map κ ν -> [(κ, ν)]
forall k a. Map k a -> [(k, a)]
OrdMap.toList ((κ -> ν -> Map κ ν -> Map κ ν) -> Map κ ν -> HashMap κ ν -> Map κ ν
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey κ -> ν -> Map κ ν -> Map κ ν
forall k a. Ord k => k -> a -> Map k a -> Map k a
OrdMap.insert Map κ ν
forall k a. Map k a
OrdMap.empty HashMap κ ν
HashMap (K [(κ, ν)]) (V [(κ, ν)])
u)
  intoMap :: [(κ, ν)] -> Map (K [(κ, ν)]) (V [(κ, ν)])
intoMap [(κ, ν)]
kvs = HashMap κ ν -> Map κ ν
forall κ ν. HashMap κ ν -> Map κ ν
Map ([(κ, ν)] -> HashMap κ ν
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
[Set ε] -> ShowS
Set ε -> String
(Int -> Set ε -> ShowS)
-> (Set ε -> String) -> ([Set ε] -> ShowS) -> Show (Set ε)
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
(Set ε -> Set ε -> Bool) -> (Set ε -> Set ε -> Bool) -> Eq (Set ε)
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 :: Set ε -> HashSet ε
unSet (Set HashSet ε
u) = HashSet ε
u
{-# INLINE unSet #-}

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

instance Key ε => Semigroup (Set ε) where
  <> :: Set ε -> Set ε -> Set ε
(<>) (Set HashSet ε
u1) (Set HashSet ε
u2) = HashSet ε -> Set ε
forall ε. HashSet ε -> Set ε
Set (HashSet ε -> HashSet ε -> HashSet ε
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 = Set ε
forall ε. Key ε => Set ε
emptySet
  mappend :: Set ε -> Set ε -> Set ε
mappend = Set ε -> Set ε -> Set ε
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 :: Set ε
emptySet = HashSet ε -> Set ε
forall ε. HashSet ε -> Set ε
Set (HashSet ε
forall a. HashSet a
HashSet.empty)

-- |
-- Construct a collection comprising only the supplied element.
singletonSet :: Key ε => ε -> Set ε
singletonSet :: ε -> Set ε
singletonSet ε
e = HashSet ε -> Set ε
forall ε. HashSet ε -> Set ε
Set (ε -> HashSet ε
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 :: ε -> Set ε -> Set ε
insertElement ε
e (Set HashSet ε
u) = HashSet ε -> Set ε
forall ε. HashSet ε -> Set ε
Set (ε -> HashSet ε -> HashSet ε
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 :: ε -> Set ε -> Bool
containsElement ε
e (Set HashSet ε
u) = ε -> HashSet ε -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member ε
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 α :: *
  fromSet :: Set (E α) -> α
  intoSet :: α -> Set (E α)

instance Key ε => Collection (Set ε) where
  type E (Set ε) = ε
  fromSet :: Set (E (Set ε)) -> Set ε
fromSet = Set (E (Set ε)) -> Set ε
forall a. a -> a
id
  intoSet :: Set ε -> Set (E (Set ε))
intoSet = Set ε -> Set (E (Set ε))
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 ε
HashSet (E (HashSet ε))
u
  intoSet :: HashSet ε -> Set (E (HashSet ε))
intoSet HashSet ε
u = HashSet ε -> Set ε
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) = (ε -> Set ε -> Set ε) -> Set ε -> HashSet ε -> Set ε
forall b a. (b -> a -> a) -> a -> HashSet b -> a
HashSet.foldr ε -> Set ε -> Set ε
forall a. Ord a => a -> Set a -> Set a
OrdSet.insert Set ε
forall a. Set a
OrdSet.empty HashSet ε
HashSet (E (Set ε))
u
  intoSet :: Set ε -> Set (E (Set ε))
intoSet Set ε
u = HashSet ε -> Set ε
forall ε. HashSet ε -> Set ε
Set ((ε -> HashSet ε -> HashSet ε) -> HashSet ε -> Set ε -> HashSet ε
forall a b. (a -> b -> b) -> b -> Set a -> b
OrdSet.foldr ε -> HashSet ε -> HashSet ε
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert HashSet ε
forall a. HashSet a
HashSet.empty Set ε
u)

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