packages feed

clanki-1.2.7: src/Remove.hs

module Remove where
import Display
import Card
import Text.Printf(printf)
import Data.List(delete)
import qualified Input
data RemoveAction = RemoveDeck | RemoveFromDeck deriving (Show, Eq)

instance Display RemoveAction where
    display RemoveDeck = "Remove a deck"
    display RemoveFromDeck = "Remove cards from a deck"

removeLoop :: [Card] -> IO [Card]
removeLoop cards = do
    removeAction <- getRemoveAction cards
    runRemoveAction removeAction cards

runRemoveAction :: Maybe RemoveAction -> [Card] -> IO [Card]
runRemoveAction (Just RemoveDeck) cards     = removeDeck cards
runRemoveAction (Just RemoveFromDeck) cards = removeFromDeck cards
runRemoveAction Nothing cards               = return cards

removeDeck :: [Card] -> IO [Card]
removeDeck cards = do
    printf $ "Choose what deck to remove" ++ "\n"
    
    input <- Input.getUserChoiceStr $ allDeckNames cards
    case input of 
        Just deckName -> return $ filter (\card -> cardDeck card /= deckName) cards
        Nothing   -> return cards


removeFromDeck :: [Card] -> IO [Card]
removeFromDeck cards = do
    chosenDeckName <- Input.getUserChoiceStr $ allDeckNames cards
    case chosenDeckName of
        Just deckName -> do
                        updatedCards <- removeFromDeckLoop deckName (cardsInDeck deckName cards)
                        let newCards = replaceCardsInDeck deckName updatedCards cards
                        return newCards 
        Nothing -> return cards

removeFromDeckLoop :: String -> [Card] -> IO [Card]
removeFromDeckLoop     _        [] = return []
removeFromDeckLoop deckName cards = do
    input <- Input.getUserChoice cards
    case input of 
        Just card  -> removeFromDeckLoop deckName $ delete card cards
        Nothing    -> return cards

getRemoveAction :: [Card] -> IO (Maybe RemoveAction)
getRemoveAction [] = return Nothing
getRemoveAction _  = do
        printf $ "What would you like to do?" ++ "\n"
        Input.getUserChoice allRemoveActions

allRemoveActions :: [RemoveAction]
allRemoveActions = [RemoveDeck, RemoveFromDeck]