Tweet
Tweet

Slide 1

Slide 1 text

Tic @markhibberd Type Tac

Slide 2

Slide 2 text

No content

Slide 3

Slide 3 text

Data is validated with respect to other data ! If types are to capture valid data precisely, we must let them depend on terms” - Conor McBride, Winging It “

Slide 4

Slide 4 text

No content

Slide 5

Slide 5 text

IDRIS a primer

Slide 6

Slide 6 text

haskell like syntax

Slide 7

Slide 7 text

but… types and values co-exist in the same term language

Slide 8

Slide 8 text

idris haskell ! 1 infixr 7 :. 2 3 data List a 4 = Nil 5 | a :. List a 6 7 headOr :: a -> List a -> a 8 headOr x Nil = x 9 headOr _ (h :. _) = h 10 11 type String = 12 List Char 1 infixr 7 :. 2 3 data List a 4 = Nil 5 | (:.) a (List a) 6 7 headOr : a -> List a -> a 8 headOr x Nil = x 9 headOr _ (h :. _) = h 10 11 String : Type 12 String = List Char

Slide 9

Slide 9 text

idris haskell ! 1 infixr 7 :. 2 3 data List a 4 = Nil 5 | a :. List a 6 7 headOr :: a -> List a -> a 8 headOr x Nil = x 9 headOr _ (h :. _) = h 10 11 type String = 12 List Char 1 infixr 7 :. 2 3 data List a 4 = Nil 5 | (:.) a (List a) 6 7 headOr : {a: Type} -> (x: a) -> (xs: List a) -> a 8 headOr {a} x Nil = x 9 headOr {a} _ (h :. _) = h 10 11 String : Type 12 String = List Char

Slide 10

Slide 10 text

idris haskell ! 1 data Nat 2 = Z 3 | S Nat ! 1 data Nat 2 = Z 3 | S Nat

Slide 11

Slide 11 text

