TickTackToe -- compile-time type errors

[Michael Fox]

Trying to figure out how to make certain calls a compile-time type error.

I made a version where Board can be any of Empty | InPlay | Finished, then didn't implement the illegal calls -- but realized that just makes the un-matched calls runtime errors.

In version 2 I tried something with types and classes but couldn't get it to compile. I now have the idea that it can work using certain language extensions but ...

Tony mentioned on GitHub that there's a better approach. I'd like to know more.

Here's my version 1:

module Api

    ( Player (..)

    , Board (..)

    , Row

    , Col

    , move

    , whoWon

    , takeBack

    , playerAt)

    where

import Prelude

import Data.List (elemIndex)

data Player = X | O

  deriving (Eq, Show)

data Row = R1 | R2 | R3

  deriving (Eq, Show)

data Col = C1 | C2 | C3

  deriving (Eq, Show)

type Position = (Row, Col)

data Board = Empty

           | InPlay [Position] Player

           | Won [Position] Player

move :: Board -> Position -> Board

move Empty pos = InPlay [pos] O -- X first, O next

move brd@(InPlay ps player) pos =

  let occupied = pos `elem` ps

      newps = if occupied then ps else (pos:ps)

      done = full || won -- || unwinable  -- TODO

      full = length newps == 9

      -- unwinable = cantwin X && cantwin Y -- TODO

      won = haswon X || haswon O

      haswon X = wins xmoves

      haswon O = wins omoves

      xmoves = evenmoves ps

      omoves = evenmoves (tail ps)

      evenmoves [] = []

      evenmoves (m:ms) = m : evenmoves (tail ms)

      wins moves =

          ownsrow R1 moves

       || ownsrow R2 moves

       || ownsrow R3 moves

       || ownscol C1 moves

       || ownscol C2 moves

       || ownscol C3 moves

       || owns [(R1,C1), (R2,C2), (R3,C3)] moves

       || owns [(R3,C1), (R2,C2), (R1,C3)] moves

      ownsrow :: Row -> [Position] -> Bool

      ownsrow r moves = 3 == length (filter ((== r) . fst) moves)

      ownscol c moves = 3 == length (filter ((== c) . snd) moves)

      owns cells moves = all (`elem` moves) cells

  in

    if occupied

        then brd

        else if done

            then Won (pos:ps) player

            else InPlay (pos:ps) (other player)

whoWon :: Board -> Player

whoWon (Won _ player) = player

takeBack :: Board -> Board

takeBack (Won (_:ps) player) = InPlay ps player

takeBack (InPlay (_:ps) player) = InPlay ps (other player)

playerAt :: Board -> Position -> Maybe Player

playerAt Empty _ = Nothing

playerAt (InPlay ps _) pos =

  case pos `elemIndex` ps of

    Just idx -> Just $ if even idx then X else O

    Nothing  -> Nothing

-- Todo: Copy paste makes me sad

playerAt (Won ps _) pos =

  case pos `elemIndex` ps of

    Just idx -> Just $ if even idx then X else O

    Nothing  -> Nothing

other :: Player -> Player

other X = O

other O = X

-- WTF?

-- Api.hs|53 col 5 error| Not in scope: ‘ifThenElse’

-- ifThenElse :: Bool -> a -> a

-- ifThenElse True  a _ = a

-- ifThenElse False _ b = b

And version 2:

