clanki 1.0.2 → 1.0.3

raw patch · 9 files changed

+339/−2 lines, 9 files

Files

• clanki.cabal +2/−2
• src/Add.hs +76/−0
• src/Card.hs +19/−0
• src/Decks.hs +21/−0
• src/Display.hs +5/−0
• src/Input.hs +36/−0
• src/Quiz.hs +93/−0
• src/Remove.hs +60/−0
• src/Tracker.hs +27/−0

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                clanki-version:             1.0.2+version:             1.0.3 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@@ -17,7 +17,7 @@  executable clanki   main-is:             Main.hs-  --other-modules:       src+  other-modules:       Add, Quiz, Remove, Display, Card, Decks, Input, Tracker   -- other-extensions:       build-depends:       base >=4.7 && <4.8, time >= 1.4.2, directory >= 1.2.1.0, safe   hs-source-dirs:      src

@@ -0,0 +1,76 @@+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 addAct = show addAct++addLoop :: [Deck] -> IO [Deck]+addLoop decks = do+    addAction <- getAddAction decks+    runAddAction addAction decks++runAddAction :: Maybe AddAction -> [Deck] -> IO [Deck]+runAddAction addAction decks+    | addAction == Just NewDeck = newDeck decks+    | addAction == Just ToDeck  = toDeck decks+    | addAction == Nothing      = return decks++newDeck :: [Deck] -> IO [Deck]+newDeck decks = do+    printf $ "Please input the name of the new deck" ++ "\n"+    deckName <- getLine+    case deckName of +        "" -> do+                return decks+        _  -> if any (\deck -> dName deck == deckName) decks+                then do+                  printf $ "Invalid input, already a deck with that name" ++ "\n"+                  newDeck decks+                else +                  return $ addDeckWithName deckName decks++addDeckWithName :: String -> [Deck] -> [Deck]+addDeckWithName name decks = decks ++ [Deck {dCards = [], dName = name}]++toDeck :: [Deck] -> IO [Deck]+toDeck decks = do+    chosenDeck <- Input.getUserChoice $ decks+    case chosenDeck of+        Just deck -> do+                        deckWithNewItems <- toDeckLoop deck+                        let newDecks = replaceDeckNamed (dName deck) deckWithNewItems decks+                        return $ newDecks+        Nothing -> return decks+++toDeckLoop :: Deck -> IO Deck+toDeckLoop deck = 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 deck+        _  -> do+                printf $ "Please input the answer" ++ "\n"+                answer <- getLine+                case answer of+                    "" -> do+                        printf $ "You wish to stop adding" ++ "\n"+                        return deck+                    _  -> do+                        let card = newCard question answer+                        toDeckLoop (addCardToDeck card deck)++getAddAction :: [Deck] -> IO (Maybe AddAction)+getAddAction decks+    | null decks = return $ Just NewDeck+    | otherwise = Input.getUserChoice allAddActions++allAddActions :: [AddAction]+allAddActions = [NewDeck, ToDeck]

@@ -0,0 +1,19 @@+module Card where +import Display+import Text.Printf(printf)+data CardTracker = CardTracker {ctEF :: Float, ctN :: Int, ctTimeQuizzed :: Integer, ctLastResponseQuality :: Maybe Integer} deriving (Show, Read, Eq)++data Card = Card {cardQuestion :: String, cardAnswer :: String, cardTracker :: CardTracker} deriving (Show, Read, Eq)++newCard :: String -> String -> Card+newCard question answer = Card {cardQuestion = question, cardAnswer = answer, cardTracker = newCardTracker} ++newCardTracker :: CardTracker+newCardTracker = CardTracker {ctEF = 2.5, ctN = 0, ctTimeQuizzed = 0, ctLastResponseQuality = Nothing}++instance Display Card where+    display card = cardQuestion card ++ "\n" ++ cardAnswer card++printCard :: Card -> IO ()+printCard card = printf $ cardQuestion card ++ "\n" ++ cardAnswer card+

@@ -0,0 +1,21 @@+module Decks where+import Card+import Display+import Data.List(delete)+data Deck = Deck {dCards :: [Card], dName :: String} deriving (Show, Eq, Read)++instance Display Deck where+    display = dName -- ++ "\n" ++ concat [display card ++ "\n" | card <- dCards deck] ++ "--------"++addCardToDeck :: Card -> Deck -> Deck+addCardToDeck card deck = deck {dCards = dCards deck ++ [card]}++removeCardFromDeck :: Card -> Deck -> Deck+removeCardFromDeck card deck = deck {dCards = delete card (dCards deck)}++allCards :: [Deck] -> [Card]+allCards decks = concat [dCards deck | deck <- decks]++replaceDeckNamed :: String -> Deck -> [Deck] -> [Deck]+replaceDeckNamed deckName deck decks = filter (\d -> dName d /= deckName) decks ++ [deck]+

@@ -0,0 +1,5 @@+module Display where++class (Show a) => Display a where+    display :: a -> String+

@@ -0,0 +1,36 @@+module Input(getUserChoice) 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']++repKeysAndValues :: (Display a) => [(String, a)] -> String+repKeysAndValues choices = unlines [key ++ ")" ++ " " ++ display a | (key, a) <- choices]++getUserChoice :: (Display a) => [a] -> IO (Maybe a)+getUserChoice = getChoiceWithKeys . zip keys++getChoiceWithKeys :: (Display a) => [(String, a)] -> IO (Maybe a)+getChoiceWithKeys 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++userInputLetter :: IO String+userInputLetter = do+    input <- fmap (:[]) getChar+    putStrLn ""+    return input++