idris haskell ! 1 {-# LANGUAGE GADTs #-} 2 3 data Nat where 4 Z :: Nat 5 S :: Nat -> Nat ! 1 data Nat : Type where 2 Z : Nat 3 S : Nat -> Nat ! !

Slide 12

Slide 12 text

idris haskell ! 1 {-# LANGUAGE GADTs #-} 2 {-# LANGUAGE KindSignatures #-} 3 4 data Nat :: * where 5 Z :: Nat 6 S :: Nat -> Nat ! 1 data Nat : Type where 2 Z : Nat 3 S : Nat -> Nat ! ! !

Slide 13

Slide 13 text

idris haskell 1 {-# LANGUAGE GADTs #-} 2 {-# LANGUAGE KindSignatures #-} 3 4 data Z 5 data S a = S a 6 7 data Nat a :: * -> * where 8 Zero :: Nat Z 9 Succ :: Nat n -> Nat (S n) 10 11 data Fin n :: * -> * where 12 FZero :: Nat n -> Fin (S n) 13 FSucc :: Nat n -> Fin n 14 -> Fin (S n) ! 1 data Nat : Type where 2 Z : Nat 3 S : Nat -> Nat 4 5 data Fin : Nat -> Type where 6 fZ : Fin (S k) 7 fS : Fin k -> Fin (S k) ! ! ! ! ! ! !

Slide 14

Slide 14 text

idris haskell ! 1 {-# LANGUAGE GADTs #-} 2 {-# LANGUAGE DataKinds #-} 3 {-# LANGUAGE KindSignatures #-} 4 5 data Nat :: * where 6 Z :: Nat 7 S :: Nat -> Nat 8 9 data Fin :: Nat -> * where 10 FZ :: Fin Z 11 FS :: Fin n -> Fin (S n) ! 1 data Nat : Type where 2 Z : Nat 3 S : Nat -> Nat 4 5 data Fin : Nat -> Type where 6 fZ : Fin (S k) 7 fS : Fin k -> Fin (S k) ! ! ! !

Slide 15

Slide 15 text

“Stick a number in my type. What is that?” - Manuel Chakravarty

Slide 16

Slide 16 text

! 1 data Vect : Nat -> Type -> Type where 2 Nil : Vect Z a 3 (::) : (x : a) -> (xs : Vect n a) -> Vect (S n) a ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 17

Slide 17 text

! 1 data Vect : Nat -> Type -> Type where 2 Nil : Vect Z a 3 (::) : (x : a) -> (xs : Vect n a) -> Vect (S n) a 4 5 v2 : Vect 2 String 6 v2 = "hello" :: "idris" :: Nil ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 18

Slide 18 text

1 data Vect : Nat -> Type -> Type where 2 Nil : Vect Z a 3 (::) : (x : a) -> (xs : Vect n a) -> Vect (S n) a 4 5 v2 : Vect 2 String 6 v2 = "hello" :: "idris" :: Nil 7 8 v3 : Vect ?len String 9 v3 = "tic" :: "tac" :: "type" :: Nil ! ! ! ! ! ! ! ! ! ! !

Slide 19

Slide 19 text

1 data Vect : Nat -> Type -> Type where 2 Nil : Vect Z a 3 (::) : (x : a) -> (xs : Vect n a) -> Vect (S n) a 4 5 v2 : Vect 2 String 6 v2 = "hello" :: "idris" :: Nil 7 8 v3 : Vect ?len String 9 v3 = "tic" :: "tac" :: "type" :: Nil 10 11 len = proof search ! ! ! ! ! ! ! ! !

Slide 20

Slide 20 text

! 1 data Vect : Nat -> Type -> Type where 2 Nil : Vect Z a 3 (::) : (x : a) -> (xs : Vect n a) -> Vect (S n) a 4 5 index : Fin n -> Vect n a -> a 6 index fZ (x::xs) = x 7 index (fS k) (x::xs) = index k xs 8 index fZ [] impossible ! ! ! ! ! ! ! ! ! ! ! !

Slide 21

Slide 21 text

1 (++) : Vect n a -> Vect m a -> Vect (n + m) a 2 (++) Nil m = m 3 (++) (h :: t) m = h :: (t ++ m) ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 22

Slide 22 text

1 (++) : Vect n a -> Vect m a -> Vect (n + m) a 2 (++) Nil m = m 3 (++) (h :: t) m = h :: (t ++ m) 4 5 filter : (a -> Bool) -> Vect n a -> (p ** Vect p a) 6 filter p [] = ( _ ** [] ) 7 filter p (x::xs) with (filter' p xs) 8 | (n ** tail) = 9 if p x then 10 ((S n) ** x::tail) 11 else 12 (n ** tail) ! ! ! ! ! ! ! !

Slide 23

Slide 23 text

what did I just see?

Slide 24

Slide 24 text

dependent product types aka ∏ types

Slide 25

Slide 25 text

dependent sum types aka Σ types

Slide 26

Slide 26 text

Curry–Howard correspondence

Slide 27

Slide 27 text

(Intuitionistic) Logic Programming FALSE ⊥ TRUE () Disjunction (or) Sum Types Conjunction (and) Product Types Implication Function Types

Slide 28

Slide 28 text

(Predicate) Logic Programming FALSE ⊥ TRUE () Disjunction (or) Sum Types Conjunction (and) Product Types Implication Function Types Existential Quantification (exists.) Σ Types Universal Quantification (forall.) ∏ Types

Slide 29

Slide 29 text

So how do we go about constructing programs?

Slide 30

Slide 30 text

Start With Value Level Primitives

Slide 31

Slide 31 text

1 data Player = X | O 2 data Cell = Occupied Player | Unoccupied 3 4 instance Show Player where {...} 5 instance Eq Player where {...} 6 instance Show Cell where {...} 7 instance Eq Cell where {…} ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 32

Slide 32 text

north-east north-west north center east west south-east south-west south

Slide 33

Slide 33 text

1 Position : Type 2 Position = Fin 9 3 4 nw : Position 5 nw = 0 6 {...} 7 se : Position 8 se = 8 9 10 parse : String -> Maybe Position 11 parse "nw" = Just nw 12 parse "n" = Just n 13 parse "ne" = Just ne 14 parse "e" = Just e 15 parse "c" = Just c 16 parse "w" = Just w 17 parse "sw" = Just sw 18 parse "s" = Just s 19 parse "se" = Just se 20 parse _ = Nothing

Slide 34

Slide 34 text

1 data Board = 2 B (Vect 9 Cell) 3 4 instance Eq Board where {...} 5 instance Show Board where {...} 6 7 -- How many positions are occupied ? 8 occupied : Board -> Nat 9 10 -- Who's turn is it? 11 turn : Board -> Player 12 13 -- Is this position free? 14 free : Position -> Board -> Bool 15 16 -- Is there a winner on the board? 17 winner : Board -> Maybe Player 18 19 -- Is this a valid board? 20 isValidBoard : Board -> Bool

Slide 35

Slide 35 text

Types and Proofs

Slide 36

Slide 36 text

! 1 data so : Bool -> Type where 2 oh : so True ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 37

Slide 37 text

! 1 data so : Bool -> Type where 2 oh : so True 3 4 printIf3 : (n: Nat) 5 -> {default oh prf : so (n == 3)} 6 -> IO () 7 printIf3 _ = 8 print "3s are good." ! ! ! ! ! ! ! ! ! ! ! !

Slide 38

Slide 38 text

*> :x printIf3 3 "3s are good." ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 39

Slide 39 text

*> :x printIf3 3 "3s are good." ! *> :x printIf3 3 { prf = oh } "3s are good.” ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 40

Slide 40 text

*> :x printIf3 3 "3s are good." ! *> :x printIf3 3 { prf = oh } "3s are good.” ! *> :x printIf3 2 (input):1:13:When elaborating argument prf to function Main.printIf3: Can't unify IsJust (Just x) with IsJust (fromInteger 2 == (fromInteger 3)) ! Specifically: Can't unify True with False !

Slide 41

Slide 41 text

1 natToFin : Nat -> (n : Nat) -> Maybe (Fin n) 2 natToFin Z (S j) = Just fZ 3 natToFin (S k) (S j) with (natToFin k j) 4 | Just k' = Just (fS k') 5 | Nothing = Nothing ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 42

Slide 42 text

1 natToFin : Nat -> (n : Nat) -> Maybe (Fin n) 2 natToFin Z (S j) = Just fZ 3 natToFin (S k) (S j) with (natToFin k j) 4 | Just k' = Just (fS k') 5 | Nothing = Nothing 6 7 data IsJust : Maybe a -> Type where 8 ItIsJust : IsJust {a} (Just x) ! ! ! ! ! ! ! ! ! ! ! !

Slide 43

Slide 43 text

1 natToFin : Nat -> (n : Nat) -> Maybe (Fin n) 2 natToFin Z (S j) = Just fZ 3 natToFin (S k) (S j) with (natToFin k j) 4 | Just k' = Just (fS k') 5 | Nothing = Nothing 6 7 data IsJust : Maybe a -> Type where 8 ItIsJust : IsJust {a} (Just x) 9 10 fromNat : (x: Nat) 11 -> {default ItIsJust 12 prf : (IsJust (natToFin x n))} 13 -> Fin n ! ! ! ! ! ! !

Slide 44

Slide 44 text

1 natToFin : Nat -> (n : Nat) -> Maybe (Fin n) 2 natToFin Z (S j) = Just fZ 3 natToFin (S k) (S j) with (natToFin k j) 4 | Just k' = Just (fS k') 5 | Nothing = Nothing 6 7 data IsJust : Maybe a -> Type where 8 ItIsJust : IsJust {a} (Just x) 9 10 fromNat : (x: Nat) 11 -> {default ItIsJust 12 prf : (IsJust (natToFin x n))} 13 -> Fin n 14 fromNat {n} x {prf} with (natToFin x n) ! ! ! ! !

Slide 45

Slide 45 text

1 natToFin : Nat -> (n : Nat) -> Maybe (Fin n) 2 natToFin Z (S j) = Just fZ 3 natToFin (S k) (S j) with (natToFin k j) 4 | Just k' = Just (fS k') 5 | Nothing = Nothing 6 7 data IsJust : Maybe a -> Type where 8 ItIsJust : IsJust {a} (Just x) 9 10 fromNat : (x: Nat) 11 -> {default ItIsJust 12 prf : (IsJust (natToFin x n))} 13 -> Fin n 14 fromNat {n} x {prf} with (natToFin x n) 15 fromNat {n} x {prf = ItIsJust} | Just y = y ! ! ! ! !

