{-# LANGUAGE DeriveGeneric #-}
-- | Combined (value + suit) card data type and its processing functions

module CardParts.Cards where

import CardParts.Suits ( Suit (..), parseSuit )
import CardParts.Values ( Value (..), parseValue )
import GHC.Generics (Generic)
import Data.Aeson
    ( FromJSON(parseJSON),
      Object,
      (.:),
      ToJSON(toJSON),
      object,
      KeyValue((.=)) )
import qualified Data.Aeson as JsonValue(Value (Object))
import Data.Aeson.Key (fromString)

-- | This type represents a card - combination of suit and value.

data Card = Card {
    Card -> Value
value :: Value,
    Card -> Suit
suit :: Suit
} deriving (Int -> Card -> ShowS
[Card] -> ShowS
Card -> String
(Int -> Card -> ShowS)
-> (Card -> String) -> ([Card] -> ShowS) -> Show Card
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Card] -> ShowS
$cshowList :: [Card] -> ShowS
show :: Card -> String
$cshow :: Card -> String
showsPrec :: Int -> Card -> ShowS
$cshowsPrec :: Int -> Card -> ShowS
Show, (forall x. Card -> Rep Card x)
-> (forall x. Rep Card x -> Card) -> Generic Card
forall x. Rep Card x -> Card
forall x. Card -> Rep Card x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Card x -> Card
$cfrom :: forall x. Card -> Rep Card x
Generic)

instance FromJSON Card where
    parseJSON :: Value -> Parser Card
parseJSON (JsonValue.Object Object
v) = Value -> Suit -> Card
Card (Value -> Suit -> Card) -> Parser Value -> Parser (Suit -> Card)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
fromString String
"value" Parser (Suit -> Card) -> Parser Suit -> Parser Card
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Suit
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
fromString String
"suit"
    parseJSON Value
_ = Parser Card
forall a. Monoid a => a
mempty

instance ToJSON Card where
    toJSON :: Card -> Value
toJSON (Card Value
value Suit
suit) = [Pair] -> Value
object [String -> Key
fromString String
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value, String -> Key
fromString String
"suit" Key -> Suit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Suit
suit]

instance Eq Card where
    c1 :: Card
c1@Card {} == :: Card -> Card -> Bool
== c2 :: Card
c2@Card {} = Card -> Value
value Card
c1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Card -> Value
value Card
c2

instance Ord Card where
    c1 :: Card
c1@Card {} compare :: Card -> Card -> Ordering
`compare` c2 :: Card
c2@Card {} = Card -> Value
value Card
c1 Value -> Value -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Card -> Value
value Card
c2

{- | This function gets a string which represents full card combination (value + suit)
and returns a 'Card' wrapped with 'Right'. The function uses 'parseValue' and 'parseSuit' functions.

Passed string should have length 2 and have format "{VALUE}{SUIT}".

__Examples:__

@
parseCard "2c" = 'Right' 'Two' 'Clubs'
parseCard \"As\" = 'Right' 'Ace' 'Spades'
parseCard "" = 'Left' "Can't process emtpy string"
parseCard "22c" = 'Left' "Argument length should be 2"
parseCard "Zd" = 'Left' "There is no broadway card, which could be represented with \'Z\'"
parseCard "5f" = 'Left' "There is no card suit marked as \'f\'"
parseCard "2x" = 'Left' "There is no card suit marked as \'x\'"
@
-}
parseCard :: String -> Either String Card
parseCard :: String -> Either String Card
parseCard [] = String -> Either String Card
forall a b. a -> Either a b
Left String
"Can't process emtpy string"
parseCard String
str
    | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2 = String -> Either String Card
forall a b. a -> Either a b
Left String
"Argument length should be 2"
    | Bool
otherwise = do
        Value
value <- Char -> ValueResult
parseValue (Char -> ValueResult) -> Char -> ValueResult
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
str
        Suit
suit <- Char -> Either String Suit
parseSuit (Char -> Either String Suit) -> Char -> Either String Suit
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
last String
str
        Card -> Either String Card
forall (m :: * -> *) a. Monad m => a -> m a
return (Card -> Either String Card) -> Card -> Either String Card
forall a b. (a -> b) -> a -> b
$ Card :: Value -> Suit -> Card
Card { value :: Value
value = Value
value, suit :: Suit
suit = Suit
suit }