Contact/support | Changelog

First class dictionaris with constraint kinds

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RecordWildCards, PolymorphicComponents #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import GHC.Prim ( Constraint )
import qualified Data.Map    as Map
import qualified Data.IntMap as IntMap
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM


data MapLike (conK :: * -> Constraint) (m :: * -> *) = MapLike 
  { lookup :: (conK (KeyType m)) => KeyType m -> m a -> Maybe a
  , insert :: (conK (KeyType m)) => KeyType m -> a -> m a -> m a
  , empty  :: forall a . m a
  }

type family KeyType m :: *



-- Data.Map
type instance KeyType (Map.Map k) = k
     
mapMap :: MapLike Ord (Map.Map k)
mapMap = MapLike
  { lookup = Map.lookup
  , insert = Map.insert
  , empty  = Map.empty
  }



-- Data.IntMap
type instance KeyType IntMap.IntMap = Int
     
mapIntMap :: MapLike Ord IntMap.IntMap
mapIntMap = MapLike
  { lookup = IntMap.lookup
  , insert = IntMap.insert
  , empty  = IntMap.empty
  }



-- HashMap
type instance KeyType (HM.HashMap k) = k

mapHashMap :: MapLike (Hashable :&&: Eq) (HM.HashMap k)
mapHashMap = MapLike
  { lookup = HM.lookup
  , insert = HM.insert
  , empty  = HM.empty
  }

-- We need AND for constraints of kind (* -> Constraint)
class (c1 t, c2 t) => (:&&:) (c1 :: * -> Constraint)  (c2 :: * -> Constraint) (t :: *)
instance (c1 t, c2 t) => (:&&:) c1 c2 t