Coverting tuples to lists

Let's say you wanted to convert pairs to lists of Strings

pairToStringList :: (Show a, Show b) => (a, b) -> [String]
pairToStringList (a, b) = [show a, show b]

*Main> pairToStringList (True, Just 3)
["True","Just 3"]

Now say you want to convert a pair of Enums to a list of Ints

pairToIntList :: (Enum a, Enum b) => (a, b) -> [Int]
pairToIntList (a, b) = [fromEnum a, fromEnum b]

Can we generalize this function? Would like to say:

pairToList conv (a, b) = [conv a, conv b]
pairToList show (True, Just 3)   -- error

Unfortunately, can't pass methods as arguments, only functions
```
pairToList :: (a -> b) -> (a, a) -> [b]
```

Polymorphism with fundeps

Let's represent ad hoc polymorphic methods with a class

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

class Function f a b | f a -> b where
    funcall :: f -> a -> b
instance Function (a -> b) a b where
    funcall = id

pairToList :: (Function f a c, Function f b c) =>
              f -> (a, b) -> [c]
pairToList f (a, b) = [funcall f a, funcall f b]

Use placeholder singleton types to represent particular methods

data ShowF = ShowF
instance (Show a) => Function ShowF a [Char] where
    funcall _ = show

data FromEnumF = FromEnumF
instance (Enum a) => Function FromEnumF a Int where
    funcall _ = fromEnum

`Function` in action

Now singleton types act like method arguments:

*Main> pairToList ShowF (True, 3)
["True","3"]
*Main> pairToList FromEnumF (False, 7)
[0,7]

Now, what if you wanted tupleToList for arbitrary n-tuples?
- Can auto-generate instances for a generic tuple fold, e.g.:
```
class TupleFoldr f z t r | f z t -> r where
    tupleFoldr :: f -> z -> t -> r
```
- Works okay for small tuples, craps out around 10-tuple without larger -fcontext-stack argument
Unfortunately, I'm temporarily out of compile-time tricks
- An alternative is to use run-time type information (RTTI)
- RTTI easier to reason about, but adds runtime overhead and errors
- We will come back to static tricks at end of lecture

`DeriveDataTypeable` extension

Haskell allows six classes to be automatically derived
- Show, Read, Eq, Ord, Bounded, Enum
DeriveDataTypeable extension adds two more: Typeable, Data
```
data MyType = Con1 Int | Con2 String deriving (Typeable, Data)
```
- These types encode run-time type information in various ways
- Data requires that inner types (Int, String) also have instances
- Typeable requires any type parameters to have instances
```
-- MyTyCon only typeable when a is
data MyTyCon a = MyTyCon a deriving (Typeable, Data)
```
- Most standard library types have Typeable and Data instances
Provide programming approach known as "scrap your boilerplate"
- GHC's support described by two papers: [Boilerplate1], [Boilerplate2]

The `Typeable` class

import Data.Typeable to get Typeable class:

class Typeable a where
    typeOf :: a -> TypeRep -- Note: never evaluates argument

data TypeRep -- Opaque, but instance of Eq, Ord, Show, Typeable

This allows us to compare types for equality

rtTypeEq :: (Typeable a, Typeable b) => a -> b -> Bool
rtTypeEq a b = typeOf a == typeOf b

*Main> rtTypeEq True False
True
*Main> rtTypeEq True 5
False

Big Whoop!
- Couldn't we already do this at compile time with OverlappingInstances?
- Doing it dynamically is less exciting, but different
- And allows one very important function...

Type Casting

GHC has a function unsafeCoerce
```
unsafeCoerce :: a -> b
```
- And note: it doesn't just return ⊥
- If the name doesn't scare you, the type signature should

Let's use Typeable to make a safe cast function

cast :: (Typeable a, Typeable b) => a -> Maybe b
cast a = fix $ \ ~(Just b) -> if typeOf a == typeOf b
                              then Just $ unsafeCoerce a
                              else Nothing

*Main> cast "hello" :: Maybe String
Just "hello"
*Main> cast "hello" :: Maybe Int
Nothing

Safe if typeOf on two different types always returns different TypeReps
Guaranteed by deriving (Typeable); SafeHaskell disallows manual instances

Generalized casting

To cast monadic computations, etc., use generalized cast, gcast:

import Data.Maybe (fromJust)

gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
gcast ca = mcr
  where mcr = if typeOf (unc ca) == typeOf (unc $ fromJust mcr)
              then Just $ unsafeCoerce ca
              else Nothing
        unc :: c x -> x
        unc = undefined

