diff --git a/clanki.cabal b/clanki.cabal --- a/clanki.cabal +++ b/clanki.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: clanki -version: 1.2.3 +version: 1.2.5 synopsis: Command-line spaced-repetition software description: Command-line spaced-repetition learning software. CL (command line) + Anki (popular spaced-repetition software) = Clanki. Usage is fairly simple, just follow the instructions after running the program. Add a deck, add cards to the deck, then quiz whenever possible. The program will determine what cards need to be reviewed, using the Super Memo 2 algorithm. license: MIT diff --git a/src/Add.hs b/src/Add.hs --- a/src/Add.hs +++ b/src/Add.hs @@ -1,6 +1,5 @@ module Add where import Card -{-import Decks-} import Display import Text.Printf(printf) import qualified Input @@ -16,23 +15,25 @@ runAddAction addAction decks runAddAction :: Maybe AddAction -> [Card] -> IO [Card] -runAddAction = maybe return newOrTo - where - newOrTo NewDeck = newDeck - newOrTo ToDeck = toDeck +runAddAction (Just NewDeck) cards = do + printf $ "Press at any time to stop adding" ++ "\n" + newDeck cards +runAddAction (Just ToDeck) cards = do + printf $ "Press at any time to stop adding" ++ "\n" + toDeck cards +runAddAction Nothing cards = return cards newDeck :: [Card] -> IO [Card] newDeck cards = do - printf $ "Please input the name of the new deck" ++ "\n" - deckName <- getLine + deckName <- Input.sameLinePrompt "New deck name : " case deckName of "" -> return cards _ -> if any (\card -> cardDeck card == deckName) cards then do - printf $ "Invalid input, already a deck with that name" ++ "\n" - newDeck cards + printf $ "Invalid input, already a deck with that name" ++ "\n" + newDeck cards else - toDeckLoop deckName cards + toDeckLoop deckName cards toDeck :: [Card] -> IO [Card] toDeck cards = do @@ -46,28 +47,24 @@ toDeckLoop :: String -> [Card] -> IO [Card] toDeckLoop deckName cards = do - printf $ "Please input the question, enter to stop adding" ++ "\n" - question <- getLine + question <- Input.sameLinePrompt "Add question : " case question of "" -> do - printf $ "You wish to stop adding" ++ "\n" + {-printf $ "You wish to stop adding" ++ "\n"-} + printf "\n" return cards _ -> do - printf $ "Please input the answer" ++ "\n" - answer <- getLine - case answer of - "" -> do - printf $ "You wish to stop adding" ++ "\n" - return cards - _ -> do - let card = newCard question answer deckName - toDeckLoop deckName (card:cards) + answer <- Input.sameLinePrompt "Add answer : " + case answer of + "" -> do + return cards + _ -> do + let card = newCard question answer deckName + toDeckLoop deckName (card:cards) getAddAction :: [Card] -> IO (Maybe AddAction) getAddAction [] = return $ Just NewDeck -getAddAction _ = do - printf $ "What would you like to do?" ++ "\n" - Input.getUserChoice allAddActions +getAddAction _ = Input.getUserChoice allAddActions allAddActions :: [AddAction] allAddActions = [NewDeck, ToDeck] diff --git a/src/Card.hs b/src/Card.hs --- a/src/Card.hs +++ b/src/Card.hs @@ -20,7 +20,7 @@ printCard card = printf $ "Q : " ++ cardQuestion card ++ "\n" ++ "A : " ++ cardAnswer card allDeckNames :: [Card] -> [String] -allDeckNames cards = nub $ [cardDeck card | card <- cards] +allDeckNames cards = nub . map cardDeck $ cards cardsInDeck :: String -> [Card] -> [Card] cardsInDeck deckName cards = filter (\card -> cardDeck card == deckName) cards diff --git a/src/Input.hs b/src/Input.hs --- a/src/Input.hs +++ b/src/Input.hs @@ -1,12 +1,13 @@ -module Input(getUserChoice, getUserChoiceStr) where +module Input(getUserChoice, getUserChoiceStr, sameLinePrompt) where import Text.Printf(printf) import Data.Maybe(isJust) -import System.IO(hSetBuffering, BufferMode(NoBuffering, LineBuffering), stdin, stdout) +import System.IO(hSetBuffering, BufferMode(NoBuffering, LineBuffering), stdin, stdout, hFlush) import Display import Control.Monad(when) +import Data.Char(toUpper) keys :: [String] -keys = map (:[]) ['a' .. 'z'] +keys = map (:[]) ['A' .. 'Z'] getUserChoice :: (Display a) => [a] -> IO (Maybe a) getUserChoice = getChoiceWithKeys . zip keys @@ -48,7 +49,12 @@ userInputLetter :: IO String userInputLetter = do - input <- fmap (:[]) getChar + input <- fmap ((:[]) . toUpper) getChar putStrLn "" return input +sameLinePrompt :: String -> IO String +sameLinePrompt prompt = do + printf prompt + hFlush stdout + getLine diff --git a/src/Quiz.hs b/src/Quiz.hs --- a/src/Quiz.hs +++ b/src/Quiz.hs @@ -35,7 +35,8 @@ runQuizAction (Just FromDeck) cards = do input <- Input.getUserChoiceStr $ allDeckNames cards case input of - Just deckName -> quizFromDeck deckName cards + Just deckName -> do + quizFromDeck deckName cards Nothing -> return cards runQuizAction Nothing decks = return decks @@ -44,7 +45,6 @@ {-newCards <- sequence [maybeQuiz card | card <- cards]-} {-return cards-} - {-maybeQuiz :: Card -> IO Card-} {-maybeQuiz card = shouldQuizCard card >>= (\shouldQuiz -> if shouldQuiz then quizCard card else return card)-} @@ -56,30 +56,35 @@ quizCards cards = quizSomeCards cards cards quizSomeCards :: [Card] -> [Card] -> IO [Card] -quizSomeCards cards allCards - | null cards = return allCards - | otherwise = do - quizResult <- quizCard headCard - case quizResult of - Nothing -> return allCards - Just updatedCard -> do - needsRequizzing <- shouldQuizCard updatedCard - if needsRequizzing - then do - quizSomeCards (restOfCards ++ [updatedCard]) allCards - else do - let newAllCards = (updatedCard:) . delete headCard $ allCards - quizSomeCards (restOfCards) newAllCards +quizSomeCards subset set = do + printf "Press at any time to stop quizzing\n" + quizSomeCards' subset set where - headCard = head cards - restOfCards = tail cards + quizSomeCards' cards allCards + | null cards = return allCards + | otherwise = do + quizResult <- quizCard headCard + case quizResult of + Nothing -> return allCards + Just updatedCard -> do + needsRequizzing <- shouldQuizCard updatedCard + if needsRequizzing + then do + quizSomeCards' (restOfCards ++ [updatedCard]) allCards + else do + let newAllCards = (updatedCard:) . delete headCard $ allCards + quizSomeCards' (restOfCards) newAllCards + where + headCard = head cards + restOfCards = tail cards quizCard :: Card -> IO (Maybe Card) quizCard card = do printf $ "Question : " ++ cardQuestion card ++ "\n" - printf $ "Answer : " - hFlush stdout - answer <- getLine + {-printf $ "Answer : "-} + {-hFlush stdout-} + {-answer <- getLine-} + answer <- Input.sameLinePrompt "Answer : " confidence <- getConfidence answer (cardAnswer card) case confidence of Just conf -> do @@ -99,7 +104,7 @@ | isJust inferredConfidence = return $ inferredConfidence | otherwise = do printf $ "Correct answer : " ++ correctAnswer ++ "\n" - printf $ "Rate your answer on a scale from 0-5, to stop quizzing : " + printf $ "Rate your answer on a scale from 0-5 : " hFlush stdout promptConfidence where @@ -126,7 +131,7 @@ hSetBuffering stdout LineBuffering case readInput of Just confidence -> if confidence `elem` [0 .. 5] then return $ Just confidence else promptConfidence - Nothing -> return Nothing + Nothing -> printf "\n" >> return Nothing quizFromDeck :: String -> [Card] -> IO [Card] quizFromDeck deckName cards = do @@ -139,12 +144,15 @@ getQuizAction [] = do printf $ "No decks, returning to menu" ++ "\n" return Nothing -getQuizAction decks = do - cardsToBeQuizzed <- cardsToQuiz decks +getQuizAction cards = do + cardsToBeQuizzed <- cardsToQuiz cards case cardsToBeQuizzed of [] -> do printf $ "No cards need to be quizzed at this time" ++ "\n" return Nothing _ -> do - printf $ "What would you like to be quizzed on?" ++ "\n" - Input.getUserChoice allQuizActions + case allDeckNames cards of + [_] -> return $ Just AllCards + _ -> do + printf $ "What would you like to be quizzed on?" ++ "\n" + Input.getUserChoice allQuizActions