@@ -0,0 +1,93 @@+module Quiz where+import Card+import Decks+import Tracker+import Data.List(lookup)+import Data.Char(isSpace)+import Display+import Text.Printf(printf)+import Safe(readMay)+import Data.Time.Clock.POSIX+import qualified Input+data QuizAction = AllCards | FromDeck deriving (Show, Eq)++allQuizActions :: [QuizAction]+allQuizActions = [AllCards, FromDeck]++instance Display QuizAction where+    display quizAct +        | quizAct == AllCards = "Quiz from all cards"+        | quizAct == FromDeck = "Quiz from a deck"++quizLoop :: [Deck] -> IO [Deck]+quizLoop decks = do+    quizAction <- getQuizAction decks+    runQuizAction quizAction decks++anyCardsToQuiz :: [Deck] -> IO Bool+anyCardsToQuiz decks = do+    let cards = allCards decks+    sequence [shouldQuizCard card | card <- cards] >>= return . (True `elem`)++runQuizAction :: Maybe QuizAction -> [Deck] -> IO [Deck]+runQuizAction quizAct decks+    | quizAct == Just AllCards = quizDecks decks decks+    | quizAct == Just FromDeck = do+        input <- Input.getUserChoice decks+        case input of+            Just deck -> return decks+            Nothing   -> return decks+    | otherwise = return decks++quizDecks :: [Deck] -> [Deck] -> IO [Deck]+quizDecks decksToQuiz allDecks = sequence $ map (\deck -> if deck `elem` decksToQuiz then quizDeck deck else return deck) allDecks++quizDeck :: Deck -> IO Deck+quizDeck deck = do+    newCards <- sequence [maybeQuiz card | card <- dCards deck]+    return deck {dCards = newCards}+++maybeQuiz :: Card -> IO Card+maybeQuiz card = shouldQuizCard card >>= (\shouldQuiz -> if shouldQuiz then quizCard card else return card)+    ++{-quizCards :: [Card] -> [Deck] -> IO [Deck]-}+{-quizCards cards decks = return decks-}+    {-newTrackers <- sequence [quizCard card tracker | card <- cards, let tracker = trackerOfCard card (cardTrackers decks)]-}+    {--- TODO: replace trackers, but not all -}+    {-return $ decks {cardTrackers = newTrackers}-}++quizCard :: Card -> IO Card+quizCard card = do+    printf $ "Question : " ++ cardQuestion card ++ "\n"+    printf "Input your answer, then press enter to continue\n"+    _ <- getLine+    --printf $ "Answer : " ++ cardAnswer card ++ "\n"+    printf "Did you get it right?\n"+    confidence <- getAnswerConfidence+    let newEF = adjustEF (ctEF $ cardTracker card) confidence+    let oldTracker = cardTracker card+    let n = if confidence < 3 then 1 else ctN oldTracker + 1+    currentTime <- fmap round getPOSIXTime+    printf "\n"+    return $ card {cardTracker = oldTracker {ctEF = newEF, ctN = n, ctLastResponseQuality = Just confidence, ctTimeQuizzed = currentTime}}++getAnswerConfidence :: IO Integer+getAnswerConfidence = do+    input <- getLine +    let readInput = readMay input :: Maybe Integer+    case readInput of+        Just confidence -> if confidence `elem` [1 .. 5] then return confidence else getAnswerConfidence+        Nothing         -> getAnswerConfidence+++++{-quizFromDeck :: Deck -> [Deck] -> IO [Deck]-}+{-quizFromDeck deck decks = return decks-}++getQuizAction :: [Deck] -> IO (Maybe QuizAction)+getQuizAction decks = Input.getUserChoice allQuizActions+    +

@@ -0,0 +1,60 @@+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 removeAct+        | removeAct == RemoveDeck = "Remove a deck"+        | removeAct == RemoveFromDeck = "Remove cards from a deck"++removeLoop :: [Deck] -> IO [Deck]+removeLoop decks = do+    removeAction <- getRemoveAction decks+    updatedDecks <- runRemoveAction removeAction decks+    return $ updatedDecks++runRemoveAction :: Maybe RemoveAction -> [Deck] -> IO [Deck]+runRemoveAction removeAction decks+    | removeAction == Just RemoveDeck     = removeDeck decks+    | removeAction == Just RemoveFromDeck = removeFromDeck decks+    | removeAction == Nothing             = 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 (\deck -> length (dCards deck) > 0) 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 length (dCards deck) > 0 +                        then removeFromDeckLoop $ removeCardFromDeck card deck+                        else return deck+        Nothing    -> return deck++getRemoveAction :: [Deck] -> IO (Maybe RemoveAction)+getRemoveAction decks+    | null decks = return Nothing+    | all (\deck -> length (dCards deck) == 0) decks = return $ Just RemoveDeck+    | otherwise  = Input.getUserChoice allRemoveActions++allRemoveActions :: [RemoveAction]+allRemoveActions = [RemoveDeck, RemoveFromDeck]

@@ -0,0 +1,27 @@+module Tracker where+import Card+import Data.Time.Clock.POSIX+import Data.Maybe(fromJust, fromMaybe, isNothing)++sm2 :: Int -> Float -> Float+sm2 n ef+    | n == 0 = 1+    | n == 1 = 1+    | n == 2 = 6+    | otherwise = sm2 (n-1) ef++shouldQuizCard :: Card -> IO Bool+shouldQuizCard card = do+    currentTime <- fmap round getPOSIXTime+    let timeDifference = currentTime - (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 -> Integer -> Float+adjustEF ef confidence = ef-0.8+0.28*q-0.02*q*q+    where q = fromIntegral confidence :: Float