import Html exposing (Html, button, text, div, hr, span)
import Html.Events exposing (onClick)
import Html.Attributes exposing (style)
import List exposing (..)
import Color exposing (..)
import Time exposing (Time, second)

main = Html.program
    { init = (reset 0, Cmd.none)
    , view = view
    , update = update
    , subscriptions = subscription
    }

-- MODEL

type alias Index = Int
type alias Model =
    { state : List Int
    , goto : List Int
    , score : Int
    , history : List (List Int)
    }

type alias Problem =
    { from : List Int
    , to : List Int
    }

-- non empty
type NonEmptyList a = NonEmptyList a (List a)

problems : NonEmptyList Problem
problems = NonEmptyList
      { from = [0,0,0,0,3,0,0,0,0], to = [2,2,2,2,0,2,2,2,2] }
    [ { from = [2,1,2,1,0,1,2,1,2], to = [0,3,0,3,1,3,0,3,0] }
    , { from = [2,1,2,1,1,1,2,1,2], to = [2,1,2,1,0,1,2,1,2] }
    , { from = [3,3,3,3,0,3,3,3,3], to = [0,3,0,3,0,3,0,3,0] }
    , { from = [0,2,2,0,0,3,0,0,3], to = [3,0,1,0,3,2,2,2,3] }
    , { from = [0,2,2,3,2,2,1,1,0], to = [0,2,2,3,1,0,2,2,3] }
    , { from = [3,0,1,1,0,0,1,3,0], to = [1,1,1,0,2,2,3,1,2] }
    , { from = [3,0,2,3,3,3,1,1,2], to = [2,3,2,0,2,2,1,1,1] }
    ]


(!!) : NonEmptyList a -> Int -> a
(!!) ls n = case ls of
    NonEmptyList x [] -> x
    NonEmptyList x (y::xs) -> if n <= 0 
                        then x 
                        else (NonEmptyList y xs) !! (n-1)

mod : Int -> List a -> List (List a)
mod n ls =
    let go n ls = case (take n ls, drop n ls) of
                    (l1, []) -> [l1]
                    (l1, l2) -> l1 :: go n l2
    in go n ls

reset : Int -> Model
reset n = let prob = problems !! n
          in { state = prob.from
             , goto = prob.to
             , score = 0
             , history = [prob.from]
             }

-- UPDATE

type Msg = Reset Int | AddAt Int | Fix | Undo

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    Reset n -> (reset n, Cmd.none)
    AddAt m ->
        let
          l1 = take m model.state
          l1b = drop m model.state
          x = take 1 l1b
          l2 = drop 1 l1b
          newL = l1 ++ (map (\n -> n+1) x) ++ l2
          newH = model.state :: model.history
        in ({ model | state = newL, score = model.score + 1, history = newH }, Cmd.none)
    Fix ->
        let
          rems = map (\v -> v % 4) model.state
          divs = map (\v -> v // 4) model.state
          dividx = map (\(v, i) -> scale v (neighbours i)) <| zip divs idxs
          adds = foldr add zero dividx
          newState = add rems adds
        in ({ model | state = newState }, Cmd.none)
    Undo -> case model.history of
        []    -> ({ model | history = [model.state]}, Cmd.none)
        [x]   -> ({ model | state = x }, Cmd.none)
        x::xs -> ({ model | state = x, history = xs }, Cmd.none)

subscription : Model -> Sub Msg
subscription _ = Time.every (0.2*second) (always Fix)

zip = map2 (,)
idxs = range 0 8
zero = List.repeat 9 0
add l1 l2 = map2 (+) l1 l2
scale n ls = map (\v -> n*v) ls
neighbours n = case n of
    0 -> [0,1,0,1,0,0,0,0,0]
    1 -> [1,0,1,0,1,0,0,0,0]
    2 -> [0,1,0,0,0,1,0,0,0]
    3 -> [1,0,0,0,1,0,1,0,0]
    4 -> [0,1,0,1,0,1,0,1,0]
    5 -> [0,0,1,0,1,0,0,0,1]
    6 -> [0,0,0,1,0,0,0,1,0]
    7 -> [0,0,0,0,1,0,1,0,1]
    8 -> [0,0,0,0,0,1,0,1,0]
    _ -> []
correct model = model.state == model.goto

-- VIEW

color n = case n of
    0 -> rgb 255 255 255
    1 -> rgb 255 255 100
    2 -> rgb 255 200 50
    3 -> rgb 255 100 0
    _ -> rgb 100 255 255

toRgbaString : Color -> String
toRgbaString color =
  let {red, green, blue, alpha} = Color.toRgb color
  in "rgba(" ++ toString red ++ ", " ++ toString green ++ ", " ++ toString blue ++ ", " ++ toString alpha ++ ")"

fst (a, b) = a

view : Model -> Html Msg
view model =
    let
      intro = div [] [ text "Can you transform the top grid into the bottom grid?" ]
      but n = button [ onClick (Reset n) ] [ text (toString (n+1))]
      puzzleSelect = div [] ( [ text "Choose puzzle " ] ++ map but (List.range 0 7) )
      undoButton = button [ onClick Undo ] [ text "undo move" ]
      finTxt = case model.state == model.goto of
                    True -> ". Yay!"
                    False -> ""
      scoreView = div [] [ undoButton, text ("Taps: " ++ toString model.score), text finTxt ]
      tile c f n = div [ style
                        [ ("backgroundColor", c n)
                        , ("width", "37px")
                        , ("height", "37px")
                        , ("display", "inline-block")
                        , ("textAlign", "center")
                        , ("padding", "30px")
                        ]
                     ] [f n]
      row c f r = div [] (map (tile c f) r)
      grid c f g = div [] (map (row c f) g)
      pile c f p = grid c f (mod 3 p)
      tstr = text << toString
      tstr2 (n, m) = button [ style
                              [ ("backgroundColor", c n)
                              , ("width", "37px")
                              , ("height", "37px")
                              ], onClick (AddAt m) ] [ tstr n ]
      c = toRgbaString << color
      c2 = if correct model
           then always "#00FF00"
           else toRgbaString << color << fst
    in
      div [] [ intro
             , puzzleSelect
             , hr [] []
             , scoreView
             , pile c2 tstr2 (map2 (,) model.state idxs)
             , hr [] []
             , pile c tstr model.goto
             ]