*Main> fromJust $ gcast (readFile "/etc/issue") :: IO String
"\nArch Linux \\r  (\\n) (\\l)\n\n"
*Main> fromJust $ gcast (readFile "/etc/issue") :: IO Int
*** Exception: Maybe.fromJust: Nothing

Note undefined function unc in definition of gcast
- Common idiom--poses no problem because typeOf is not strict
- Recall context Typeable b => is like a hidden argument; often use undefined functions with type signatures to unpack types and get dictionaries

Using `Typeable`: `mkT` [Boilerplate1]

mkT ("make transformation") behaves like id except on one type

mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a

Example:

newtype Salary = Salary Double deriving (Show, Data, Typeable)

raiseSalary :: (Typeable a) => a -> a
raiseSalary = mkT $ \(Salary s) -> Salary (s * 1.04)

*Main> raiseSalary ()
()
*Main> raiseSalary 7
7
*Main> raiseSalary (Salary 7)
Salary 7.28

Exercise: implement mkT
- Hint: The function type (->) is Typeable, so Data.Typeable exports:
```
instance (Typeable a, Typeable b) => Typeable (a -> b) where ...
```

Solution

mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT f a = case cast f of Just g  -> g a
                         Nothing -> a

Note the magic of Haskell's type inference
- g is applied to a, so must have type a -> a
- Hence cast f must have type Maybe (a -> a)
- Hence compiler knows to use Typeable dictionary of (b -> b) for argument, and dictionary (a -> a) for return of cast
[Jones] has detailed explanation of Haskell's type inference

Note, a fancier implementation could use standard maybe function

maybe :: b -> (a -> b) -> Maybe a -> b
maybe b _ Nothing  = b
maybe _ f (Just a) = f a

mkT :: (Typeable a, Typeable b) => (b -> b) -> (a -> a)
mkT f = maybe id id $ cast f

Using `Typeable`: `mkQ` [Boilerplate1]

Function that computes over one type or returns default val:

mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ defaultVal fn a = ...

mkQ stands for "make query"

Example

salaryVal :: Typeable a => a -> Double
salaryVal = mkQ 0 $ \(Salary s) -> s

*Main> salaryVal ()
0.0
*Main> salaryVal 7
0.0
*Main> salaryVal (Salary 7)
7.0

Exercise: implement mkQ

Solution

mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ defaultVal fn a = case cast a of
                        Just b -> fn b
                        Nothing -> defaultVal

Or if you want to get fancy:

mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ defaultVal fn = maybe defaultVal fn . cast

Functions on multiple types: `extQ`

mkQ only works for one type

Let's extend mkQ's output to work on another type [Boilerplate1]

extQ :: (Typeable a, Typeable b) =>
        (a -> r) -> (b -> r) -> a -> r
extQ q f a = case cast a of
               Just b -> f b
               Nothing -> q a

Now can cascade multiple one-type query functions

myShow :: Typeable a => a -> String
myShow = mkQ "unknown type" (show :: Int -> String)
         `extQ` (show :: Bool -> String)
         `extQ` (show :: Integer -> String)
         `extQ` (const "no floating point" :: Double -> String)

Recall default associatifity is left (infixl 9 `extQ`)
Kind of tedious, but could approximate goal of tupleToList at beginning of lecture if tuples contain limited number of types

`ExistentialQuantification` extension

Lets you introduce type variables on right side of data declaration
```
{-# LANGUAGE ExistentialQuantification #-}
data Step s a = Done | Skip !s | Yield !a !s
data Stream a = forall s. Stream (s -> Step s a) !s                
```
- Given a value of type Stream a, there exists a type s such that...
  But syntax uses forall, not exists, to avoid introducing new keyword
- Very safe extension (Control.Exception relies on it)
Don't confuse with Rank2Types, where forall means for all types s:
```
data Stream a = Stream (forall s. s -> Step s a)
```

Contexts on existential variables like hidden dictionary fields

data Showable = forall a. (Show a) => Showable a
instance Show Showable where
    show (Showable a) = "Showable " ++ show a

A Showable value has both a value of type a, and a dictionary for Show

Example: Dynamic type

Data.Dynamic has type Dynamic, which can hold anything Typeable

data Dynamic  -- opaque type
toDyn :: Typeable a => a -> Dynamic
fromDynamic :: Typeable a => Dynamic -> Maybe a

Actual implementation slightly gross
- Uses unsafeCoerce to coerce everything to a placeholder Obj type

But easy to implement safely with ExistentialQuantification:

data Dynamic = forall a. Typeable a => Dynamic a