Slide 46

Slide 46 text

! 1 *> fromNat 7 2 Can't resolve type class Enum iType ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 47

Slide 47 text

! 1 *> fromNat 7 2 Can't resolve type class Enum iType 3 4 *FinProof> :t the 5 Prelude.Basics.the : (a : Type) -> a -> a ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 48

Slide 48 text

! 1 *> fromNat 7 2 Can't resolve type class Enum iType 3 4 *FinProof> :t the 5 Prelude.Basics.the : (a : Type) -> a -> a 6 7 *FinProof> the (Fin 10) (fromNat 7) 8 fS (fS (fS (fS (fS (fS (fS fZ)))))) : Fin 10 ! ! ! ! ! ! ! ! ! ! ! !

Slide 49

Slide 49 text

! 1 *> fromNat 7 2 Can't resolve type class Enum iType 3 4 *FinProof> :t the 5 Prelude.Basics.the : (a : Type) -> a -> a 6 7 *FinProof> the (Fin 10) (fromNat 7) 8 fS (fS (fS (fS (fS (fS (fS fZ)))))) : Fin 10 9 10 *FinProof> the (Fin 10) (fromNat 10) 11 (input):1:23:When elaborating argument prf 12 Can't unify 13 IsJust (Just x) 14 with 15 IsJust (natToFin 10 10) 16 17 Specifically: 18 Can't unify 19 Just x 20 with 21 Nothing

