Elm, rolling a dice with 'rotation'

dice.elm

-- origin https://gist.github.com/h3h/ce339825f2ba8fe1e4d3bf2d1a3e60da

import Html exposing (..)
import Html.Attributes
import Html.Events exposing (..)
import Process exposing (..)
import Time exposing (..)
import Task exposing (..)
import List
import Random
import Svg exposing (..)
import Svg.Attributes exposing (..)


main =
    Html.program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }



-- MODEL


type alias Model =
    { dieFace : Int
    , rotations : Int
    }


init : ( Model, Cmd Msg )
init =
    ( Model 6 0, Cmd.none )



-- UPDATE


type Msg
    = Roll
    | NewFace Int
    | Rotations Int
    | None


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        Roll ->
            ( model, Random.generate Rotations (Random.int 3 8) )
            
        Rotations n ->
            ( { model | rotations = n }, Random.generate NewFace (Random.int 1 6)  )

        NewFace newFace ->
            let model1 = { model | dieFace = newFace, rotations = model.rotations - 1 }
            in
              ( model1, Process.sleep (500 * Time.millisecond)
        |> Task.perform (\_ -> None) ) -- test model1
            
        None ->
            ( model, test model )


-- What wrong with batch? It drops sleep.            
-- rotate : Cmd Msg
-- rotate = Cmd.batch [Process.sleep (2 * Time.second)
--        |> Task.perform (\_ -> None), Random.generate NewFace (Random.int 1 6) ]
        
test : Model -> Cmd Msg
test model =
    if (model.rotations > 0)
    then Random.generate NewFace (Random.int 1 6)
    else Cmd.none


-- SUBSCRIPTIONS


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



-- VIEW


view : Model -> Html Msg
view model =
    div []
        [ h1 [] [ Html.text (toString model.dieFace) ]
        , svg
            [ width "120", height "120", viewBox "0 0 120 120", fill "white", stroke "black", strokeWidth "3", Html.Attributes.style [ ( "padding-left", "20px" ) ] ]
            (List.append
                [ rect [ x "1", y "1", width "100", height "100", rx "15", ry "15" ] [] ]
                (svgCirclesForDieFace model.dieFace)
            )
        , if model.rotations > 0
          then Html.text ""
          else button [ onClick Roll ] [ Html.text "Roll" ]
        , h2 [] [ Html.text <| "Rotations: " ++ (toString model.rotations) ]
        ]


svgCirclesForDieFace : Int -> List (Svg Msg)
svgCirclesForDieFace dieFace =
    case dieFace of
        1 ->
            [ circle [ cx "50", cy "50", r "10", fill "black" ] [] ]

        2 ->
            [ circle [ cx "25", cy "25", r "10", fill "black" ] []
            , circle [ cx "75", cy "75", r "10", fill "black" ] []
            ]

        3 ->
            [ circle [ cx "25", cy "25", r "10", fill "black" ] []
            , circle [ cx "50", cy "50", r "10", fill "black" ] []
            , circle [ cx "75", cy "75", r "10", fill "black" ] []
            ]

        4 ->
            [ circle [ cx "25", cy "25", r "10", fill "black" ] []
            , circle [ cx "75", cy "25", r "10", fill "black" ] []
            , circle [ cx "25", cy "75", r "10", fill "black" ] []
            , circle [ cx "75", cy "75", r "10", fill "black" ] []
            ]

        5 ->
            [ circle [ cx "25", cy "25", r "10", fill "black" ] []
            , circle [ cx "75", cy "25", r "10", fill "black" ] []
            , circle [ cx "25", cy "75", r "10", fill "black" ] []
            , circle [ cx "75", cy "75", r "10", fill "black" ] []
            , circle [ cx "50", cy "50", r "10", fill "black" ] []
            ]

        6 ->
            [ circle [ cx "25", cy "20", r "10", fill "black" ] []
            , circle [ cx "25", cy "50", r "10", fill "black" ] []
            , circle [ cx "25", cy "80", r "10", fill "black" ] []
            , circle [ cx "75", cy "20", r "10", fill "black" ] []
            , circle [ cx "75", cy "50", r "10", fill "black" ] []
            , circle [ cx "75", cy "80", r "10", fill "black" ] []
            ]

        _ ->
            [ circle [ cx "50", cy "50", r "50", fill "red", stroke "none" ] [] ]