toDyn :: Typeable a => a -> Dynamic
toDyn = Dynamic

fromDynamic :: Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic a) = cast a

Example: Extensible exceptions [Marlow]

GHC runtime implements primitive, unsafe exceptions
```
raise# :: a -> b
catch# :: IO a -> (b -> IO a) -> IO a  -- slight simplification
```
- Must ensure that, as used, b is always same type, otherwise get unsafe coercion
In reality, want many exception types, organized into a hierarchy

Control.Exception implements safe, hierarchical exceptions

raise# and catch# only ever called with one type: SomeException

class (Typeable e, Show e) => Exception e where
    toException :: e -> SomeException
    toException = SomeException                 -- default impl
    fromException :: SomeException -> Maybe e
    fromException (SomeException e) = cast e    -- default impl

data SomeException = forall e. Exception e => SomeException e
    deriving Typeable  -- note use of ExistentialQuantification
instance Show SomeException where
    show (SomeException e) = show e

Throwing and catching exceptions

class (Typeable e, Show e) => Exception e where
    toException :: e -> SomeException
    fromException :: SomeException -> Maybe e

To throw an exception, first convert it to type SomeException

throw :: Exception e => e -> a
throw e = raise# (toException e)

To catch an exception, must ensure it matches desired type

-- Define catchX because catch#'s real type more complicated
catchX :: IO a -> (b -> IO a) -> IO a
catchX (IO a) handler = IO $ catch# a (unIO . handler)

catch :: (Exception e) => IO a -> (e -> IO a) -> IO a
catch action handler = catchX action handler'
    where handler' se =
            maybe (throwIO se) handler $ fromException se

Note handler makes fromException se use e's Exception dictionary

Making hierarchical exceptions

Easy to add your own top-level exception type

data MyException = MyException deriving (Show, Typeable)
instance Exception MyException -- use default methods

But you can also create a hierarchy of exception types

data AppError = forall e. Exception e => AppError e
                deriving (Typeable)
instance Show AppError where show (AppError e) = show e
instance Exception AppError

data Error1 = Error1 deriving (Show, Typeable)
instance Exception Error1 where
    toException = toException . AppError
    fromException se = do  -- using Maybe as a Monad here
      AppError e <- fromException se
      cast e

-- Now can do the same for Error2, and catch both as AppError

Let's you catch just Error1, or any AppError

The `Data` class

class Typeable a => Data a where ...

Data class allows generic traversal and construction of data structures

Defines gfoldl and gunfold methods like this

data T a b = C1 a b | C2 deriving (Typeable, Data)

gfoldl k z (C1 a b) = z C1 `k` a `k` b
gfoldl k z C2       = z C2

toConstr (C1 _ _) = ...     -- encodes constructor number
toConstr C2       = ...
gunfold k z c = case constrIndex c of
                    1 -> k (k (z C1))
                    2 -> z C2

Now can work over all sized tuples! But:
- Once you introduce types, things get uglier [cosmetic]
- The only dictionaries available are Data and Typeable [fundamental]
- All the runtime type checking is slow [fundamental]

Can we do it at compile time?

Alternative: push generic programming to compile time [Magalhães]
Let's look at a simplified implementation
- wget cs240h.stanford.edu/metadata.hs

High-level idea: Say you auto-derived instances of Show-like class:

class MyShow a where myShow :: a -> String

instance MyShow MyType where myShow = genericMyShow

Introduce generic MetaData class for which compiler can generate instance

class MetaData d m | d -> m, m -> d where -- not what GHC does
  fromData :: d -> m
  toData :: m -> d

And a MyShow-specific meta-class, such that?

class MetaMyShow a where metaMyShow :: a -> String
genericMyShow :: (MetaData d m, MetaMyShow m) => d -> String
genericMyShow = metaMyShow . fromData

`DefaultSignatures` extension

We can do even better using DefaultSignatures extension
Allows default methods that don't work for all instances

