clanki 1.2.3 → 1.2.5
raw patch · 5 files changed
+69/−58 lines, 5 files
Files
- clanki.cabal +1/−1
- src/Add.hs +22/−25
- src/Card.hs +1/−1
- src/Input.hs +10/−4
- src/Quiz.hs +35/−27
clanki.cabal view
@@ -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
src/Add.hs view
@@ -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 <Enter> at any time to stop adding" ++ "\n"+ newDeck cards+runAddAction (Just ToDeck) cards = do+ printf $ "Press <Enter> 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]
src/Card.hs view
@@ -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
src/Input.hs view
@@ -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
src/Quiz.hs view
@@ -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 <Enter> 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, <Enter> 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