path: root/src/Data/Dependent/EnumMap/Strict/Internal.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Dependent.EnumMap.Strict.Internal where

import Data.Bifunctor (bimap)
import Data.Dependent.Sum
import qualified Data.IntMap.Strict as IM
import Data.Kind (Type)
import Data.Proxy
import Data.Some
import Data.Type.Equality
import Text.Show (showListWith)
import Unsafe.Coerce (unsafeCoerce)


data KV k v = forall a. KV !(Enum1Info k) !(v a)

newtype DEnumMap k v = DEnumMap (IM.IntMap (KV k v))

instance (Enum1 k, forall a. Show (k a), forall a. Show (v a))
      => Show (DEnumMap (k :: kind -> Type) (v :: kind -> Type)) where
  showsPrec d mp = showParen (d > 10) $
    showString "fromList " . showListWith (\(k :=> v) -> showsPrec 2 k . showString " :=> " . showsPrec 1 v) (toList mp)

class Enum1 f where
  type Enum1Info f
  fromEnum1 :: f a -> (Int, Enum1Info f)
  toEnum1 :: Int -> Enum1Info f -> Some f

-- * Construction

empty :: DEnumMap k v
empty = DEnumMap IM.empty

singleton :: Enum1 k => k a -> v a -> DEnumMap k v
singleton k v =
  let (i, inf) = fromEnum1 k
  in DEnumMap (IM.singleton i (KV inf v))

-- fromSet

-- ** From Unordered Lists

fromList :: Enum1 k => [DSum k v] -> DEnumMap k v
fromList l =
  DEnumMap (IM.fromList (map (\(k :=> v) -> let (i, inf) = fromEnum1 k in (i, KV inf v)) l))

-- fromListWith
-- fromListWithKey

-- ** From Ascending Lists

-- fromAscList
-- fromAscListWith
-- fromAscListWithKey

fromDistinctAscList :: Enum1 k => [DSum k v] -> DEnumMap k v
fromDistinctAscList l =
  DEnumMap (IM.fromDistinctAscList (map (\(k :=> v) -> let (i, inf) = fromEnum1 k in (i, KV inf v)) l))

-- * Insertion

insert :: Enum1 k => k a -> v a -> DEnumMap k v -> DEnumMap k v
insert k v (DEnumMap m) =
  let (i, inf) = fromEnum1 k
  in DEnumMap (IM.insert i (KV inf v) m)

-- insertWith

insertWithKey :: Enum1 k
              => (k a -> v a -> v a -> v a)
              -> k a -> v a -> DEnumMap k v -> DEnumMap k v
insertWithKey f k v (DEnumMap m) =
  let (i, inf) = fromEnum1 k
  in DEnumMap (IM.insertWithKey
                (\_ (KV _ v1) (KV _ v2) -> KV inf (f k (coe1 v1) (coe1 v2)))
                i (KV inf v) m)

-- insertLookupWithKey

-- * Deletion\/Update

delete :: Enum1 k => k a -> DEnumMap k v -> DEnumMap k v
delete k (DEnumMap m) = DEnumMap (IM.delete (fst (fromEnum1 k)) m)

adjust :: (Enum1 k, TestEquality k) => (v a -> v a) -> k a -> DEnumMap k v -> DEnumMap k v
adjust = adjust' typeCheckK

adjustUnsafe :: Enum1 k => (v a -> v a) -> k a -> DEnumMap k v -> DEnumMap k v
adjustUnsafe = adjust' don'tCheckK

adjust' :: Enum1 k => Checker k a -> (v a -> v a) -> k a -> DEnumMap k v -> DEnumMap k v
adjust' ch f k (DEnumMap m) =
  let (i, _) = fromEnum1 k
  in DEnumMap (IM.adjust (\(KV inf v) -> ch i k inf $ KV inf (f (coe1 v))) i m)

-- adjustWithKey
-- update
-- updateWithKey
-- updateLookupWithKey

alter :: forall k v a. (Enum1 k, TestEquality k) => (Maybe (v a) -> Maybe (v a)) -> k a -> DEnumMap k v -> DEnumMap k v
alter = alter' typeCheckK

alterUnsafe :: forall k v a. Enum1 k => (Maybe (v a) -> Maybe (v a)) -> k a -> DEnumMap k v -> DEnumMap k v
alterUnsafe = alter' don'tCheckK

