packages feed

clanki-1.0.7: src/Remove.hs

module Remove where
import Decks
import Display
import Text.Printf(printf)
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 :: [Deck] -> IO [Deck]
removeLoop decks = do
    removeAction <- getRemoveAction decks
    runRemoveAction removeAction decks

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

removeDeck :: [Deck] -> IO [Deck]
removeDeck decks = do
    printf $ "Choose what deck to remove" ++ "\n"
    input <- Input.getUserChoice decks
    case input of 
        Just deck -> return $ filter (/= deck) decks
        Nothing   -> return decks


removeFromDeck :: [Deck] -> IO [Deck]
removeFromDeck decks = do
    chosenDeck <- Input.getUserChoice $ filter (not . null . dCards) decks
    case chosenDeck of
        Just deck -> do
                        updatedDeck <- removeFromDeckLoop deck
                        let newDecks = replaceDeckNamed (dName updatedDeck) updatedDeck decks 
                        return newDecks 
        Nothing -> return decks

removeFromDeckLoop :: Deck -> IO Deck
removeFromDeckLoop deck = do
    input <- Input.getUserChoice $ dCards deck
    case input of 
        Just card  -> if not $ null (dCards deck)
                        then removeFromDeckLoop $ removeCardFromDeck card deck
                        else return deck
        Nothing    -> return deck

getRemoveAction :: [Deck] -> IO (Maybe RemoveAction)
getRemoveAction [] = return Nothing
getRemoveAction decks
    | all (null . dCards) decks = return $ Just RemoveDeck
    | otherwise  = do
        printf $ "What would you like to do?" ++ "\n"
        Input.getUserChoice allRemoveActions

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