2048.elm

import Html exposing (text)

import String exposing (join)

-- Entry point
main = text <| toString <| test

-- Test data
testState = {cells =
  [ [1,1,4,0]
  , [8,2,0,4]
  , [2,0,2,4]
  , [1,2,8,4]
  ]}
  
equivalentToZero state angles = List.foldl rotate state angles == state
  
test = List.all identity
  [ equivalentToZero testState [Up, Up, Up, Up]
  , equivalentToZero testState [Up, Right, Up]
  , equivalentToZero testState [Right, Up, Up]
  , equivalentToZero testState [Up, Up, Right]
  , equivalentToZero testState [Right, Right]
  , equivalentToZero testState [Up, Down]
  , equivalentToZero testState [Down, Up]
  , equivalentToZero testState [Left]
  ]

-- model
type alias GameState =
  { cells: List (List Int)
  }
  
withCells f {cells} = {cells = f cells}

-- action
lean : Rotation -> GameState -> GameState
lean angle = rotate angle >> collideToTheLeft >> rotate (inverse angle)
        
type Rotation = Left | Up | Right | Down

inverse : Rotation -> Rotation
inverse angle = case angle of
  Left  -> Left
  Up    -> Down
  Right -> Right
  Down  -> Up

rotate : Rotation -> GameState -> GameState
rotate angle =
  withCells <|
    case angle of
      Left  -> identity
      Up    -> transpose >> List.reverse
      Right -> List.reverse >> List.map List.reverse
      Down  -> List.reverse >> transpose

collideToTheLeft : GameState -> GameState
collideToTheLeft = withCells (List.map collide)
  
collide : List Int -> List Int
collide = 
  let
    push next res =
      -- eat up all zeros
      if next == 0 then res
      else
        -- merge all sequent equal cells
        if headOr 0 res == next
        then next * 2 :: tailOr [] res
        else next     ::           res
  
  in List.foldl push []     -- make all collisions
  >> List.append [0,0,0,0]  -- fill up with zeros
  >> List.reverse           -- restore order
  >> List.take 4            -- cut to the required length

headOr def list = List.head list |> Maybe.withDefault def
tailOr def list = List.tail list |> Maybe.withDefault def

-- Stolen from
-- https://github.com/circuithub/elm-list-extra/blob/3.10.0/src/List/Extra.elm#L316
transpose : List (List a) -> List (List a)
transpose ll =
  case ll of
    [] -> []
    ([]::xss) -> transpose xss
    ((x::xs)::xss) ->
      let
        heads = List.filterMap List.head xss
        tails = List.filterMap List.tail xss
      in
        (x::heads)::transpose (xs::tails)
        
-- "view"
show = String.join "\n" << List.map toString << .cells