Dict Typing

Solving the Haskell record problem with Data.Constraint.Dict and implicit parameters

Soares Chen

OPLSS - July 2018

The Haskell

Extensible Record Problem

Function Acting on an Environment

data Env = Env {
  siteName :: String, -- e.g. "My Awesome Website"
  apiPrefix :: String, -- e.g. "/api"
  logDir :: String, -- e.g. "/var/log"
  apiSecret :: String, -- e.g. "$ecret"
}

type Result = ...

handleApiRequest :: Env -> Result
handleApiRequest = ...

processReport :: Env -> Result
processReport = ...

a.k.a. Config, Args, Settings, Context, etc

What happen when some code need new parameter?

data Env = Env {
  ...
  fontFamily :: String -- e.g. "Helvetica"
}

-- Don't use fontFamily
handleApiRequest :: Env -> Result
handleApiRequest = ...

-- Uses fontFamily
processReport :: Env -> Result
processReport env = 
  let gen = mkReportGenerator $ fontFamily env 
  in ...

A Global Env Type

  • Every function taking in Env can access all fields
  • Adding new fields affects all code
  • Can we do better?

Side Note for Haskellers

data Env = Env { foo :: String, ... }

myApp :: Env -> Result

myApp :: Reader Env Result

myApp :: ReaderT Env (IO Result)

myApp :: MonadReader Env m => m Result

Non Haskell Solutions

Row Polymorphism

Subtyping

Dynamic Typing

Duct Typing

etc

Haskell Solutions

Ad Hoc Solutions

The Has* / ReaderT design patterns

class HasFoo a where
  getFoo :: a -> String

class Has a ctx where
  get :: ctx -> a

class HasField (x :: Symbol) r a | x r -> a where
  getField :: Proxy# x -> r -> a

Problems with Existing Solutions

  • Manual instance declaration

    • Limited support on auto instance declarations

    • Hard to create new types that extends concrete types

  • Interoperability issues

    • Libraries have to commit to specific type classes / record framework

  • Hard to compose functions with complex constraints

    • Require explicit type annotation

    • MultiParamTypeClasses causes ambiguity in intermediate type variables

  • Easily get into typeclass language extensions hell

    • FlexibleInstances, OverlappingInstances, IncoherentInstances,  
      AllowAmbiguousTypes, FunctionalDependencies, UndecidableInstances, etc

  • Limitations on nested constraint resolution

    • Record contains field with flexible type, satisfying some other constraint

    • Manipulation of record object turning into other types

Dict Typing

Yet Another Solution to the Record Problem

  • Data.Constraint.Dict

  • Implicit Parameters

Introducing

Type Classes and Constraints

class Show a where
  show :: a -> String

escapedShow :: forall a. Show a => a -> String
escapedShow x = let rawStr = show x in
  ... -- do some string escaping

Type Classes and Constraints

class HasFoo a where
  getFoo :: a -> String

data Env = Env { foo :: String, ... }

instance HasFoo Env where
  getFoo = foo

handleFooLike :: forall a. HasFoo a => a -> Result
handleFooLike = ...

Type Classes and Constraints

class HasFoo a where
  getFoo :: a -> String

data Env = { foo :: String, bar :: String, ... }

instance HasFoo Env where
  getFoo = foo

instance HasBar Env where
  getBar = bar

handleFooLike :: forall a. HasFoo a => a -> Result
handleFooLike = ...

handleFooBarLike :: forall a
  . (HasFoo a, HasBar a)
  => a -> Result
handleFooBarLike = ...

Constraint Dictionary

