Haskell Row Types

Compose a Record with Vinyl!

Dan Fithian - TVision Insights

LambdaConf 2018

https://github.com/dfithian/composite-lambdaconf-2018

Definitions

Nominal Types are types that are defined by name

```
data Bar = Bar { x :: Text, y :: Int }
```
```
data Foo = Foo { x :: Text, y :: Int }
```

Row Types are determined by structure, not by name

```
type Foo = '[ Text, Int ]
```
```
type Bar = '[ Text, Int ]
```

Definitions

Nominal Types

```
data Foo = Foo { x :: Text, y :: Int }
```
```
data Bar = Bar { x :: Text, y :: Int }
```
Foo and Bar are not the same

Row Types

```
type Foo = '[ Text, Int ]
```
```
type Bar = '[ Text, Int ]
```
Foo and Bar are the same

Why are row types useful?

Set operations are easy

Intersection/union

Equivalence

Subset/superset

Why are Row Types useful?

Value equivalence is easy
Projecting fields
Merging fields
Like a tuple, but field order doesn't matter

Vinyl

Row type library in Haskell
HList plus effects

Vinyl

Subset operations
- Type classes - proofs
- Lenses - projection/injection
Effects
- Functors - interpretation

Vinyl

stack ghci example-vinyl

Vinyl - Constructor

-- construct a value
data Rec :: (u -> *) -> [u] -> * where
  RNil :: Rec f '[]
  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)

infixr 7 :&

λ → type X = '[ Char, Int ]
λ → Identity 'a' :& Identity 1 :& RNil :: Rec Identity X
{Identity 'a', Identity 1}

Vinyl - Index/Element

-- prove a type is in a Rec
type family RIndex (r :: k) (rs :: [k]) :: Nat where
  RIndex r (r ': rs) = 'Z
  RIndex r (s ': rs) = 'S (RIndex r rs)

class i ~ RIndex r rs => RElem r rs i where
  rlens :: Proxy r -> Lens' (Rec f rs) (f r) -- proxy not important now

-- no instances here - they're defined by recursing the Nat index
-- through the Rec until 'Z

type (∈) r rs = RElem r rs (RIndex r rs)

λ → type X = '[ Char, Int ]
λ → let x = Identity 'a' :& Identity 1 :& RNil :: Rec Identity X
λ → :{
λ ‖ extractInt :: (Int ∈ rs) => Rec f rs -> f Int
λ ‖ extractInt = view (rlens Proxy)
λ ‖ :}
λ → extractInt x
Identity 1

Vinyl - Image/Subset

-- prove multiple types are in a Rec
type family RImage (rs :: [k]) (ss :: [k]) :: [Nat] where
  RImage '[] ss = '[]
  RImage (r ': rs) ss = RIndex r ss ': RImage rs ss

class is ~ RImage rs ss => RSubset rs ss is where
  rsubset :: Lens' (Rec f ss) (Rec f rs) -- no proxy, inferred for each type

-- instances are defined using rlens for each element in
-- the subset

type (⊆) rs ss = RSubset rs ss (RImage rs ss)

λ → type X = '[ Char, Int ]
λ → let x = Identity 'a' :& Identity 1 :& RNil :: Rec Identity X
λ → type A = '[ Char ]
λ → :{
λ ‖ projectA :: (A ⊆ rs) => Rec f rs -> Rec f A
λ ‖ projectA = view rsubset
λ ‖ :}
λ → projectA x
{Identity 'a'}

Vinyl - Equivalence

-- prove two Recs are the same
type REquivalent rs ss is js = (RSubset rs ss is, RSubset ss rs js)

type (≅) rs ss = REquivalent rs ss (RImage rs ss) (RImage ss rs)

λ → type X = '[ Char, Int ]
λ → let x = Identity 'a' :& Identity 1 :& RNil :: Rec Identity X
λ → type X' = '[ Int, Char ]
λ → :{
λ ‖ reorder :: (a ≅ b) => Rec f a -> Rec f b
λ ‖ reorder = view rsubset
λ ‖ :}
λ → reorder x :: Rec Identity X'
{Identity 1, Identity 'a'}
λ → reorder (reorder x :: Rec Identity X') :: Rec Identity X
{Identity 'a', Identity 1}

Vinyl - Traversals

rtraverse
  :: Applicative h
     => (forall x. f x -> h (g x)) 
     -> Rec f rs -> h (Rec g rs)

λ → type X = '[ Char, Int ]
λ → let x = Identity 'a' :& Identity 1 :& RNil :: Rec Identity X
λ → :{
λ ‖ justInside :: Functor f => f x -> f (Maybe x)
λ ‖ justInside = map Just
λ ‖ 
λ ‖ justOutside :: Functor f => f x -> Maybe (f x)
λ ‖ justOutside = Just
λ ‖ :}
λ → rtraverse justInside x
Identity {Just 1, Just 'a'}
λ → rtraverse justOutside x
Just {Identity 1, Identity 'a'}

Vinyl Example

-- base types here
newtype Username = Username Text deriving Show
newtype Password = Password Text deriving Show
newtype Email = Email Text deriving Show

-- a regular user has a username and password, but no email
type User = '[Username, Password]
type RegisteredUser = '[Email, Username, Password]

Vinyl Example

newtype Username = Username Text deriving Show
newtype Password = Password Text deriving Show
newtype Email = Email Text deriving Show

type User = '[Username, Password]
type RegisteredUser = '[Email, Username, Password]

λ → :kind! Username ∈ RegisteredUser
Username ∈ RegisteredUser :: Constraint 
= RElem Username RegisteredUser ('S 'Z)

λ → :kind! User ⊆ RegisteredUser
User ⊆ RegisteredUser :: Constraint 
= RSubset User RegisteredUser '['S 'Z, 'S ('S 'Z)]

λ → :kind! RegisteredUser ⊆ User
RegisteredUser ⊆ User :: Constraint
= RSubset RegisteredUser User '['S ('S (RIndex Email '[])), 'Z, 'S 'Z]

λ → type User2 = '[Password, Username] -- reordered
λ → :kind! User ≅ User2
User ≅ User2 :: Constraint
= REquivalent User User2 '['S 'Z, 'Z] '['S 'Z, 'Z]