alter' :: forall k v a. Enum1 k => Checker k a -> (Maybe (v a) -> Maybe (v a)) -> k a -> DEnumMap k v -> DEnumMap k v
alter' ch f k (DEnumMap m) = DEnumMap (IM.alter f' i m)
  where
    (i, inf) = fromEnum1 k

    f' :: Maybe (KV k v) -> Maybe (KV k v)
    f' Nothing = KV inf <$> f Nothing
    f' (Just (KV inf' v)) = ch i k inf' $ KV inf <$> f (Just (coe1 v))

-- alterF

-- * Query
-- ** Lookup

lookup :: (Enum1 k, TestEquality k) => k a -> DEnumMap k v -> Maybe (v a)
lookup = lookup' typeCheckK

lookupUnsafe :: Enum1 k => k a -> DEnumMap k v -> Maybe (v a)
lookupUnsafe = lookup' don'tCheckK

lookup' :: Enum1 k => Checker k a -> k a -> DEnumMap k v -> Maybe (v a)
lookup' ch k (DEnumMap m) =
  let (i, _) = fromEnum1 k
  in (\(KV inf v) -> ch i k inf $ coe1 v) <$> IM.lookup i m

-- (!?)
-- (!)

findWithDefault :: (Enum1 k, TestEquality k) => v a -> k a -> DEnumMap k v -> v a
findWithDefault = findWithDefault' typeCheckK

findWithDefaultUnsafe :: Enum1 k => v a -> k a -> DEnumMap k v -> v a
findWithDefaultUnsafe = findWithDefault' don'tCheckK

findWithDefault' :: Enum1 k => Checker k a -> v a -> k a -> DEnumMap k v -> v a
findWithDefault' ch def k (DEnumMap m) =
  let (i, _) = fromEnum1 k
  in case IM.findWithDefault (KV undefined def) i m of
       KV inf' v -> ch i k inf' $ coe1 v

member :: Enum1 k => k a -> DEnumMap k v -> Bool
member k (DEnumMap m) = IM.member (fst (fromEnum1 k)) m

-- notMember
-- lookupLT
-- lookupGT
-- lookupLE
-- lookupGE

-- ** Size

null :: DEnumMap k v -> Bool
null (DEnumMap m) = IM.null m

size :: DEnumMap k v -> Int
size (DEnumMap m) = IM.size m

-- * Combine

-- ** Union

union :: (Enum1 k, TestEquality k) => DEnumMap k v -> DEnumMap k v -> DEnumMap k v
union = unionWith const  -- if we're checking, we need unionWith anyway, so might as well just delegate here already

-- in the unsafe variant, we can make do with IM.union, which is slightly faster than IM.unionWith, so let's specialise
unionUnsafe :: DEnumMap k v -> DEnumMap k v -> DEnumMap k v
unionUnsafe (DEnumMap m1) (DEnumMap m2) = DEnumMap (IM.union m1 m2)

unionWith :: (Enum1 k, TestEquality k)
          => (forall a. v a -> v a -> v a) -> DEnumMap k v -> DEnumMap k v -> DEnumMap k v
unionWith f (m1 :: DEnumMap k v) = unionWith' (typeCheckSK (Proxy @k)) f m1

unionWithUnsafe :: (forall a. v a -> v a -> v a) -> DEnumMap k v -> DEnumMap k v -> DEnumMap k v
unionWithUnsafe f (m1 :: DEnumMap k v) = unionWith' (don'tCheckSK (Proxy @k)) f m1

unionWith' :: CheckerSplit k
           -> (forall a. v a -> v a -> v a)
           -> DEnumMap k v -> DEnumMap k v -> DEnumMap k v
unionWith' ch f (DEnumMap m1 :: DEnumMap k v) (DEnumMap m2) = DEnumMap (IM.unionWithKey f' m1 m2)
  where
    f' :: Int -> KV k v -> KV k v -> KV k v
    f' i (KV inf1 v1) (KV inf2 v2) = ch i inf1 inf2 $ KV inf1 (f v1 (coe1 v2))

-- unionWithKey
-- unions
-- unionsWith

-- ** Difference

difference :: DEnumMap k v -> DEnumMap k v -> DEnumMap k v
difference (DEnumMap m1) (DEnumMap m2) = DEnumMap (IM.difference m1 m2)

-- (\\)
-- differenceWith
-- differenceWithKey

-- ** Intersection

-- intersection
-- intersectionWith
-- intersectionWithKey

-- ** Disjoint

-- disjoint

-- ** Compose

