Coverting tuples to lists

Polymorphism with fundeps

Function in action

DeriveDataTypeable extension

The Typeable class

Type Casting

Generalized casting

Using Typeable: mkT [Boilerplate1]

Solution

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

Using Typeable: mkQ [Boilerplate1]

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
mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ defaultVal fn = maybe defaultVal fn . cast

Functions on multiple types: extQ

ExistentialQuantification extension

Example: Dynamic type

Example: Extensible exceptions [Marlow]

Throwing and catching exceptions

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

Making hierarchical exceptions

The Data class

class Typeable a => Data a where ...

gfoldl traversals

gfoldl queries

Can we do it at compile time?

DefaultSignatures extension

{-# LANGUAGE DefaultSignatures #-}

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

DeriveGeneric extension

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 MyType = MyCons deriving (Show, Generic)
*Main> :t from MyCons
from MyCons :: D1 Main.D1MyType (C1 Main.C1_0MyType U1) x
*Main> :t undefined :: Rep MyType X
undefined :: Rep MyType X
  :: D1 Main.D1MyType (C1 Main.C1_0MyType U1) X
*Main> datatypeName (from MyCons)
"MyType"
*Main> moduleName (from MyCons)
"Main"
*Main> conName $ undef2 (from MyCons)
"MyCons"

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 MyType = MyCons deriving (Show, Generic)
data MyType1 = MyCons1 { sel1a :: Bool } deriving (Show, Generic)
data MyType2 = MyCons2 { sel2a :: Bool, sel2b :: Bool } deriving (Show, Generic)
undef2 :: mi c f p -> f p
*Main> :t from MyCons
from MyCons :: D1 Main.D1MyType (C1 Main.C1_0MyType U1) x
*Main> :t from (MyCons1 True)
from (MyCons1 True)
  :: D1 Main.D1MyType1
       (C1 Main.C1_0MyType1 (S1 Main.S1_0_0MyType1 (Rec0 Bool))) x
*Main> -- was U1 for MyType ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
*Main> conName (undef2 $ from $ MyCons1 True)
"MyCons1"
*Main> selName (undef2 $ undef2 $ from $ MyCons1 True)
"sel1a"
*Main> :t (undefined :: Rep MyType2 X)
(undefined :: Rep MyType2 X)
  :: D1 Main.D1MyType2
        (C1 Main.C1_0MyType2
            (S1 Main.S1_0_0MyType2 (Rec0 Bool)
             :*: S1 Main.S1_0_1MyType2 (Rec0 Bool)))
        X

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 }
data R
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

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?

Non-generic instances of MyShow1

Implementing a generic MyShow