{-# LANGUAGE NoMonomorphismRestriction #-}

module Api

    ( Player (..)

    , Board (..)

    , Row

    , Col

    , move

    , whoWon

    , takeBack

    , playerAt)

    where

import Prelude

import Data.List (elemIndex)

data Player = X | O

  deriving (Eq, Show)

data Row = R1 | R2 | R3

  deriving (Eq, Show)

data Col = C1 | C2 | C3

  deriving (Eq, Show)

type Position = (Row, Col)

class Board a where

  positions :: a -> [Position]

data Empty = Empty

data InPlay = InPlay [Position]

data Won = Won [Position]

instance Board Empty where

  positions _ = []

instance Board InPlay where

  positions (InPlay poss) = poss

instance Board Won where

  positions (Won poss) = poss

class Started a where

  takeBack :: (Started a, Unfinished b) => a -> b

instance Started InPlay where

  takeBack brd =

    case positions brd of

      [p]    -> Empty

      (_:ps) -> InPlay ps

instance Started Won where

  takeBack brd =

      InPlay (tail (positions brd))

class Unfinished a

instance Unfinished Empty

instance Unfinished InPlay

move :: (Unfinished a, Board b) => a -> Position -> b

move brd pos =

  let

      ps = positions brd

      occupied = pos `elem` ps

      newps = if occupied then ps else (pos:ps)

      done = full || won -- || unwinable  -- TODO

      full = length newps == 9

      -- unwinable = cantwin X && cantwin Y -- TODO

      won = haswon X || haswon O

      haswon X = wins xmoves

      haswon O = wins omoves

      xmoves = evenmoves ps

      omoves = evenmoves (tail ps)

      evenmoves [] = []

      evenmoves (m:ms) = m : evenmoves (tail ms)

      wins moves =

          ownsrow R1 moves

       || ownsrow R2 moves

       || ownsrow R3 moves

       || ownscol C1 moves

       || ownscol C2 moves

       || ownscol C3 moves

       || owns [(R1,C1), (R2,C2), (R3,C3)] moves

       || owns [(R3,C1), (R2,C2), (R1,C3)] moves

      ownsrow :: Row -> [Position] -> Bool

      ownsrow r moves = 3 == length (filter ((== r) . fst) moves)

      ownscol c moves = 3 == length (filter ((== c) . snd) moves)

      owns cells moves = all (`elem` moves) cells

  in

    if occupied

        then brd

        else if done

            then Won (pos:ps)

            else InPlay (pos:ps)

whoWon :: Won -> Player

whoWon (Won poss) = other (nextPlayer poss)

nextPlayer poss

  | even (length poss) = O

  | otherwise          = X

playerAt :: Board a => a -> Position -> Maybe Player

playerAt brd pos =

  let ps = positions brd

  in

    case pos `elemIndex` ps of

      Just idx -> Just $ if even idx then X else O

      Nothing  -> Nothing

other :: Player -> Player

other X = O

other O = X

 

[David Tchepak]

I believe there are a few approaches to this. My approach is pretty crude, but seems to work (with a fair amount of gymnastics wiring everything together).

Let's look at this type:

    move :: Board -> Position -> Board

This seems to suggest that we can take any Board (in play, finished, etc), and a Position, and return the updated Board.

But we can't move on a finished board. So we could try representing that in the type:

    move :: InPlayBoard -> Position -> Board

We could also move on an empty board:

    move :: Either EmptyBoard InPlayBoard -> Position -> Board

What about the result of this call? We shouldn't get back an empty board, it will either be in play or finished:

    move :: Either EmptyBoard InPlayBoard -> Position -> Either FinishedBoard InPlayBoard

I think that captures the intent of the exercise, then it becomes a matter of finding easier representations to work with, different combinators that simplify the implementations, etc.

Hope this helps.

Regards,

David

--
You received this message because you are subscribed to the Google Groups "haskell-exercises" group.
To unsubscribe from this group and stop receiving emails from it, send an email to haskell-exerci...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Michael Fox]

Oh. I kind of get it. So the caller will say something like:

    move (Left EmptyBoard) (R1,C1)

and get back:

   Right (InPlayBoard)

It's so simple. I agree that it seems burdensome to make the caller keep track of the Lefts and Rights as well as the various board states which are each different types. But your idea has the great advantage of meeting the spec which sounds good to me.

[Tony Morris]

Yep, on the right track.

So, to continue:

1. make sure all of your detailed requirements are met in this regard.

2. make the API less burdensome to use. As an API user, you don't want to hear complaints of, "but now I have to destructure this clumsy data type..."