{-# LANGUAGE DefaultSignatures #-}

class MyShow a where
  myShow :: a -> String
  default myShow :: (MetaData a m, MetaMyShow m) => a -> String
  myShow = genericMyShow

Makes it even easier to declare instances

instance MyShow MyType

Let's see how we could design such a MetaData class
- wget cs240h.stanford.edu/metadata.hs

`DeriveGeneric` extension

Compiler supports single Generic class that converts any datatype to a Rep that can be computed over generically:

{-# LANGUAGE TypeFamilies #-}

class Generic a where
  type Rep a :: * -> *
  from :: a -> Rep a x
  to :: Rep a x -> a

type Rep uses extension called TypeFamilies. Can read above as:

class Generic a rep | a -> rep where
    from :: a -> rep x
    to :: rep x -> a

Like our simpler example, except everything of kind ∗ → ∗
- Why? Maybe so you need a Ph.D. to use the extension?
- (Allegedly will someday facilitate generic types of kind ∗ → ∗, so can make generic Functor-like instances)

`Rep` of a unit type

{-# LANGUAGE DeriveGeneric, TypeFamilies, TypeOperators,
    FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

import GHC.Generics

data X = X  -- because we are dealing with types of kind * -> *
undef2 :: mi c f p -> f p
undef2 _ = undefined

-- A unit type has one constructor and no arguments
data T1 = C1 deriving (Show, Generic)

*Main> :t from C1
from C1 :: Rep T1 x
*Main> :t (undefined :: Rep T1 X)
(undefined :: Rep T1 X) :: D1 Main.D1T1 (C1 Main.C1_0T1 U1) X
*Main> datatypeName (from C1)
"T1"
*Main> moduleName (from C1)
"Main"
*Main> conName $ undef2 (from C1)
"C1"

`GHC.Generics` contents (part 1)

{-# LANGUAGE TypeFamilies, KindSignatures, TypeOperators #-}

-- | Unit: used for constructors without arguments
data U1 p = U1

-- | Meta-information (constructor names, etc.)
newtype M1 i c f p = M1 { unM1 :: f p }

-- | Three flavors of meta-information for variable i
data D; type D1 = M1 D -- c instance of Datatype, f is C1 (or :+:)
data C; type C1 = M1 C -- c instance of Constructor, f is S1 (or :*:)
data S; type S1 = M1 S -- c instance of Selector, f is U1 (or Rec0)

class Datatype d where
  datatypeName :: t d (f :: * -> *) a -> String
  moduleName   :: t d (f :: * -> *) a -> String
class Constructor c where
  conName :: t c (f :: * -> *) a -> String
class Selector s where
  selName :: t s (f :: * -> *) a -> String

Types with constructor arguments

data T2 = C2 { t2a :: Bool } deriving (Show, Generic)
data T3 = C3 { t3a :: Bool, t3b :: Bool } deriving (Show, Generic)

*Main> :t (undefined :: Rep T2 X)
(undefined :: Rep T2 X)
  :: D1 Main.D1T2 (C1 Main.C1_0T2 (S1 Main.S1_0_0T2 (Rec0 Bool))) X
*Main> -- This was U1 for type T1 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
*Main> conName (undef2 $ from $ C2 True)
"C2"
*Main> selName (undef2 $ undef2 $ from $ C2 True)
"t2a"
*Main> :t (undefined :: Rep T3 X)
(undefined :: Rep T3 X)
  :: D1
       Main.D1T3
       (C1
          Main.C1_0T3
          (S1 Main.S1_0_0T3 (Rec0 Bool) :*: S1 Main.S1_0_1T3 (Rec0 Bool)))
       X

Note selectors are one feature our simpler example didn't have
- Let's you pick out record names from types

`GHC.Generics` contents (part 2)

-- Used to glue multiple constructor arguments together
data (:*:) f g p = f p :*: g p
infixr 6 :*:

-- Used to represent a type with multiple constructors
data (:+:) f g p = L1 { unL1 :: f p } | R1 { unR1 :: g p }
infixr 5 :+:

-- Used to hold actual concrete values of constructor arguments
newtype K1 i c p = K1 { unK1 :: c }
type Rec0 = K1 R

-- From two slides ago:
data U1 p = U1 -- Unit constructors (no arguments)
newtype M1 i c f p = M1 { unM1 :: f p }
data D; type D1 = M1 D -- c instance of Datatype, f is C1 or :+:
data C; type C1 = M1 C -- c instance of Constructor, f is S1 or :*:
data S; type S1 = M1 S -- c instance of Selector, f is U1 or Rec0

Again, ignore parameter p (there to make types of kind ∗ → ∗)
M1 exists so a single traversal method can skip over D1, C1, and S1
Could say newtype Rec0 c p = K1 c, but some instances use K1 P

What would a `Generic` instance look like?

data T a b = C1 a b | C2 deriving (Show, Generic)

data T_
instance Datatype T_ where
    datatypeName _ = "T"
    moduleName _ = "Main"

data T_C1_
data T_C2_
instance Constructor T_C1_ where conName _ = "C1"
instance Constructor T_C2_ where conName _ = "C2"

type Rep0T_ a_0 b_1 = D1 T_
  (C1 T_C1_ (S1 NoSelector (Rec0 a_0) :*: S1 NoSelector (Rec0 b_1))
   :+: (C1 T_C2_ U1))

instance Generic (T a_0 b_1) where
    type Rep (T a_0 b_1) = Rep0T_ a_0 b_1
    from (C1 f0 f1) = M1 (L1 (M1 (M1 (K1 f0) :*: M1 (K1 f1))))
    from (C2)       = M1 (R1 (M1 U1))
    to (M1 (L1 (M1 (M1 (K1 f0) :*: M1 (K1 f1))))) = C1 f0 f1
    to (M1 (R1 (M1 U1)))                          = C2

How can we use this?

Say we are defining our own Show-like class

class MyShow a where myShow :: a -> String
instance MyShow [Char] where myShow = show
instance MyShow Int where myShow = show

Want it to work with all user-defined data types

Let's define a class Show1 to deal with annoying p parameters

{-# LANGUAGE FlexibleInstances, UndecidableInstances,
  OverlappingInstances, TypeSynonymInstances, TypeOperators,
  TypeFamilies, TemplateHaskell, FlexibleContexts #-}

class MyShow1 f where myShow1 :: f p -> String

And let's define generic traversal methods

instance (MyShow1 f) => MyShow1 (M1 i c f) where  -- for D1, S1
    myShow1 m1 = myShow1 (unM1 m1)
instance (MyShow1 f, MyShow1 g) => MyShow1 (f :+: g) where
    myShow1 (L1 a) = myShow1 a
    myShow1 (R1 a) = myShow1 a

Non-generic instances of `MyShow1`

When we hit a constructor, want to print the name

instance (Constructor c, MyShow1 f) => MyShow1 (C1 c f) where
    myShow1 m1 = conName m1 ++ myShow1 (unM1 m1)

We're using OverlappingInstances, since already have M1 instance

When we have no constructor args, don't show anything
```
instance MyShow1 U1 where myShow1 _ = ""
```

When we have multiple constructor args, show them all

instance (MyShow1 f, MyShow1 g) => MyShow1 (f :*: g) where
    myShow1 (fp :*: gp) = myShow1 fp ++ myShow1 gp

When you hit the actual value, show it
```
instance (MyShow c) => MyShow1 (K1 i c) where
    myShow1 k1 = ' ' : myShow (unK1 k1)
```
- Now we're calling myShow, which we haven't yet defined for many types

Implementing a generic `MyShow`

Now can define generic MyShow in terms of MyShow1

instance (Generic a, MyShow1 (Rep a)) => MyShow a where
    myShow a = myShow1 $ from a

Can we avoid OverlappingInstances?

Could have defined separate D1, S1 instances of Show1 (easy)
Could have avoided completely generic instance
Recommended use is just to define a function myShowDefault, then

myShowDefault :: (Generic a, MyShow1 (Rep a)) => a -> String
myShowDefault a = myShow1 $ from a

instance MyShow T1 where myShow = myShowDefault
instance MyShow T2 where myShow = myShowDefault
instance MyShow T3 where myShow = myShowDefault
...

There's still the problem of different behavior for [Char] vs. [a]

Coverting tuples to lists

Polymorphism with fundeps

Function in action

DeriveDataTypeable extension

The Typeable class

Type Casting

Generalized casting

Using Typeable: mkT [Boilerplate1]

Solution

Using Typeable: mkQ [Boilerplate1]

Solution

Functions on multiple types: extQ

ExistentialQuantification extension

Example: Dynamic type

Example: Extensible exceptions [Marlow]

Throwing and catching exceptions

Making hierarchical exceptions

The Data class

Can we do it at compile time?

DefaultSignatures extension

DeriveGeneric extension

Rep of a unit type

GHC.Generics contents (part 1)

Types with constructor arguments

GHC.Generics contents (part 2)

What would a Generic instance look like?

How can we use this?

Non-generic instances of MyShow1

Implementing a generic MyShow

`Function` in action

`DeriveDataTypeable` extension

The `Typeable` class

Using `Typeable`: `mkT` [Boilerplate1]

Using `Typeable`: `mkQ` [Boilerplate1]

Functions on multiple types: `extQ`

`ExistentialQuantification` extension

The `Data` class

`DefaultSignatures` extension

`DeriveGeneric` extension

`Rep` of a unit type

`GHC.Generics` contents (part 1)

`GHC.Generics` contents (part 2)

What would a `Generic` instance look like?

Non-generic instances of `MyShow1`

Implementing a generic `MyShow`