Object that allows using any String newtype as the keys

ObjectMap.purs

module Sentence.Biz.Types.ObjectMap
  ( ObjectMap(..)
  , empty
  , isEmpty
  , size
  , singleton
  , insert
  , lookup
  , toUnfoldable
  , toAscUnfoldable
  , fromFoldable
  , fromFoldableWith
  , fromFoldableWithIndex
  , fromHomogeneous
  , delete
  , pop
  , member
  , alter
  , update
  , mapWithKey
  , filterWithKey
  , filterKeys
  , filter
  , keys
  , values
  , union
  , unionWith
  , unions
  , isSubmap
  , fold
  , foldMap
  , foldM
  , foldMaybe
  , all
  --  , thawST
  --  , freezeST
  --  , runST
  , toArrayWithKey
  ) where

import Prelude

import Data.Array (sortWith, toUnfoldable) as A
import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, forWithIndex_)
import Data.FunctorWithIndex (class FunctorWithIndex)
import Data.Lens.AffineTraversal (affineTraversal)
import Data.Lens.At (class At)
import Data.Lens.Index (class Index)
import Data.Lens.Lens (lens)
import Data.Maybe (Maybe(Just), maybe, maybe')
import Data.Newtype (class Newtype, unwrap)
import Data.Traversable (class Traversable)
import Data.TraversableWithIndex (class TraversableWithIndex)
import Data.Tuple (Tuple(Tuple), fst, uncurry)
import Data.Unfoldable (class Unfoldable)
import Foreign.Object (Object, runST)
import Foreign.Object (toAscUnfoldable) as A
import Foreign.Object as Object
import Foreign.Object.ST (new, poke) as OST
import Pinboard.Shape.Types (ShapeData)
import Prim.Coerce (class Coercible)
import Safe.Coerce (coerce)
import TLDraw.Types (PSShape)
import Type.Row.Homogeneous (class Homogeneous)
import Unsafe.Coerce (unsafeCoerce)
import Web.DOM.Element (id)
import Yoga.JSON (class ReadForeign, class WriteForeign, writeImpl)
import Yoga.JSON (readImpl, writeImpl) as JSON

newtype ObjectMap :: Type -> Type -> Type
newtype ObjectMap k a = ObjectMap (Object a)

derive instance Newtype (ObjectMap key a) _

derive newtype instance (Eq key, Eq a) => Eq (ObjectMap key a)

derive newtype instance (Ord key, Ord a) => Ord (ObjectMap key a)

derive newtype instance (Show key, Show a) => Show (ObjectMap key a)

derive newtype instance Functor (ObjectMap key)

instance Newtype key String => FunctorWithIndex key (ObjectMap key) where
  mapWithIndex = unsafeCoerce Object.mapWithKey

derive newtype instance Foldable (ObjectMap key)

derive newtype instance Semigroup value => Semigroup (ObjectMap key value)

derive newtype instance Monoid value => Monoid (ObjectMap key value)

instance Newtype key String => FoldableWithIndex key (ObjectMap key) where
  foldlWithIndex f = fold (flip f)
  foldrWithIndex f z m = foldr (uncurry f) z (toArrayWithKey Tuple m)
  foldMapWithIndex = foldMap

derive newtype instance Newtype key String => Traversable (ObjectMap key)

fold :: forall key a z. Newtype key String => (z -> key -> a -> z) -> z -> ObjectMap key a -> z
fold = unsafeCoerce Object.fold

values :: forall key a. Newtype key String => ObjectMap key a -> Array a
values = Object.values <<< coerce

toArrayWithKey :: forall key a b. Newtype key String => (key -> a -> b) -> ObjectMap key a -> Array b
toArrayWithKey = unsafeCoerce Object.toArrayWithKey

-- | Create an empty `ObjectMap key a`
empty :: forall key a. Newtype key String => ObjectMap key a
empty = unsafeCoerce Object.empty

-- | Create an `ObjectMap key a` with one key/value pair
singleton :: forall key a. Newtype key String => key -> a -> ObjectMap key a
singleton = unsafeCoerce Object.singleton

-- | Lookup the value for a key in a map
lookup :: forall key a. Newtype key String => key -> ObjectMap key a -> Maybe a
lookup = unsafeCoerce Object.lookup

-- | Test whether a `key` appears as a key in a map
member :: forall key a. Newtype key String => key -> ObjectMap key a -> Boolean
member = unsafeCoerce Object.member

-- | Insert or replace a key/value pair in a map
insert :: forall key a. Newtype key String => key -> a -> ObjectMap key a -> ObjectMap key a
insert = unsafeCoerce Object.insert

-- | Delete a key and value from a map
delete :: forall key a. Newtype key String => key -> ObjectMap key a -> ObjectMap key a
delete = unsafeCoerce Object.delete

-- | Delete a key and value from a map, returning the value
-- | as well as the subsequent map
pop :: forall key a. Newtype key String => key -> ObjectMap key a -> Maybe (Tuple a (ObjectMap key a))
pop = unsafeCoerce Object.pop

-- | Insert, remove or update a value for a key in a map
alter :: forall key a. Newtype key String => (Maybe a -> Maybe a) -> key -> ObjectMap key a -> ObjectMap key a
alter = unsafeCoerce Object.alter

-- | Remove or update a value for a key in a map
update :: forall key a. Newtype key String => (a -> Maybe a) -> key -> ObjectMap key a -> ObjectMap key a
update = unsafeCoerce Object.update

-- | Keeps only the key/value pairs satisfying a predicate
filter :: forall key a. Newtype key String => (a -> Boolean) -> ObjectMap key a -> ObjectMap key a
filter = unsafeCoerce Object.filter

-- | Keeps only the key/value pairs satisfying a predicate which also takes a key

filterWithKey :: forall key a. Newtype key String => (key -> a -> Boolean) -> ObjectMap key a -> ObjectMap key a
filterWithKey = unsafeCoerce Object.filterWithKey

filterKeys :: forall key a. Newtype key String => (key -> Boolean) -> ObjectMap key a -> ObjectMap key a
filterKeys = unsafeCoerce Object.filterKeys

-- | Create an `ObjectMap key a` from a foldable collection of key/value pairs
fromFoldable :: forall f key a. Foldable f => Newtype key String => f (Tuple key a) -> ObjectMap key a
fromFoldable tuples = unsafeCoerce (Object.fromFoldable (unsafeCoerce tuples :: f (Tuple String a)))

-- | Create an `Object a` from a `key`-indexed foldable collection
fromFoldableWithIndex :: forall f key a. FoldableWithIndex key f => Newtype key String => f a -> ObjectMap key a
fromFoldableWithIndex l = unsafeCoerce $ runST do
  s <- OST.new
  forWithIndex_ l \k v -> OST.poke (unwrap k) v s
  pure s

fromFoldableWith :: forall f key a. Foldable f => Newtype key String => (a -> a -> a) -> f (Tuple key a) -> ObjectMap key a
fromFoldableWith f tuples = unsafeCoerce (Object.fromFoldableWith f (unsafeCoerce tuples :: f (Tuple String a)))

-- | Create an `ObjectMap a` from a homogeneous record, i.e. all of the record
-- | fields are of the same type.
fromHomogeneous :: forall r key a. Newtype key String => Homogeneous r a => { | r } -> ObjectMap key a
fromHomogeneous = unsafeCoerce

-- | Get all keys of a map
keys :: forall key a. Newtype key String => ObjectMap key a -> Array key
keys = unsafeCoerce Object.keys

-- | Compute the union of two maps, preferring the first map in the case of duplicate keys.
union :: forall key a. Newtype key String => ObjectMap key a -> ObjectMap key a -> ObjectMap key a
union = unsafeCoerce Object.union

-- | Compute the union of two maps, using the specified function to combine values for duplicate keys.
unionWith :: forall key a. Newtype key String => (a -> a -> a) -> ObjectMap key a -> ObjectMap key a -> ObjectMap key a
unionWith = unsafeCoerce Object.unionWith

-- | Compute the union of a collection of maps
unions :: forall key f a. Newtype key String => Foldable f => f (ObjectMap key a) -> ObjectMap key a
unions = foldl union empty

-- | Returns true if there are no key/value pairs in the map
isEmpty :: forall key a. Newtype key String => ObjectMap key a -> Boolean
isEmpty = unsafeCoerce Object.isEmpty

-- | The number of key/value pairs in a map
size :: forall key a. Newtype key String => ObjectMap key a -> Number
size = unsafeCoerce Object.size

-- | Unfolds a map into a list of key/value pairs
toUnfoldable :: forall key a f. Newtype key String => Unfoldable f => ObjectMap key a -> f (Tuple key a)
toUnfoldable = A.toUnfoldable <<< toArrayWithKey Tuple

-- | Unfolds a map into a list of key/value pairs which is guaranteed to be
-- | sorted by key
toAscUnfoldable :: forall f key a. Ord key => Newtype key String => Unfoldable f => ObjectMap key a -> f (Tuple key a)
toAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< toArrayWithKey Tuple

-- | Apply a function of two arguments to each key/value pair, producing a new map
mapWithKey :: forall key a b. Newtype key String => (key -> a -> b) -> ObjectMap key a -> ObjectMap key b
mapWithKey = unsafeCoerce Object.mapWithKey

-- | Test whether one map contains all of the keys and values contained in another map
isSubmap :: forall key a. Newtype key String => Eq a => ObjectMap key a -> ObjectMap key a -> Boolean
isSubmap map1 map2 = Object.isSubmap (unsafeCoerce map1 :: Object a) (unsafeCoerce map2 :: Object a)

-- | Fold the keys and values of an object, accumulating values using some
-- | `Monoid`.
foldMap :: forall key a m. Newtype key String => Monoid m => (key -> a -> m) -> ObjectMap key a -> m
foldMap f = unsafeCoerce (Object.foldMap ((unsafeCoerce f :: String -> a -> m)))

-- | Fold the keys and values of an object, accumulating values and effects in
-- | some `Monad`.
foldM :: forall key a m z. Newtype key String => Monad m => (z -> key -> a -> m z) -> z -> ObjectMap key a -> m z
foldM f z = unsafeCoerce (Object.foldM ((unsafeCoerce f :: z -> String -> a -> m z)) z)

-- | Fold the keys and values of a map.
-- |
-- | This function allows the folding function to terminate the fold early,
-- | using `Maybe`.
foldMaybe :: forall key a z. Newtype key String => (z -> key -> a -> Maybe z) -> z -> ObjectMap key a -> z
foldMaybe f z = unsafeCoerce (Object.foldMaybe ((unsafeCoerce f :: z -> String -> a -> Maybe z)) z)

-- | Test whether all key/value pairs in a `Object` satisfy a predicate.
all :: forall key a. Newtype key String => (key -> a -> Boolean) -> ObjectMap key a -> Boolean
all f = unsafeCoerce (Object.all ((unsafeCoerce f :: String -> a -> Boolean)))

---------------------------------------------
---- Lens stuff

instance Newtype key String => Index (ObjectMap key v) key v where
  ix k = affineTraversal set pre
    where
    set :: ObjectMap key v -> v -> ObjectMap key v
    set s b = update (\_ -> Just b) k s

    pre :: ObjectMap key v -> Either (ObjectMap key v) v
    pre s = maybe (Left s) Right $ lookup k s

instance Newtype key String => At (ObjectMap key v) key v where
  at k = lens (lookup k) \m -> maybe' (\_ -> delete k m) \v -> insert k v m

-- Serialisation

instance (Newtype key String, WriteForeign a) => WriteForeign (ObjectMap key a) where
  writeImpl obj = JSON.writeImpl (unsafeCoerce obj :: Object a)

instance (Newtype key String, ReadForeign a) => ReadForeign (ObjectMap key a) where
  readImpl fgn = unsafeCoerce (JSON.readImpl fgn :: _ (Object a))