Vinyl Example

-- base types here
newtype Username = Username Text
newtype Password = Password Text
newtype Email = Email Text

-- a regular user has a username and password, but no email
type User = '[Username, Password]
type RegisteredUser = '[Email, Username, Password]

λ → :{
λ ‖ verifyField :: Maybe x -> Maybe (Identity x)
λ ‖ verifyField = map Identity
λ ‖
λ ‖ verifyUser :: Rec Maybe User -> Maybe (Rec Identity User)
λ ‖ verifyUser = rtraverse verifyField
λ ‖ :}
λ → let goodUser = Just (Username "dan") :& Just (Password "*****") :& RNil
λ → verifyUser goodUser
Just {Identity (Username "dan"), Identity (Password "*****")}
λ → let badUser = Nothing :& Just (Password "*****") :& RNil
λ → verifyUser badUser
Nothing

Recap

Proofs
Injection/projection
Interpretation/effects
What's missing?

Usability

(Or, what's wrong with Vinyl?)

Unwieldy operators
- ```
Identity email :& user
```
- Just want to use an HList sometimes!
Can't use row types throughout program
- No JSON (or any other data format) support
- No API support
- No database support

Usability

(Or, how can we improve?)

~~Unwieldy operators~~
- Define better operators
~~Can't use row types throughout program~~
- Figure out a way to identify JSON keys/database columns using row types and effects

Composite Records

Syntactic sugar over Vinyl
Statically defined type identifiers
JSON, Database, REST API support

Composite Records

stack ghci example-composite

Composite Records

newtype (s :: Symbol) :-> a = Val { getVal :: a }

pattern (:*:) :: a -> Rec Identity rs -> Rec Identity ((s :-> a) ': rs)

pattern (:^:) :: Functor f => f a -> Rec f rs -> Rec f ((s :-> a) ': rs)

type Record = Rec Identity

λ → type X = '[ "foo" :-> Char, "bar" :-> Int ]
λ → 
λ → 'a' :*: 1 :*: RNil :: Record X
{Identity foo :-> 'a', Identity bar :-> 1}
λ → 
λ → Just 'a' :^: Nothing :^: RNil :: Rec Maybe X
{Just foo :-> 'a', Nothing}
λ → 
λ → $(withLensesAndProxies [d| type FFoo = "foo" :-> Char |])
λ → -- lots of lenses, except GHCi doesn't do TH well ;P

Composite Aeson

Using Rec to parse JSON
Other composite libraries use similar approaches

Composite Aeson

stack ghci example-composite-aeson

Composite Aeson

import qualified Data.Aeson.BetterErrors as ABE

-- Parse is a Monad with a failure type `e` and a success type `a`
newtype FromField e a =
  FromField { unFromField :: Text -> ABE.Parse e a }

-- a class for parsing a record
class RecordFromJson rs where
  recordFromJson :: Rec (FromField e) rs -> ABE.Parse e (Rec Identity rs)

Composite Aeson

import qualified Data.Aeson.BetterErrors as ABE

newtype FromField e a =
  FromField { unFromField :: Text -> ABE.Parse e a }

-- a class for parsing a record
class RecordFromJson rs where
  recordFromJson :: Rec (FromField e) rs -> ABE.Parse e (Rec Identity rs)

-- inductively define a type class by defining the base case...
instance RecordFromJson '[] where
  recordFromJson _ = pure RNil

-- inductively define a type class by defining the base case...
instance RecordFromJson '[] where
  recordFromJson _ = pure RNil

Composite Aeson

import qualified Data.Aeson.BetterErrors as ABE

newtype FromField e a =
  FromField { unFromField :: Text -> ABE.Parse e a }

-- a class for parsing a record
class RecordFromJson rs where
  recordFromJson :: Rec (FromField e) rs -> ABE.Parse e (Rec Identity rs)

-- inductively define a type class by defining the base case...
instance RecordFromJson '[] where
  recordFromJson _ = pure RNil

-- inductively define a type class by defining the base case...
instance RecordFromJson '[] where
  recordFromJson _ = pure RNil

-- ...and the n + 1 case
instance forall s a rs. (KnownSymbol s, RecordFromJson rs)
  => RecordFromJson (s :-> a ': rs) where
  recordFromJson (FromField aFromField :& fs) =
    (:&)
      <$> (Identity <$> aFromField (pack . symbolVal $ (Proxy :: Proxy s)))
      <*> recordFromJson fs

Composite Aeson

import qualified Data.Aeson.BetterErrors as ABE

newtype Username = Username Text deriving Show
newtype Password = Password Text deriving Show
newtype Email = Email Text deriving Show

-- same as before, but with `:->` now
type RegisteredUser = '[ "user" :-> Username
                       , "password" :-> Password
                       , "email" :-> Email
                       ]

objectKeyAsText :: FromField Text Text
objectKeyAsText = FromField $ \ x -> ABE.key x ABE.asText

registeredUserRecordFromJson :: Rec (FromField Text) RegisteredUser
registeredUserRecordFromJson =
  (Username <$> objectKeyAsText)
    :^: (Password <$> objectKeyAsText)
    :^: (Email <$> objectKeyAsText)
    :^: RNil

Composite Aeson

λ → fromJson = recordFromJson registeredUserRecordFromJson 
λ → good = "{\"user\": \"dan\", \"password\": \"*****\", \"email\": \"dan@dan.dan\"}"
λ → ABE.parse fromJson good
Right { Identity user :-> (Username "dan")
      , Identity password :-> (Password "*****")
      , Identity email :-> (Email "dan@dan.dan") }
λ → 
λ → missingEmail = "{\"user\": \"dan\", \"password\": \"*****\"}"
λ → ABE.parse fromJson missingEmail
Left (BadSchema [] (KeyMissing "email"))
λ → 
λ → badUsername = "{\"user\": 1, \"password\": \"*****\", \"email\": \"dan@dan.dan\"}"
λ → ABE.parse fromJson badUsername
Left (BadSchema [ObjectKey "user"] (WrongType TyString (Number 1.0)))

Recap

Composite provides
- Syntactic sugar over Vinyl
- Statically defined type identifiers
- Inductively defined type classes

Other Composite Libraries

Opaleye
- PostgreSQL database integration
EKG
- Define metrics for an app using row types
Swagger
- Define a Swagger spec for a Servant API

Resources

Vinyl
Composite
Example combining Composite, Servant, Opaleye, Swagger, and EKG