Slide 50

Slide 50 text

1 data ValidMove : Board -> Type where 2 IsValidMove : Position -> Player 3 -> (b : Board) -> ValidMove b ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 51

Slide 51 text

1 data ValidMove : Board -> Type where 2 IsValidMove : Position -> Player 3 -> (b : Board) -> ValidMove b 4 5 tryValidMove : Position 6 -> Player 7 -> (b : Board) 8 -> Maybe (ValidMove b) ! ! ! ! ! ! ! ! ! ! ! !

Slide 52

Slide 52 text

1 data ValidMove : Board -> Type where 2 IsValidMove : Position -> Player 3 -> (b : Board) -> ValidMove b 4 5 tryValidMove : Position 6 -> Player 7 -> (b : Board) 8 -> Maybe (ValidMove b) 9 10 validMove : (pos : Position) 11 -> (p : Player) 12 -> (b : Board) 13 -> {default ItIsJust 14 prf : IsJust (tryValidMove pos p b)} 15 -> ValidMove ! ! ! ! !

Slide 53

Slide 53 text

1 data ValidMove : Board -> Type where 2 IsValidMove : Position -> Player 3 -> (b : Board) -> ValidMove b 4 5 tryValidMove : Position 6 -> Player 7 -> (b : Board) 8 -> Maybe (ValidMove b) 9 10 validMove : (pos : Position) 11 -> (p : Player) 12 -> (b : Board) 13 -> {default ItIsJust 14 prf : IsJust (tryValidMove pos p b)} 15 -> ValidMove 16 validMove pos p b {prf} with (tryValidMove pos p b) ! ! ! !

Slide 54

Slide 54 text

1 data ValidMove : Board -> Type where 2 IsValidMove : Position -> Player 3 -> (b : Board) -> ValidMove b 4 5 tryValidMove : Position 6 -> Player 7 -> (b : Board) 8 -> Maybe (ValidMove b) 9 10 validMove : (pos : Position) 11 -> (p : Player) 12 -> (b : Board) 13 -> {default ItIsJust 14 prf : IsJust (tryValidMove pos p b)} 15 -> ValidMove 16 validMove pos p b {prf} with (tryValidMove pos p b) 17 validMove pos p b {prf = ItIsJust} | Just y = y ! ! !

Slide 55

Slide 55 text

Break on Through to the Other Side

Slide 56

Slide 56 text

