F# poker hands ranker exercise

poker.fs

open System

type Suit =
    | Spades
    | Clubs
    | Diamonds
    | Hearts
type Rank = int
type Card = 
    | Card of Rank * Suit
type Result =
    | Win = 0 
    | Loss = 1
    | Tie = 2
type Combination = 
    | HighCard
    | Pair of Rank
    | TwoPairs of Rank * Rank
    | ThreeOfAKind of Rank
    | Straight of Rank
    | Flush of Rank
    | FullHouse of Rank * Rank
    | FourOfAKind of Rank
    | StraightFlush of Rank
type Hand = Hand of Card list * Combination 
type Game = Game of Card list * Card list * Result

let initGame cards1 cards2 = Game(cards1 |> List.sort, cards2 |> List.sort, Result.Tie)
let declareWinner game =
    let (>=>) f1 f2 arg =
        let res = f1 arg
        match res with
        | Game (_, _, Result.Tie) -> f2 res
        | _ -> res 
    let getSuit (Card(_,suit)) = suit
    let getRank (Card(rank,_)) = rank
    let allOfOtherRank r = List.filter (fun c -> c |> getRank <> r)
    let compareTwoCards card1 card2 =
        match card1, card2 with
        | c1, c2 when c1 > c2 -> Result.Win
        | c1, c2 when c1 < c2 -> Result.Loss
        | _ -> Result.Tie
    let rec compareCardLists list1 list2 =
        match list1, list2 with
        | h1::t1, h2::t2 ->
            match compareTwoCards (getRank h1) (getRank h2) with
            | Result.Tie -> compareCardLists t1 t2
            | x -> x
        | [], [] -> Result.Tie
        | _, _ -> failwith "Wrong lengths"
    let revAndCompareCardLists list1 list2 = compareCardLists (list1 |> List.rev) (list2 |> List.rev)
    let findMultiCards cards =
        //let chooser = function
        let chooser x =
            match x with
            | c, _::_::_::_::_ -> FourOfAKind c |> Some
            | c, _::_::_::_ -> ThreeOfAKind c |> Some
            | c, _::_::_ -> Pair c |> Some
            | _ -> None
        cards 
            |> List.groupBy getRank 
            |> List.choose chooser
    let findStraight cards =
        let folder (last,res) cur =
            let curVal = getRank cur
            let lastVal = getRank last
            match curVal - lastVal, res with
            | 1, true -> (cur, true)
            | _ -> (cur, false)
        let checkHandForStraight cards = List.tail cards |> List.fold folder (List.head cards, true) |> snd
        if checkHandForStraight cards then Straight (cards |> List.last |> getRank) |> Some else None
    let findFlush cards =
        let highCard = List.last cards
        let suit = getSuit highCard
        let allSameSuit = List.forall (fun el -> suit = getSuit el) cards
        if allSameSuit then Flush(highCard |> getRank) |> Some else None
    let findFullHouse cards =
        cards |> findMultiCards |> function 
            | ThreeOfAKind x::Pair y::_ -> Hand ([], FullHouse (x, y))
            | Pair y::ThreeOfAKind x::_ -> Hand ([], FullHouse (x, y))
            | _ -> Hand(cards, HighCard)
    let findNumberCombos cards =
        cards |> findMultiCards |> function
        | FourOfAKind x::_ -> Hand (cards |> allOfOtherRank x, FourOfAKind x)
        | ThreeOfAKind x::_ -> Hand (cards |> allOfOtherRank x, ThreeOfAKind x)
        | Pair x::Pair y::_ -> Hand (cards |> allOfOtherRank x |> allOfOtherRank y, TwoPairs (x, y))
        | Pair x::_ -> Hand (cards |> allOfOtherRank x, Pair x)
        | _ -> Hand(cards, HighCard)
    let checkStraightFlush (Game(c1, c2, _)) =
        let findStraightFlush cards =
            match (findFlush cards, findStraight cards) with
            | (Some _, Some (Straight x)) -> StraightFlush x |> Some
            | _ -> None
        match findStraightFlush c1, findStraightFlush c2 with
        | Some (StraightFlush x), Some (StraightFlush y) -> Game(c1, c2, compareTwoCards x y)
        | Some _, _ -> Game(c1, c2, Result.Win)
        | _, Some _ -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkFourOfAKind (Game(c1, c2, _)) =
        match findNumberCombos c1, findNumberCombos c2 with
        | Hand(r1, (FourOfAKind x)), Hand(r2, (FourOfAKind y)) -> 
            match compareTwoCards x y with
            | Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
            | x -> Game(c1, c2, x)
        | Hand(_, FourOfAKind _), _ -> Game(c1, c2, Result.Win)
        | _, Hand(_, (FourOfAKind _)) -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkFullHouse (Game(c1, c2, _)) =
        match findFullHouse c1, findFullHouse c2 with
        | Hand(_, (FullHouse (t1, p1))), Hand(_, (FullHouse (t2, p2))) -> 
            match compareTwoCards t1 t2 with
            | Result.Tie -> Game(c1, c2, compareTwoCards p1 p2)
            | x -> Game(c1, c2, x)
        | Hand(_,(FullHouse _)), _ -> Game(c1, c2, Result.Win)
        | _, Hand(_,(FullHouse _)) -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkFlush (Game(c1, c2, _)) =
        match findFlush c1, findFlush c2 with
        | Some (Flush x), Some (Flush y) -> Game(c1, c2, compareTwoCards x y)
        | Some _, _ -> Game(c1, c2, Result.Win)
        | _, Some _ -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkStraight (Game(c1, c2, _)) =
        match findStraight c1, findStraight c2 with
        | Some (Straight x), Some (Straight y) -> Game(c1, c2, compareTwoCards x y)
        | Some _, _ -> Game(c1, c2, Result.Win)
        | _, Some _ -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkThreeOfAKind (Game(c1, c2, _)) =
        match findNumberCombos c1, findNumberCombos c2 with
        | Hand(r1, (ThreeOfAKind x)), Hand(r2, (ThreeOfAKind y)) -> 
            match compareTwoCards x y with
            | Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
            | x -> Game(c1, c2, x)
        | Hand(_, ThreeOfAKind _), _ -> Game(c1, c2, Result.Win)
        | _, Hand(_, (ThreeOfAKind _)) -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkTwoPairs (Game(c1, c2, _)) =
        match findNumberCombos c1, findNumberCombos c2 with
        | Hand(r1, (TwoPairs(x1, x2))), Hand(r2, (TwoPairs(y1, y2))) -> 
            match compareTwoCards x1 y1 with
            | Result.Tie -> 
                match compareTwoCards x2 y2 with
                | Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
                | x -> Game(c1, c2, x)
            | x -> Game(c1, c2, x)
        | Hand(_, TwoPairs(_)), _ -> Game(c1, c2, Result.Win)
        | _, Hand(_, (TwoPairs(_))) -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkPair (Game(c1, c2, _)) =
        match findNumberCombos c1, findNumberCombos c2 with
        | Hand(r1, (Pair x)), Hand(r2, (Pair y)) -> 
            match compareTwoCards x y with
            | Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
            | x -> Game(c1, c2, x)
        | Hand(_, Pair _), _ -> Game(c1, c2, Result.Win)
        | _, Hand(_, (Pair _)) -> Game(c1, c2, Result.Loss)
        | _ -> Game(c1, c2, Result.Tie)
    let checkOtherCards (Game(c1, c2, _)) =
        match compareCardLists (List.rev c1) (List.rev c2) with
        | Result.Tie -> Game(c1, c2, Result.Tie)
        | r -> Game(c1, c2, r)
    let checkGame =
        checkStraightFlush 
        >=> checkFourOfAKind
        >=> checkFullHouse
        >=> checkFlush
        >=> checkStraight
        >=> checkThreeOfAKind
        >=> checkTwoPairs
        >=> checkPair
        >=> checkOtherCards
    checkGame game

type Pokerhand (s:String) =
    member this.Hand = 
        let toCard arr = 
            let suit = function
                | 'S' -> Spades
                | 'C' -> Clubs
                | 'D' -> Diamonds
                | 'H' -> Hearts
                | _ -> failwith "Bad suit"
            let rank = function
                | 'A' -> 14
                | 'K' -> 13
                | 'Q' -> 12
                | 'J' -> 11
                | 'T' -> 10
                | x -> string x |> Int32.Parse
            Card( arr |> Array.head |> rank , arr |> Array.last |> suit)
        s.Split [|' '|] |> Array.map (fun s -> s.ToCharArray() |> toCard) |> Array.toList
    member this.compareWith (other:Pokerhand) = 
        let game = initGame this.Hand other.Hand
        let (Game (_, _, result)) = game |> declareWinner
        result