-- compose

-- ** Universal combining function

-- mergeWithKey

-- * Traversal
-- ** Map

-- map
-- mapWithKey
-- traverseWithKey
-- traverseMaybeWithKey
-- mapAccum
-- mapAccumWithKey
-- mapAccumRWithKey
-- mapKeys
-- mapKeysWith
-- mapKeysMonotonic

-- * Folds

-- foldr
-- foldl
-- foldrWithKey
-- foldlWithKey
-- foldMapWithKey

-- ** Strict folds

-- foldr'
-- foldl'
-- foldrWithKey'
-- foldlWithKey'

-- * Conversion

elems :: DEnumMap k v -> [Some v]
elems (DEnumMap m) = map (\(KV _ v) -> Some v) (IM.elems m)

keys :: Enum1 k => DEnumMap k v -> [Some k]
keys (DEnumMap m) = map (\(k, KV inf _) -> toEnum1 k inf) (IM.assocs m)

-- assocs
-- keysSet

-- ** Lists

toList :: Enum1 k => DEnumMap k v -> [DSum k v]
toList = toAscList

-- ** Ordered lists

toAscList :: Enum1 k => DEnumMap k v -> [DSum k v]
toAscList (DEnumMap m) =
  map (\(i, KV inf v) -> case toEnum1 i inf of Some k -> k :=> coe1 v)
      (IM.toAscList m)

toDescList :: Enum1 k => DEnumMap k v -> [DSum k v]
toDescList (DEnumMap m) =
  map (\(i, KV inf v) -> case toEnum1 i inf of Some k -> k :=> coe1 v)
      (IM.toDescList m)

-- * Filter

-- filter
-- filterWithKey
-- restrictKeys
-- withoutKeys

partition :: (forall a. v a -> Bool) -> DEnumMap k v -> (DEnumMap k v, DEnumMap k v) 
partition f (DEnumMap m) =
  bimap DEnumMap DEnumMap (IM.partition (\(KV _ v) -> f v) m)

partitionWithKey :: Enum1 k => (forall a. k a -> v a -> Bool) -> DEnumMap k v -> (DEnumMap k v, DEnumMap k v)
partitionWithKey f (DEnumMap m) =
  bimap DEnumMap DEnumMap (IM.partitionWithKey (\i (KV inf v) -> case toEnum1 i inf of Some k -> f k (coe1 v)) m)

-- takeWhileAntitone
-- dropWhileAntitone
-- spanAntitone

-- mapMaybe
-- mapMaybeWithKey
-- mapEither
-- mapEitherWithKey

-- split
-- splitLookup
-- splitRoot

-- * Submap

-- isSubmapOf, isSubmapOfBy
-- isProperSubmapOf, isProperSubmapOfBy

-- * Min\/Max

-- lookupMin
-- lookupMax
-- findMin
-- findMax
-- deleteMin
-- deleteMax
-- deleteFindMin
-- deleteFindMax
-- updateMin
-- updateMax
-- updateMinWithKey
-- updateMaxWithKey
-- minView
-- maxView
-- minViewWithKey

maxViewWithKey :: Enum1 k => DEnumMap k v -> Maybe (DSum k v, DEnumMap k v)
maxViewWithKey (DEnumMap m) =
  bimap (\(i, KV inf v) -> case toEnum1 i inf of Some k -> k :=> coe1 v) DEnumMap
    <$> IM.maxViewWithKey m


-- * Helpers

coe1 :: v a -> v b
coe1 = unsafeCoerce

type CheckerSplit k = forall r. Int -> Enum1Info k -> Enum1Info k -> r -> r

typeCheckSK :: forall k proxy. (Enum1 k, TestEquality k) => proxy k -> CheckerSplit k
typeCheckSK _ i inf1 inf2 = case toEnum1 @k i inf1 of Some k -> typeCheckK i k inf2

don'tCheckSK :: proxy k -> CheckerSplit k
don'tCheckSK _ _ _ _ = id

type Checker k a = forall r. Int -> k a -> Enum1Info k -> r -> r

typeCheckK :: (Enum1 k, TestEquality k) => Checker k a
typeCheckK i k1 inf cont
  | Some k2 <- toEnum1 i inf
  , Just Refl <- testEquality k1 k2 = cont
  | otherwise = errorWithoutStackTrace "DEnumMap: keys with same Int but different types"

don'tCheckK :: Checker k a
don'tCheckK _ _ _ = id