Tic tac toe with Elm

tic-tac-toe.elm

import Array exposing (Array, get)
import Html exposing (Html, div, text)
import Html.Attributes exposing (style)
import Html.App as Html
import Html.Events exposing (onClick)
import Maybe exposing (withDefault)
import Random
import String

main : Program Never
main =
  Html.program
    { init = (init 3)
    , view = view
    , update = update
    , subscriptions = subscriptions
    }


-- MODEL
type Player = Dot | Cross
type alias Location = (Int, Int)

type alias Cell =
  { location: Location
  , owner: Maybe Player
  }

type alias Model =
  { board: Array (Array Cell)
  , order: Int
  , turn: Player
  , over: Bool
  , winningLine: Maybe (Array Cell)
  }


init : Int -> (Model, Cmd Msg)
init n =
  let model =
    { board  = makeBoard n
    , order = n
    , over = False
    , turn   = Cross
    , winningLine = Nothing
    }
  in (model, Cmd.none)


makeBoard : Int -> Array (Array Cell)
makeBoard n =
  Array.map (makeRow n) (Array.fromList [0..n - 1])

makeRow : Int -> Int -> Array Cell
makeRow n r =
  let mapper =
        \c -> { location = (r, c)
              , owner = Nothing
              }
  in Array.map mapper (Array.fromList [0..n - 1])


getWinner : Model -> Model
getWinner model =
  let indexes =  Array.fromList [0..model.order - 1]
      rows = Array.toList model.board
      columns = List.map getColumn (Array.toList indexes)
      diagonals =
        [ Array.map (\x -> getCell x x) indexes
        , Array.map (\x -> getCell (model.order - 1 - x) x) indexes]
      winningLines = List.filter winningLine (rows ++ columns ++ diagonals)

      getColumn c = Array.map (flip getCell c) indexes
      getCell r c = case (Array.get c (getRow r)) of
        Just cell -> cell
        _         -> { location = (r, c), owner = Nothing }
      getRow x = withDefault Array.empty (Array.get x model.board)

      winningLine l =
        (getOwners l) == allDots || (getOwners l) == allCross
      getOwners = Array.map .owner
      allDots = Array.repeat model.order (Just Dot)
      allCross = Array.repeat model.order (Just Cross)
  in if List.isEmpty winningLines
     then model
     else { model | over = True
                  , winningLine = List.head winningLines }



-- UPDATE
type Msg = Play Location

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    Play location -> ((model |> (updateBoard location)
                             >> getWinner
                             >> toggleTurn), Cmd.none)


toggleTurn : Model -> Model
toggleTurn model =
  let newTurn = case model.turn of
    Cross -> Dot
    Dot -> Cross
  in { model | turn = newTurn }


updateBoard : Location -> Model -> Model
updateBoard location model =
  { model |
      board = Array.map (Array.map (updateCell location model)) model.board }


updateCell : Location -> Model -> Cell -> Cell
updateCell location model cell =
  if cell.location == location
  then { cell | owner = Just model.turn }
  else cell


-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model = Sub.none


-- VIEWS
view : Model -> Html Msg
view model =
  div
    [ style [ ("height", "960px")
            , ("width", "640px")
            , ("margin", "auto")
            , ("position", "relative")
            ]
    ]
    [renderArena model]


renderArena : Model -> Html Msg
renderArena model =
  div [ style [ ("position", "absolute")
              , ("top", "100px")
              , ("background", "#FCFCFC")
              ]
      ]
      (Array.toList (Array.map (renderRow model) model.board))


renderRow : Model -> Array Cell -> Html Msg
renderRow model row =
  div [ style [ ("clear", "both") ]]
      (Array.toList (Array.map (renderCell model) row))

renderCell : Model -> Cell -> Html Msg
renderCell model cell =
  let size = (floor (640/toFloat model.order) - (model.order * 4))
      px = (toString size) ++ "px"
      fontSize = (toString ((toFloat size) / 2)) ++ "px"
      highlight = case model.winningLine of
        Nothing     -> "#EEE"
        Just line   -> if Array.isEmpty (Array.filter ((==) cell) line)
                       then "#EEE"
                       else "#A2E195"
      styleCfg = [ ("height", px)
                 , ("width", px)
                 , ("float", "left")
                 , ("margin", "5px")
                 , ("font-size", fontSize)
                 , ("text-align", "center")
                 , ("vertical-algin", "middle")
                 , ("line-height", px)
                 , ("border", "1px solid #999")
                 ]
      cellFilter c = c.location == cell
  in case cell.owner of
    Just Dot   -> div [ style (("background", highlight) :: styleCfg) ]
                      [ text "●" ]
    Just Cross -> div [ style (("background", highlight) :: styleCfg) ]
                      [ text "✘" ]
    Nothing    -> div [ style  styleCfg
                      , onClick (Play cell.location)] []