{#- LANGUAGE GADTs -#}
{#- LANGUAGE ConstraintKinds -#}

data Dict :: Constraint -> * where
  Dict :: p => Dict p

showStringDict :: Dict (Show String)
showStringDict = Dict

Constraint Dictionary

escapedShow :: forall a. Dict (Show a) -> a -> String
escapedShow Dict x = 
  let rawStr = show x in ...

escapedStr = escapedShow Dict 3
  • Constructing Dict captures constraint in current static context and reify it as value
  • Pattern matching on Dict brings proof into scope
  • i.e. Constraints become first class

Partial Application

class HasFoo a where
  getFoo :: a -> String

data Env = Env { foo :: String, ... }

instance HasFoo Env where
  getFoo = foo

handleFooLike :: forall a. Dict (HasFoo a) -> a -> Result
handleFooLike Dict x = ...

handleEnv :: Env -> Result
handleEnv = handleFooLike Dict

Learn More

Implicit Parameters

{#- LANGUAGE ImplicitParams #-}

prettyPrint :: 
  (?indentation :: Int) 
  => AST -> String
prettyPrint ast =
  ...
  let ?indentation = ?indentation + 2
  in prettyPrintFn ...
  • Dynamic scoping

  • Act like local constraints

  • Restriction: only one type per named parameter

    • Problematic when consuming multiple environments with similar parameters

Accessors as Implicit Parameters

handleFooLike :: forall a
  . (?getFoo :: a -> String) 
  => a -> Result

data Env = Env { foo :: String }

result = let
  ?getFoo = foo
in
  handleFooLike $ Env { foo = "fooValue" }

Dictionary of

Implicit Parameters

  • Dictionary captures constraints
  • Implicit parameters are constraints
  • What happen when we mix them together?

Capturing and Returing

Implicit Parameters

{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ConstraintKinds #-}

data Env = Env { foo :: String }

envDict :: Dict (?getFoo :: a -> String)
envDict = let ?getFoo = foo in Dict

Dictionary of Implicit Parameters

data Env = Env { foo :: String }

envDict :: Dict (?getFoo :: a -> String)
envDict = let ?getFoo = foo in Dict

handleFooLike :: forall a
  . Dict (?getFoo :: a -> String) 
  -> a -> Result

handleEnv :: Env -> Result
handleEnv = handleFooLike envDict

result = handleEnv $ Env { foo = "fooValue" }

Dict Typing plays well with Lenses

  • Have to use WithLens data wrapper to work around lack of impredicative polymorphism

  • Remaining slides focus on getters only for simplicity

data WithLens s a = WithLens { getLens :: Lens' s a }

handleFooLike :: forall a
  . Dict (?fooLens :: WithLens a String) 
  -> a -> Result

data Env = Env { _foo :: String }
makeLenses ''Env

handleEnv :: Env -> Result
handleEnv = let
  ?fooLens = WithLens foo
in
  handleFooLike Dict

result = handleEnv $ Env { _foo = "fooValue" }

Type checking problems with Dict

handleFooLike :: forall a
  . Dict (?getFoo :: a -> String) 
  -> a -> Result

data Env = Env { foo :: String, bar :: String }

envDict :: Dict (
  ?getFoo :: Env -> String, 
  ?getBar :: Env -> String)
envDict = let
  ?getFoo = foo
  ?getBar = bar
in
  Dict

-- Type Error!
handleEnv :: Env -> Result
handleEnv = handleFooLike envDict

Type checking problems with Dict

  • For any constraint p q, Dict (p, q), Dict (q, p) and Dict p are different types!

dict1 :: Dict (Show String, Show Int)
dict1 = Dict

-- type error!
dict2 :: Dict (Show Int, Show String)
dict2 = dict1

Type Superclass

class Eq a where
  (==) :: a -> a -> Bool

class Eq a => Ord a where
  compare :: a -> a -> Ordering
  • Eq is superclass of Ord
  • Instances of Ord must also be instances of Eq
  • Ord entails Eq
    • If I got an implementation of Ord, I also got an implementation of Eq

Entailment

  • mapDict = “cast” operator for dictionaries

newtype a :- b = Sub (a => Dict b)

mapDict :: (a :- b) -> Dict a -> Dict b
mapDict (Sub q) Dict = q

ordToEq :: forall a. Ord a :- Eq a
ordToEq = Sub Dict

Dict Entailment

  • Dict of set of constraints always entails:

    • Dict of subset of constraints

    • Dict of different order of constraints

handleFooLike :: forall a
  . Dict (?getFoo :: a -> String) 
  -> a -> Result

envDict :: Dict (
  ?getFoo :: Env -> String, 
  ?getBar :: Env -> String)

handleEnv :: Env -> Result
handleEnv = handleFooLike $ mapDict (Sub Dict) envDict

(Safe) Dict Casting

  • (someDict <-> Dict) boilerplates

    • Necessary evil to make dict typing work

infixr 7 <->
(<->) :: forall p q
  . Dict p -> 
  (p => Dict q) 
  -> Dict q
(<->) Dict dict = dict

handleEnv :: Env -> Result
handleEnv = handleFooLike $ 
  envDict <-> Dict

-- More verbose alternative
handleEnv = case envDict of 
  Dict -> handleFooLike Dict

Dict Typing + Combinator Patterns

composeHandler :: forall p q a r
  . Monoid r 
  => (Dict p -> a -> r) -> (Dict q -> a -> r)
  -> Dict (p, q) -> a -> r
composeHandler f g dict =
  let
    f' = f (dict <-> Dict)
    g' = g (dict <-> Dict)
  in
    \x -> (f' x) <> (g' x)

handleFooLike :: forall a. 
  Dict (?getFoo :: a -> String) -> a -> String
handleBarLike :: forall a. 
  Dict (?getBar :: a -> String) -> a -> String

-- handleFooBarLike :: forall a
--   . Dict (?getFoo :: a -> String, ?getBar :: a -> String)
--   -> a -> String
handleFooBarLike = composeHandler handleFooLike handleBarLike

Higher Order Dictionaries

  • Dict + Implicit Parameters > Implicit Parameters
  • Ability to return implicit parameters as values
  • Functions can generate dictionaries based on other dictionaries

Dict Merging

infixr 8 &-&
(&-&) :: forall p q
  . Dict p 
  -> Dict q 
  -> Dict (p, q)
(&-&) Dict Dict = Dict

Default Values

defaultDict :: forall a. Dict (
  ?getFoo :: a -> String, ?getBar :: a -> String)
defaultDict = let
  ?getFoo = \_ -> "default-foo"
  ?getBar = \_ -> "default-bar"
in Dict

data Env = Env { foo :: String }

envDict1 :: Dict (?getFoo :: a -> String)
envDict1 = let ?getFoo = foo in Dict

envDict2 :: Dict (
  ?getFoo :: Env -> String, 
  ?getBar :: Env -> String)
envDict2 = fooBarDict &-& (defaultDict @Env) <-> Dict

Default Values

handleFooBarLike :: forall a
  . Dict (
    ?getFoo :: a -> String, 
    ?getBar :: a -> String) 
  -> a -> Result

-- handleFooBarLike sees: 
--   foo = "foo-value", bar = "default-bar"
-- ... or maybe not. (GHC Bug?)
result = handleFooBarLike envDict2 $ 
  Env { foo = "foo-value" }

Dict Casting bug in GHC?

dict1 :: Dict (?a :: String, ?b :: String, ?c :: String)
dict1 = let ?a = "a1"; ?b = "b1"; ?c = "c1" in Dict

dict2 :: Dict (?c :: String, ?b :: String, ?a :: String)
dict2 = let ?a = "a2"; ?b = "b2"; ?c = "c2" in Dict

dict3 = dict1 &-& dict2

showDict :: Dict (?a :: String, ?b :: String, ?c :: String) -> String
showDict Dict = ?a ++ " " ++ ?b ++ " " ++ ?c

-- castResult1 = "a1 b1 c1"
castResult1 = showDict $ ((dict3 <-> Dict)
  :: Dict (?a :: String, ?b :: String, ?c :: String)) <-> Dict

-- castResult2 = "a2 b2 c2"
castResult2 = showDict $ ((dict3 <-> Dict)
  :: Dict (?c :: String, ?b :: String, ?a :: String)) <-> Dict

-- castResult3 = "a1 b1 c1"
castResult3 = showDict $ ((dict3 <-> Dict)
  :: Dict (?c :: String, ?a :: String, ?b :: String)) <-> Dict

-- castResult4 = "a1 b1 c1"
castResult4 = showDict $ ((dict3 <-> Dict)
  :: Dict (?b :: String, ?a :: String, ?c :: String)) <-> Dict

Dict Casting bug in GHC?

showParam2 :: (?c :: String, ?b :: String, ?a :: String) => String
showParam2 = ?a ++ " " ++ ?b ++ " " ++ ?c

-- castResult5 = "a1 b1 c1"
castResult5 = case dict3 of
  Dict -> showParam2

dict4 :: ((?a :: String, ?b :: String, ?c :: String),
          (?c :: String, ?b :: String, ?a :: String))
         => Dict (?c :: String, ?b :: String, ?a :: String)
dict4 = Dict

-- castResult6 = "a2 b2 c2"
castResult6 = showDict $ (dict3 <-> dict4) <-> Dict

Prototype Inheritance

  • If I know how to get a Foo out of a, I know how to get a Foo out of (a, b)

How to Construct a Prototype Chain?

data Base = Base { foo :: String }
data Ext = Ext { bar :: String }

baseDict :: Dict (?getFoo ::  Base -> String)
baseDict = ...

extDict :: Dict (?getBar :: Ext -> String)
extDict = ...

type Extended = (Base, Ext)

protoDict :: Dict (
  ?getFoo :: Extended -> String,
  ?getBar :: Extended -> String)
protoDict = ???

Can we reuse baseDict and extDict?

Prototype Inheritance

data Prototype (p :: Constraint) e a where
  Prototype :: ((a -> e) -> Dict p) -> Prototype p e a

infixr 8 =&=
(=&=) :: forall p1 p2 e1 e2 a.
  Prototype p1 e1 a
  -> Prototype p2 e2 a
  -> Prototype (p1, p2) (e1, e2) a
(=&=) (Prototype makeDict1) (Prototype makeDict2) =
  Prototype $ \getElement ->
    (makeDict1 (fst . getElement)) &-&
    (makeDict2 (snd . getElement))

runProto :: forall p e. Prototype p e e -> Dict p
runProto (Prototype makeDict) = makeDict id

Prototype Inheritance

fooProto :: forall a
  . Prototype (?getFoo :: a -> String) Env a
fooProto = Prototype $ \getEnv ->
  let ?getFoo = foo . getEnv in Dict

barProto :: forall a
  . Prototype (?getBar :: a -> String) String a
barProto = Prototype $ \getBar ->
  let ?getBar = getBar in Dict

fooBarDict :: Dict (
  ?getFoo :: (String, Env) -> String, 
  ?getBar :: (String, Env) -> String)
fooBarDict = runProto $ barProto =&= fooProto

protoResult = handleFooBarLike fooBarDict
  ("injected-bar", Env { foo = "foo" })

The Case For Dict Typing

  • Using Dicts are not much different from using constraints

    • We already rely on Haskell’s implicit constraint merging / propagation all the time

  • Efficient and predictable performance

    • No type level linked lists

    • Easy to reason

  • Interoperable with third party libraries

    • Polymorphic record by convention

    • Decouples choice of interface vs implementation

    • No need to commit to specific record library

  • Flexible higher order dictionary generation

    • No need to mess with type class extensions

Dict Typing

Implicit parameters of kind Constraint

Constraint Tuple (,)

Dict (?getFoo :: String, p)

 

Dict Typing

Functions taking dictionaries

Dict type

Explicit dict casting

Implicit parameters in dict

Row Polymorphism

Row variables of kind #Type

class Union l r (u :: # Type)

Row (foo :: String | r)

 

ML Modules

ML functors

Signatures

Implicit signature matching

Structures

vs

vs

Summary

Thank you!

Made with Slides.com