1 data Game : Board -> Type where 2 3 -- start a new game with an empty board 4 start : Game empty 5 6 -- make a (guaranteed to be valid) move 7 move' : {b : Board} -> (m : ValidMove b) 8 -> Game b -> Game (runMove m) ! ! ! ! ! ! ! ! ! ! ! !

Slide 57

Slide 57 text

! 1 -- Make a valid move 2 runMove : ValidMove board -> Board 3 runMove (IsValidMove position player (B board)) = 4 B $ replaceAt position (Occupied player) board 5 ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 58

Slide 58 text

! 1 -- Make a valid move 2 runMove : ValidMove board -> Board 3 runMove (IsValidMove position player (B board)) = 4 B $ replaceAt position (Occupied player) board 5 6 -- Make a valid move if you can prove it 7 move : {b : Board} 8 -> (pos : Position) 9 -> (p : Player) 10 -> (g : Game board) 11 -> {default ItIsJust 12 prf : (IsJust (tryValidMove pos p b))} 13 -> Game (runMove $ validMove pos p b {prf}) ! ! ! ! ! ! !

Slide 59

Slide 59 text

! 1 -- Make a valid move 2 runMove : ValidMove board -> Board 3 runMove (IsValidMove position player (B board)) = 4 B $ replaceAt position (Occupied player) board 5 6 -- Make a valid move if you can prove it 7 move : {b : Board} 8 -> (pos : Position) 9 -> (p : Player) 10 -> (g : Game board) 11 -> {default ItIsJust 12 prf : (IsJust (tryValidMove pos p b))} 13 -> Game (runMove $ validMove pos p b {prf}) 14 move {b} pos p g {prf} = 15 move' (validMove pos p b {prf}) game ! ! ! ! !

Slide 60

Slide 60 text

