-- | User board and its processing functions

module Game.Board where

import CardParts.Cards ( Card (..), parseCard )
import CardParts.Values (Value(..))
import CardParts.Suits (Suit(..))
import Data.Either (isLeft)
import Data.List ( nub, elemIndex )

-- | Parsed card result wrapper which also holds the possible err msg

type CardParseResult = Either String Card
-- | Shorthand for board type

type Board = [[Card]]

{- | This function gets a list of strings which items represents a card notation.
Returns 'Either' type, where 'Left' is 'String' with error message,
and 'Right' is 'Board' type.
Processes only list of length 13.
Method is going to fail the list with duplicates.

__Examples:__

@
cards = [
    \"Ah\", \"Qd\", \"Kc\",
    \"Ts\", \"Jc\", "6h", "2h", "3h",
    "8c", "4c", "7s", "9c", \"Tc\"
]
getUserBoard cards = 'Right' [
    [
        'Card' {value = Ace, suit = Hearts},
        'Card' {value = Queen, suit = Diamonds},
        'Card' {value = King, suit = Clubs}
    ],
    [
        'Card' {value = Ten, suit = Spades},
        'Card' {value = Jack, suit = Clubs},
        'Card' {value = Six, suit = Hearts},
        'Card' {value = Two, suit = Hearts},
        'Card' {value = Three, suit = Hearts}
    ],
    [
        'Card' {value = Eight, suit = Clubs},
        'Card' {value = Four, suit = Clubs},
        'Card' {value = Seven, suit = Spades},
        'Card' {value = Nine, suit = Clubs},
        'Card' {value = Ten, suit = Clubs}
    ]
]

cardsTwo = [
    \"Az\", \"Qx\", \"Kf\",
    \"Xs\", \"Jc\", "6h", "2h", "3h",
    "8c", "4c", "7s", "9c", \"Tc\"
]
getUserBoard cardsTwo = 'Left'
    "Some cards failed to be parsed:
    There is no card suit marked as \'z\';
    There is no card suit marked as \'x\';
    There is no card suit marked as \'f\';
    There is no broadway card, which could be represented with \'X\';"
@
-}
getUserBoard :: [String] -> Either String Board
getUserBoard :: [String] -> Either String Board
getUserBoard [String]
full
    | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
full Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
13 = Board -> Either String Board
forall a b. b -> Either a b
Right []
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
boardDuplicates = String -> Either String Board
forall a b. a -> Either a b
Left (String -> Either String Board) -> String -> Either String Board
forall a b. (a -> b) -> a -> b
$ String
"Duplicates ocurred: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
boardDuplicates
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [CardParseResult] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CardParseResult]
failedCards = String -> Either String Board
forall a b. a -> Either a b
Left String
failedCardsErrMsg
    | Bool
otherwise = Board -> Either String Board
forall a b. b -> Either a b
Right (Board -> Either String Board) -> Board -> Either String Board
forall a b. (a -> b) -> a -> b
$ [Card] -> Board
getLines [ Card
card | Right Card
card <- [CardParseResult]
parsedCards ]
    where
        -- | Function which calculates list duplicates

        getDuplicates :: [String] -> [String]
        getDuplicates :: [String] -> [String]
getDuplicates [] = []
        getDuplicates (String
x:[String]
xs) = case String
x String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [String]
xs of
            Maybe Int
Nothing -> [String] -> [String]
getDuplicates [String]
xs
            Just Int
el -> [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
getDuplicates [String]
xs

        -- | Shorthand for list duplicates

        boardDuplicates :: String
        boardDuplicates :: String
boardDuplicates = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"; ") ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
getDuplicates [String]
full

        -- | Function which calculates whether list contains duplicates

        containsDuplicates :: [String] -> Bool
        containsDuplicates :: [String] -> Bool
containsDuplicates [String]
xs = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ( [String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
xs )

        -- | Result of list of string card parsing, in form of a tuple

        parsedCards :: [CardParseResult]
        parsedCards :: [CardParseResult]
parsedCards = (String -> CardParseResult) -> [String] -> [CardParseResult]
forall a b. (a -> b) -> [a] -> [b]
map String -> CardParseResult
parseCard [String]
full

        -- | List of cards failed to being parsed

        failedCards :: [CardParseResult]
        failedCards :: [CardParseResult]
failedCards = (CardParseResult -> Bool) -> [CardParseResult] -> [CardParseResult]
forall a. (a -> Bool) -> [a] -> [a]
filter CardParseResult -> Bool
forall a b. Either a b -> Bool
isLeft [CardParseResult]
parsedCards

        -- | Err message in case of failed cards

        failedCardsErrMsg :: String
        failedCardsErrMsg :: String
failedCardsErrMsg = String
"Some cards failed to be parsed: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
errMsg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; " | Left String
errMsg <- [CardParseResult]
failedCards ]

        -- | Get sublist with given number of elements from given starting point

        getSublist :: [a] -> Int -> Int -> [a]
        getSublist :: [a] -> Int -> Int -> [a]
getSublist [a]
xs Int
from Int
count = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
count ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
from [a]
xs

        -- | Split list of cards into three lines

        getLines :: [Card] -> Board
        getLines :: [Card] -> Board
getLines [] = []
        getLines [Card]
xs = [[Card] -> Int -> Int -> [Card]
forall a. [a] -> Int -> Int -> [a]
getSublist [Card]
xs Int
0 Int
3, [Card] -> Int -> Int -> [Card]
forall a. [a] -> Int -> Int -> [a]
getSublist [Card]
xs Int
3 Int
5, [Card] -> Int -> Int -> [Card]
forall a. [a] -> Int -> Int -> [a]
getSublist [Card]
xs Int
8 Int
5]