[Elm] Solitaire

.gitignore

elm-stuff/
elm.js

README.md

https://twitch.tv/martinjaniczek

the gist is not complete - it doesn't support directories which I have used.

download the zipfile

TODO:

• more init-game fuzz tests
• graphics
• refactor into different modules (clean up a bit)
• Msgs for playing the game
• game-moves fuzz tests

elm-package.json

{
    "version": "1.0.0",
    "summary": "helpful summary of your project, less than 80 characters",
    "repository": "https://github.com/user/project.git",
    "license": "BSD3",
    "source-directories": [
        "."
    ],
    "exposed-modules": [],
    "dependencies": {
        "elm-community/list-extra": "3.0.0 <= v < 4.0.0",
        "elm-community/random-extra": "1.0.0 <= v < 2.0.0",
        "elm-lang/core": "4.0.5 <= v < 5.0.0",
        "elm-lang/html": "1.1.0 <= v < 2.0.0",
        "jinjor/elm-time-travel": "1.0.17 <= v < 2.0.0",
        "mgold/elm-random-pcg": "3.0.0 <= v < 4.0.0"
    },
    "elm-version": "0.17.0 <= v < 0.18.0"
}

solitaire-20160812.zip

Solitaire.elm

module Solitaire exposing (..)

import Random.Pcg as Random exposing (Generator)
import Random.List
import List.Extra as List
import Html as H exposing (Html)
import Html.Attributes as HA
import TimeTravel.Html.App as HP


main : Program Never
main =
    HP.program
        { init = init
        , update = update
        , subscriptions = subscriptions
        , view = view
        }


type Rank
    = Ace
    | Two
    | Three
    | Four
    | Five
    | Six
    | Seven
    | Eight
    | Nine
    | Ten
    | Jack
    | Queen
    | King


type Suite
    = Heart
    | Spade
    | Club
    | Diamond


type alias Card =
    { rank : Rank
    , suite : Suite
    , visible : Bool
    }


type alias Model =
    { deck : List Card
    , waste : List Card
    , foundations :
        { f1 : List Card
        , f2 : List Card
        , f3 : List Card
        , f4 : List Card
        }
    , piles :
        { p1 : List Card
        , p2 : List Card
        , p3 : List Card
        , p4 : List Card
        , p5 : List Card
        , p6 : List Card
        , p7 : List Card
        }
    }


type Msg
    = NewGame Model


init : ( Model, Cmd Msg )
init =
    initModel ! [ Random.generate NewGame gameGenerator ]


initModel : Model
initModel =
    { deck = []
    , waste = []
    , foundations =
        { f1 = []
        , f2 = []
        , f3 = []
        , f4 = []
        }
    , piles =
        { p1 = []
        , p2 = []
        , p3 = []
        , p4 = []
        , p5 = []
        , p6 = []
        , p7 = []
        }
    }


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        NewGame game ->
            game ! []


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


viewCard : Card -> Html Msg
viewCard { rank, suite, visible } =
    H.text <|
        if visible then
            toString rank ++ " of " ++ toString suite
        else
            "unknown"


view : Model -> Html Msg
view model =
    H.div [ HA.class "game" ]
        [ H.div [ HA.class "deck" ] <| List.map viewCard model.deck
        , H.div [ HA.class "waste" ] <| List.map viewCard model.waste
        , H.div [ HA.class "foundations" ]
            [ H.div [ HA.class "foundation foundation-1" ] <| List.map viewCard model.foundations.f1
            , H.div [ HA.class "foundation foundation-2" ] <| List.map viewCard model.foundations.f2
            , H.div [ HA.class "foundation foundation-3" ] <| List.map viewCard model.foundations.f3
            , H.div [ HA.class "foundation foundation-4" ] <| List.map viewCard model.foundations.f4
            ]
        , H.div [ HA.class "piles" ]
            [ H.div [ HA.class "pile pile-1" ] <| List.map viewCard model.piles.p1
            , H.div [ HA.class "pile pile-2" ] <| List.map viewCard model.piles.p2
            , H.div [ HA.class "pile pile-3" ] <| List.map viewCard model.piles.p3
            , H.div [ HA.class "pile pile-4" ] <| List.map viewCard model.piles.p4
            , H.div [ HA.class "pile pile-5" ] <| List.map viewCard model.piles.p5
            , H.div [ HA.class "pile pile-6" ] <| List.map viewCard model.piles.p6
            , H.div [ HA.class "pile pile-7" ] <| List.map viewCard model.piles.p7
            ]
        ]


