packages feed

clanki 1.1.0 → 1.2.0

raw patch · 9 files changed

+437/−2 lines, 9 files

Files

clanki.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                clanki-version:             1.1.0+version:             1.2.0 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@@ -20,7 +20,7 @@  executable clanki   main-is:             Main.hs-  --other-modules:       Add, Quiz, Remove, Display, Card, Decks, Input, Tracker+  other-modules:       Add, Quiz, Remove, Display, Card, Input, Tracker, StatTracker   -- other-extensions:       build-depends:       base >=4.6 && <4.8, time >= 1.4.2, directory >= 1.2.1.0, safe   hs-source-dirs:      src
+ src/Add.hs view
@@ -0,0 +1,73 @@+module Add where+import Card+{-import Decks-}+import Display+import Text.Printf(printf)+import qualified Input+data AddAction = NewDeck | ToDeck deriving (Show, Eq)++instance Display AddAction where+    display NewDeck = "New deck"+    display ToDeck  = "Add to deck"++addLoop :: [Card] -> IO [Card]+addLoop decks = do+    addAction <- getAddAction decks+    runAddAction addAction decks++runAddAction :: Maybe AddAction -> [Card] -> IO [Card]+runAddAction = maybe return newOrTo+  where+      newOrTo NewDeck = newDeck+      newOrTo ToDeck  = toDeck++newDeck :: [Card] -> IO [Card]+newDeck cards = do+    printf $ "Please input the name of the new deck" ++ "\n"+    deckName <- getLine+    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+                else +                  toDeckLoop deckName cards++toDeck :: [Card] -> IO [Card]+toDeck cards = do+    chosenDeckName <- Input.getUserChoiceStr $ allDeckNames cards+    case chosenDeckName of+        Just deckName -> do+                        newCards <- toDeckLoop deckName cards+                        return newCards+        Nothing -> return cards+++toDeckLoop :: String -> [Card] -> IO [Card]+toDeckLoop deckName cards = do+    printf $ "Please input the question, enter to stop adding" ++ "\n"+    question <- getLine+    case question of +        "" -> do+                printf $ "You wish to stop adding" ++ "\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)++getAddAction :: [Card] -> IO (Maybe AddAction)+getAddAction [] = return $ Just NewDeck+getAddAction _  = do+    printf $ "What would you like to do?" ++ "\n"+    Input.getUserChoice allAddActions++allAddActions :: [AddAction]+allAddActions = [NewDeck, ToDeck]
+ src/Card.hs view
@@ -0,0 +1,51 @@+module Card where +import Display+import Text.Printf(printf)+import Data.List(nub, intercalate)+import StatTracker+data CardTracker = CardTracker {ctEF :: Float, ctN :: Int, ctTimeQuizzed :: Int, ctLastResponseQuality :: Maybe Int} deriving (Show, Read, Eq)++data Card = Card {cardQuestion :: String, cardAnswer :: String, cardDeck :: String, cardTracker :: CardTracker, cardStatTracker :: StatTracker} deriving (Show, Read, Eq)++newCard :: String -> String -> String -> Card+newCard question answer deckName = Card {cardQuestion = question, cardAnswer = answer, cardDeck = deckName, cardTracker = newCardTracker, cardStatTracker = newStatTracker}++newCardTracker :: CardTracker+newCardTracker = CardTracker {ctEF = 2.5, ctN = 0, ctTimeQuizzed = 0, ctLastResponseQuality = Nothing}++instance Display Card where+    display card = "Q : " ++ cardQuestion card ++ "\n" ++ "A : " ++ cardAnswer card++printCard :: Card -> IO ()+printCard card = printf $ "Q : " ++ cardQuestion card ++ "\n" ++ "A : " ++ cardAnswer card++allDeckNames :: [Card] -> [String]+allDeckNames cards = nub $ [cardDeck card | card <- cards]++cardsInDeck :: String -> [Card] -> [Card]+cardsInDeck deckName cards = filter (\card -> cardDeck card == deckName) cards++replaceCardsInDeck :: String -> [Card] -> [Card] -> [Card]+replaceCardsInDeck deckName newCards allCards = do+    let cardsOldDeckRemoved = filter (\card -> cardDeck card /= deckName) allCards+    cardsOldDeckRemoved ++ newCards++displayCardsInDeck :: String -> [Card] -> String+displayCardsInDeck deckName cards = +    prependDeckName . appendNewLine . displayListCards $ deckCards+    where+        prependDeckName = (deckName ++) . ("\n" ++)+        appendNewLine = (++ "\n")+        deckCards = filter (\card -> cardDeck card == deckName) cards++displayListCards :: [Card] -> String+displayListCards cards = intercalate "\n" . map display $ cards++displayAllDecks :: [Card] -> IO ()+displayAllDecks cards = do+    let deckNames = allDeckNames cards+    let cardsDisplayed = intercalate "\n" $ map (\dName -> displayCardsInDeck dName cards) deckNames+    printf $ cardsDisplayed ++ "\n"++hasDeckNamed :: String -> [Card] -> Bool+hasDeckNamed deckName cards = not . null $ filter (\card -> cardDeck card == deckName) cards
+ src/Display.hs view
@@ -0,0 +1,10 @@+module Display where+import Data.List(intercalate) +import Text.Printf(printf)++class (Show a) => Display a where+    display :: a -> String++displayList list = do+    printf . (++ "\n") . intercalate "\n" . map (("-" ++) . display) $ list+
+ src/Input.hs view
@@ -0,0 +1,54 @@+module Input(getUserChoice, getUserChoiceStr) where+import Text.Printf(printf)+import Data.Maybe(isJust)+import System.IO(hSetBuffering, BufferMode(NoBuffering, LineBuffering), stdin, stdout)+import Display+import Control.Monad(when)++keys :: [String]+keys = map (:[]) ['a' .. 'z']++getUserChoice :: (Display a) => [a] -> IO (Maybe a)+getUserChoice = getChoiceWithKeys . zip keys++getUserChoiceStr :: [String] -> IO (Maybe String)+getUserChoiceStr = getChoiceWithKeysStr . zip keys++getChoiceWithKeysStr :: [(String, String)] -> IO (Maybe String)+getChoiceWithKeysStr choices = do+    hSetBuffering stdin NoBuffering+    hSetBuffering stdout NoBuffering+    printf $ repKeysAndValues choices+    input <- userInputLetter+    let action = lookup input choices+    hSetBuffering stdin LineBuffering+    hSetBuffering stdout LineBuffering+    when (isJust action) $ printf "\n"+    return action++choicesToStringPairs :: (Display a) => [(String, a)] -> [(String, String)]+choicesToStringPairs choicePairs = [(fst pair, display $ snd pair) | pair <- choicePairs]++repKeysAndValues :: [(String, String)] -> String+repKeysAndValues choices = unlines [key ++ ")" ++ " " ++ a | (key, a) <- choices]+++getChoiceWithKeys :: (Display a) => [(String, a)] -> IO (Maybe a)+getChoiceWithKeys choices = do+    hSetBuffering stdin NoBuffering+    hSetBuffering stdout NoBuffering+    printf $ repKeysAndValues $ choicesToStringPairs choices+    input <- userInputLetter+    let action = lookup input choices+    hSetBuffering stdin LineBuffering+    hSetBuffering stdout LineBuffering+    when (isJust action) $ printf "\n"++    return action++userInputLetter :: IO String+userInputLetter = do+    input <- fmap (:[]) getChar+    putStrLn ""+    return input+
+ src/Quiz.hs view
@@ -0,0 +1,148 @@+module Quiz(quizLoop, quizCards, quizFromDeck, quizSomeCards) where+import Card+import Tracker+import StatTracker+import Display+import Text.Printf(printf)+import Safe(readMay)+import Data.Time.Clock.POSIX+import Data.Maybe(isJust)+import qualified Input+import Control.Monad(filterM)+import System.IO(hSetBuffering, BufferMode(NoBuffering, LineBuffering), stdin, stdout, hFlush)+import Data.List((\\), isInfixOf, delete)+{-import StatTracker-}+data QuizAction = AllCards | FromDeck deriving (Show, Eq)++allQuizActions :: [QuizAction]+allQuizActions = [AllCards, FromDeck]++instance Display QuizAction where+    display AllCards = "Quiz from all cards"+    display FromDeck = "Quiz from a deck"++quizLoop :: [Card] -> IO [Card]+quizLoop cards = do+    quizAction <- getQuizAction cards+    runQuizAction quizAction cards++anyCardsToQuiz :: [Card] -> IO Bool+anyCardsToQuiz cards = shouldQuizList >>= return . (True `elem`)+    where shouldQuizList = sequence [shouldQuizCard card | card <- cards] ++runQuizAction :: Maybe QuizAction -> [Card] -> IO [Card]+runQuizAction (Just AllCards) cards = cardsToQuiz cards >>= (\someCards -> quizSomeCards someCards cards)+runQuizAction (Just FromDeck) cards = do+        input <- Input.getUserChoiceStr $ allDeckNames cards+        case input of+            Just deckName -> quizFromDeck deckName cards+            Nothing   -> return cards+runQuizAction Nothing decks = return decks++{-quizCards :: [Card] -> IO [Card]-}+{-quizCards cards = do-}+    {-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)-}++cardsToQuiz :: [Card] -> IO [Card]+cardsToQuiz cards = filterM shouldQuizCard cards++quizCards :: [Card] -> IO [Card]+quizCards []    = return []+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+    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+    confidence <- getConfidence answer (cardAnswer card)+    case confidence of+        Just conf -> do+            let newEF = adjustEF (ctEF $ cardTracker card) conf+            let oldTracker = cardTracker card+            let n = if conf < 3 then 1 else ctN oldTracker + 1+            currentTime <- fmap round getPOSIXTime+            printf "\n\n"+            let st = cardStatTracker card+            let newST = updateStatTracker st conf+            let newTracker = oldTracker {ctEF = newEF, ctN = n, ctLastResponseQuality = Just conf, ctTimeQuizzed = currentTime}+            return . Just $ card {cardTracker = newTracker, cardStatTracker = newST}+        Nothing   -> return Nothing ++getConfidence :: String -> String -> IO (Maybe Int)+getConfidence answer correctAnswer+    | 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 : "+            hFlush stdout+            promptConfidence+    where+    inferredConfidence = inferConfidence answer correctAnswer++inferConfidence :: String -> String -> Maybe Int+inferConfidence answer correctAnswer+    | rightAnswer =+        case answer \\ correctAnswer of+            {-"!" -> Just 5-}+            {-"." -> Just 4-}+            {-"?" -> Just 3-}+            _   -> Nothing+    | otherwise   = Nothing+        where rightAnswer = correctAnswer `isInfixOf` answer++promptConfidence :: IO (Maybe Int)+promptConfidence = do+    hSetBuffering stdin NoBuffering+    hSetBuffering stdout NoBuffering+    input <- fmap (:[]) getChar +    let readInput = readMay input :: Maybe Int+    hSetBuffering stdin LineBuffering+    hSetBuffering stdout LineBuffering+    case readInput of+        Just confidence -> if confidence `elem` [0 .. 5] then return $ Just confidence else promptConfidence+        Nothing         -> return Nothing++quizFromDeck :: String -> [Card] -> IO [Card]+quizFromDeck deckName cards = quizSomeCards deckCards cards+    where+    deckCards = filter (\card -> cardDeck card == deckName) cards++getQuizAction :: [Card] -> IO (Maybe QuizAction)+getQuizAction [] = do+            printf $ "No decks, returning to menu" ++ "\n"+            return Nothing+getQuizAction decks = do+    cardsToBeQuizzed <- cardsToQuiz decks+    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
+ src/Remove.hs view
@@ -0,0 +1,58 @@+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 decks = do+        printf $ "What would you like to do?" ++ "\n"+        Input.getUserChoice allRemoveActions++allRemoveActions :: [RemoveAction]+allRemoveActions = [RemoveDeck, RemoveFromDeck]
+ src/StatTracker.hs view
@@ -0,0 +1,15 @@+module StatTracker where++data StatTracker = StatTracker {stTimesQuizzed :: Int, stResponseCounters :: [Int]} deriving (Show, Eq, Read)++newStatTracker :: StatTracker+newStatTracker = StatTracker {stTimesQuizzed = 0, stResponseCounters = replicate 6 0}++updateStatTracker :: StatTracker -> Int -> StatTracker+updateStatTracker st confidence = st {stTimesQuizzed = oldTimesQuizzed + 1, stResponseCounters = updateResponseCounters oldCounters confidence}+    where+    oldTimesQuizzed = stTimesQuizzed st + 1+    oldCounters     = stResponseCounters st++updateResponseCounters :: [Int] -> Int -> [Int]+updateResponseCounters counters confidence = [newCount | i <- [0..5], let newCount = counters !! i + (if confidence == i then 1 else 0)]
+ src/Tracker.hs view
@@ -0,0 +1,26 @@+module Tracker where+import Card+import Data.Time.Clock.POSIX+import Data.Maybe(fromJust, isNothing)++sm2 :: Int -> Float -> Float+sm2 0 _  = 1+sm2 1 _  = 1+sm2 2 _  = 6+sm2 n ef = sm2 (n-1) ef * ef++shouldQuizCard :: Card -> IO Bool+shouldQuizCard card = do+    currentTime <- fmap round getPOSIXTime :: IO Integer+    let timeDifference = currentTime - fromIntegral (ctTimeQuizzed (cardTracker card))+        daysSinceQuiz = floor $ (fromIntegral timeDifference :: Float) / 86400+        sm2Time = (ceiling $ sm2 (ctN tracker) (ctEF tracker)) :: Integer+        tracker = cardTracker card+        lastResponse = ctLastResponseQuality tracker+        noLastResponse = isNothing lastResponse+        justLastResponse = fromJust lastResponse+    return (daysSinceQuiz >= sm2Time ||  noLastResponse || justLastResponse < 4)++adjustEF :: Float -> Int -> Float+adjustEF ef confidence = ef-0.8+0.28*q-0.02*q*q+    where q = fromIntegral confidence :: Float