1 data Prev : Game b -> Type where 2 HasPrev : {bb : Board} 3 -> {m : ValidMove bb} 4 -> {g : Game bb} 5 -> Prev (move' m g) ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 61

Slide 61 text

1 data Prev : Game b -> Type where 2 HasPrev : {bb : Board} 3 -> {m : ValidMove bb} 4 -> {g : Game bb} 5 -> Prev (move' m g) 6 7 -- What was the previous board? 8 previousBoard : (gg : Game b) 9 -> {default HasPrev prf : (Prev gg)} 10 -> Board ! ! ! ! ! ! ! ! ! !

Slide 62

Slide 62 text

1 data Prev : Game b -> Type where 2 HasPrev : {bb : Board} 3 -> {m : ValidMove bb} 4 -> {g : Game bb} 5 -> Prev (move' m g) 6 7 -- What was the previous board? 8 previousBoard : (gg : Game b) 9 -> {default HasPrev prf : (Prev gg)} 10 -> Board 11 previousBoard (move' {b} m g) {prf = HasPrev} = b ! ! ! ! ! ! ! !

Slide 63

Slide 63 text

1 data Prev : Game b -> Type where 2 HasPrev : {bb : Board} 3 -> {m : ValidMove bb} 4 -> {g : Game bb} 5 -> Prev (move' m g) 6 7 -- What was the previous board? 8 previousBoard : (gg : Game b) 9 -> {default HasPrev prf : (Prev gg)} 10 -> Board 11 previousBoard (move' {b} m g) {prf = HasPrev} = b 12 13 -- Take back the last move? 14 takeBack : (gg : Game b) 15 -> {default HasPrev prf : (Prev gg)} 16 -> Game (previousBoard gg {prf}) ! ! ! !

Slide 64

Slide 64 text

1 data Prev : Game b -> Type where 2 HasPrev : {bb : Board} 3 -> {m : ValidMove bb} 4 -> {g : Game bb} 5 -> Prev (move' m g) 6 7 -- What was the previous board? 8 previousBoard : (gg : Game b) 9 -> {default HasPrev prf : (Prev gg)} 10 -> Board 11 previousBoard (move' {b} m g) {prf = HasPrev} = b 12 13 -- Take back the last move? 14 takeBack : (gg : Game b) 15 -> {default HasPrev prf : (Prev gg)} 16 -> Game (previousBoard gg {prf}) 17 takeBack (move' {b} m g) {prf = HasPrev} = g ! ! !

Slide 65

Slide 65 text

1 game0 : ?t1 2 game0 = start 3 t1 = proof search ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 66

Slide 66 text

1 game0 : ?t1 2 game0 = start 3 t1 = proof search 4 5 --game0x : ?t2 6 --game0x = takeBack game0 7 --t3 = proof search 8 ! ! ! ! ! ! ! ! ! ! !

Slide 67

Slide 67 text

1 game0 : ?t1 2 game0 = start 3 t1 = proof search 4 5 --game0x : ?t2 6 --game0x = takeBack game0 7 --t3 = proof search 8 9 game1 : ?t3 10 game1 = move ne X game0 11 t3 = proof search ! ! ! ! ! ! ! ! !

Slide 68

Slide 68 text

1 game0 : ?t1 2 game0 = start 3 t1 = proof search 4 5 --game0x : ?t2 6 --game0x = takeBack game0 7 --t3 = proof search 8 9 game1 : ?t3 10 game1 = move ne X game0 11 t3 = proof search 12 13 --game1x : ?t4 14 --game1x = move ne O game1 15 --t4 = proof search ! ! ! ! !

Slide 69

Slide 69 text

1 game0 : ?t1 2 game0 = start 3 t1 = proof search 4 5 --game0x : ?t2 6 --game0x = takeBack game0 7 --t3 = proof search 8 9 game1 : ?t3 10 game1 = move ne X game0 11 t3 = proof search 12 13 --game1x : ?t4 14 --game1x = move ne O game1 15 --t4 = proof search 16 17 game2 : ?t5 18 game2 = move sw O game1 19 t5 = proof search !

Slide 70

Slide 70 text

Existentials for Free

Slide 71

Slide 71 text

1 data TicTacToeState = 2 InPlay | Done 3 4 toState : Board -> TicTacToeState 5 toState b = 6 case (winner b, complete b) of 7 (Just p, _) => Done 8 (Nothing, True) => Done 9 (Nothing, False) => InPlay 10 11 data TicTacToe : TicTacToeState -> Type where 12 T : (Game b) -> TicTacToe (toState b) ! ! ! ! ! ! ! !

Slide 72

Slide 72 text

Effects

Slide 73

Slide 73 text

! 1 Eff : (m : Type -> Type) 2 -> (x : Type) 3 -> List EFFECT 4 -> (x -> List EFFECT) 5 -> Type ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 74

Slide 74 text

! 1 Eff : (m : Type -> Type) 2 -> (x : Type) 3 -> List EFFECT 4 -> (x -> List EFFECT) 5 -> Type 6 7 8 STATE : Type -> EFFECT 9 EXCEPTION : Type -> EFFECT 10 FILEIO : Type -> EFFECT 11 STDIO : EFFECT 12 RND : EFFECT ! ! ! ! ! ! ! !

Slide 75

Slide 75 text

1 data TicTacToeRules : Effect where 2 Move : 3 (position : Position) 4 -> (player : Player) 5 -> { TicTacToe st ==> {st'} (TicTacToe st') } 6 TicTacToeRules TicTacToeState 7 8 Get : { g } TicTacToeRules g 9 10 GetBoard : { TicTacToe st } TicTacToeRules Board 11 ! ! ! ! ! ! ! ! !

Slide 76

Slide 76 text

1 data TicTacToeRules : Effect where 2 Move : 3 (position : Position) 4 -> (player : Player) 5 -> { TicTacToe st ==> {st'} (TicTacToe st') } 6 TicTacToeRules TicTacToeState 7 8 Get : { g } TicTacToeRules g 9 10 GetBoard : { TicTacToe st } TicTacToeRules Board 11 12 TICTACTOE : TicTacToeState -> EFFECT 13 TICTACTOE s = MkEff (TicTacToe s) TicTacToeRules ! ! ! ! ! ! !

Slide 77

Slide 77 text

1 using (m : Type -> Type) 2 instance Handler TicTacToeRules m where 3 handle (T game) (Move position player) k 4 handle t Get k 5 handle (T game) GetBoard k ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 78

Slide 78 text

1 using (m : Type -> Type) 2 instance Handler TicTacToeRules m where 3 handle (T game) (Move position player) k = 4 let b = toBoard game in 5 case tryValidMove position player b of 6 Just m' => 7 let updated = move' m' game in 8 k (toState . toBoard $ updated) (T updated) 9 Nothing => 10 k (toState . toBoard $ game) (T game) 11 12 handle t Get k = 13 k t t 14 15 handle (T game) GetBoard k = 16 k (toBoard game) (T game) ! ! ! !

Slide 79

Slide 79 text

1 game : { [TICTACTOE InPlay, STDIO] ==> 2 [TICTACTOE Done, STDIO] } Eff IO () 3 game = do ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 80

Slide 80 text

1 game : { [TICTACTOE InPlay, STDIO] ==> 2 [TICTACTOE Done, STDIO] } Eff IO () 3 game = do 4 let current = !GetBoard 5 let player = turn current 6 let _ = !(printState current player) 7 let input = !getStr 8 case parse (trim input) of 9 Nothing => ' 10 do putStrLn $ "Invalid move: " ++ input 11 pure !game 12 Just position => 13 do InPlay <- Move position player 14 | Done => putStrLn "Done" 15 game ! ! ! ! !

Slide 81

Slide 81 text

Constraints are Context Dependent

Slide 82

Slide 82 text

! 1 data CurrentGame : Type where 2 Current : (TicTacToe state) -> CurrentGame ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

Slide 83

Slide 83 text

! 1 data CurrentGame : Type where 2 Current : (TicTacToe state) -> CurrentGame 3 4 receive' : { [STDIO, 5 STATE CurrentGame, 6 TCPSERVERCLIENT ClientConnected] ==> 7 [STDIO, 8 STATE CurrentGame, 9 TCPSERVERCLIENT ()] } Eff IO () ! ! ! ! ! ! ! ! ! ! !

Slide 84

Slide 84 text

! 1 data CurrentGame : Type where 2 Current : (TicTacToe state) -> CurrentGame 3 4 receive' : { [STDIO, 5 STATE CurrentGame, 6 TCPSERVERCLIENT ClientConnected] ==> 7 [STDIO, 8 STATE CurrentGame, 9 TCPSERVERCLIENT ()] } Eff IO () 10 11 game : CurrentGame -> Game x ! ! ! ! ! ! ! ! !

Slide 85

Slide 85 text

! 1 data CurrentGame : Type where 2 Current : (TicTacToe state) -> CurrentGame 3 4 receive' : { [STDIO, 5 STATE CurrentGame, 6 TCPSERVERCLIENT ClientConnected] ==> 7 [STDIO, 8 STATE CurrentGame, 9 TCPSERVERCLIENT ()] } Eff IO () 10 11 game : CurrentGame -> Game x —?????????? ! ! ! ! ! ! ! ! !

Slide 86

Slide 86 text

! 1 data CurrentGame : Type where 2 Current : (TicTacToe state) -> CurrentGame 3 4 receive' : { [STDIO, 5 STATE CurrentGame, 6 TCPSERVERCLIENT ClientConnected] ==> 7 [STDIO, 8 STATE CurrentGame, 9 TCPSERVERCLIENT ()] } Eff IO () 10 11 game : CurrentGame -> (x ** Game x) 12 game (Current (T z)) = 13 (toBoard z ** z) ! ! ! ! ! ! !

Slide 87

Slide 87 text

! 1 data CurrentGame : Type where 2 Current : (TicTacToe state) -> CurrentGame 3 4 receive' : { [STDIO, 5 STATE CurrentGame, 6 TCPSERVERCLIENT ClientConnected] ==> 7 [STDIO, 8 STATE CurrentGame, 9 TCPSERVERCLIENT ()] } Eff IO () 10 11 game : CurrentGame -> (x ** Game x) ! ! ! ! ! ! ! ! !

Slide 88

Slide 88 text

“the most popular and best established lightweight formal methods are type systems” - Benjamin Pierce, Types and Programming Languages

Slide 89

Slide 89 text

Tic @markhibberd Type Tac