allCards : List Card
allCards =
    [ Heart, Spade, Club, Diamond ]
        `List.andThen`
            \suite ->
                [ Ace, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten, Jack, Queen, King ]
                    `List.andThen`
                        \rank ->
                            [ Card rank suite True ]


shuffledCardsGenerator : Generator (List Card)
shuffledCardsGenerator =
    Random.List.shuffle allCards


turnDownCard : Card -> Card
turnDownCard card =
    { card | visible = False }


turnDownAllButLastCard : List Card -> List Card
turnDownAllButLastCard cards =
    let
        init =
            List.init cards
                |> Maybe.withDefault []

        last =
            List.last cards
                |> Maybe.withDefault (Card Ace Spade True)
    in
        (List.map turnDownCard init) ++ [ last ]


gameGenerator : Generator Model
gameGenerator =
    Random.map
        (\shuffledCards ->
            let
                waste =
                    []

                f1 =
                    []

                f2 =
                    []

                f3 =
                    []

                f4 =
                    []

                ( deck, cards0 ) =
                    List.splitAt 24 shuffledCards

                ( p1, cards1 ) =
                    List.splitAt 1 cards0

                ( p2, cards2 ) =
                    List.splitAt 2 cards1

                ( p3, cards3 ) =
                    List.splitAt 3 cards2

                ( p4, cards4 ) =
                    List.splitAt 4 cards3

                ( p5, cards5 ) =
                    List.splitAt 5 cards4

                ( p6, cards6 ) =
                    List.splitAt 6 cards5

                ( p7, cards7 ) =
                    List.splitAt 7 cards6
            in
                { deck = List.map turnDownCard deck
                , waste = waste
                , foundations =
                    { f1 = f1
                    , f2 = f2
                    , f3 = f3
                    , f4 = f4
                    }
                , piles =
                    { p1 = turnDownAllButLastCard p1
                    , p2 = turnDownAllButLastCard p2
                    , p3 = turnDownAllButLastCard p3
                    , p4 = turnDownAllButLastCard p4
                    , p5 = turnDownAllButLastCard p5
                    , p6 = turnDownAllButLastCard p6
                    , p7 = turnDownAllButLastCard p7
                    }
                }
        )
        shuffledCardsGenerator


cardsOfGame : Model -> List Card
cardsOfGame { deck, waste, foundations, piles } =
    List.concat
        [ deck
        , waste
        , foundations.f1
        , foundations.f2
        , foundations.f3
        , foundations.f4
        , piles.p1
        , piles.p2
        , piles.p3
        , piles.p4
        , piles.p5
        , piles.p6
        , piles.p7
        ]


cardToComparable : Card -> ( Int, Int, Int )
cardToComparable { rank, suite, visible } =
    let
        rankVal : Rank -> Int
        rankVal rank =
            case rank of
                Ace ->
                    1

                Two ->
                    2

                Three ->
                    3

                Four ->
                    4

                Five ->
                    5

                Six ->
                    6

                Seven ->
                    7

                Eight ->
                    8

                Nine ->
                    9

                Ten ->
                    10

                Jack ->
                    11

                Queen ->
                    12

                King ->
                    13

        suiteVal : Suite -> Int
        suiteVal suite =
            case suite of
                Heart ->
                    1

                Spade ->
                    2

                Club ->
                    3

                Diamond ->
                    4

        boolVal : Bool -> Int
        boolVal bool =
            if bool then
                1
            else
                0
    in
        ( rankVal rank
        , suiteVal suite
        , boolVal visible
        )