Language/Symantic/Type/Map.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GADTs #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE PatternSynonyms #-}
   7 {-# LANGUAGE ScopedTypeVariables #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9 {-# OPTIONS_GHC -fno-warn-orphans #-}
  10 module Language.Symantic.Type.Map where
  11
  12 import Data.Proxy
  13 import Data.Map.Strict as Map
  14
  15 import Language.Symantic.Type.Common
  16
  17 -- * Type 'Type_Map'
  18 -- | The 'Map' type.
  19 type Type_Map = Type_Type2 (Proxy Map)
  20
  21 type instance Constraint2_of (Proxy Map)
  22  = Constraint2_Map
  23
  24 {- FIXME: Could not deduce (Ord k) arising from a pattern…
  25 pattern Type_Map
  26  :: Ord k => root k -> root a
  27  -> Type_Type2 (Proxy Map) root (Map k a)
  28 pattern Type_Map k a
  29  = Type_Type2 Proxy k a
  30 -}
  31
  32 -- ** Class 'Constraint2_Map'
  33 class Constraint2_Map k a
  34 instance Ord k => Constraint2_Map k a
  35
  36 instance -- String_from_Type
  37  String_from_Type root =>
  38  String_from_Type (Type_Map root) where
  39         string_from_type (Type_Type2 _ k a) =
  40                 "Map (" ++ string_from_type k ++ ")"
  41                  ++ " (" ++ string_from_type a ++ ")"
  42
  43 -- | Inject 'Type_Map' within a root type.
  44 type_map
  45  :: forall root h_k h_a.
  46  (Lift_Type_Root Type_Map root, Ord h_k)
  47  => root h_k -> root h_a
  48  -> root (Map h_k h_a)
  49 type_map k a = lift_type_root (Type_Type2 Proxy k a
  50          ::Type_Map root (Map h_k h_a))