clanki 1.0.7 → 1.1.0
raw patch · 10 files changed
+81/−369 lines, 10 filesdep ~base
Dependency ranges changed: base
Files
- clanki.cabal +3/−3
- src/Add.hs +0/−77
- src/Card.hs +0/−19
- src/Decks.hs +0/−21
- src/Display.hs +0/−5
- src/Input.hs +0/−36
- src/Main.hs +78/−24
- src/Quiz.hs +0/−99
- src/Remove.hs +0/−59
- src/Tracker.hs +0/−26
clanki.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: clanki-version: 1.0.7+version: 1.1.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,8 +20,8 @@ executable clanki main-is: Main.hs- other-modules: Add, Quiz, Remove, Display, Card, Decks, Input, Tracker+ --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+ build-depends: base >=4.6 && <4.8, time >= 1.4.2, directory >= 1.2.1.0, safe hs-source-dirs: src default-language: Haskell2010
− src/Add.hs
@@ -1,77 +0,0 @@-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 :: [Deck] -> IO [Deck]-addLoop decks = do- addAction <- getAddAction decks- runAddAction addAction decks--runAddAction :: Maybe AddAction -> [Deck] -> IO [Deck]-runAddAction = maybe return newOrTo- where- newOrTo NewDeck = newDeck- newOrTo ToDeck = toDeck--newDeck :: [Deck] -> IO [Deck]-newDeck decks = do- printf $ "Please input the name of the new deck" ++ "\n"- deckName <- getLine- case deckName of - "" -> 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 [] = return $ Just NewDeck-getAddAction _ = do- printf $ "What would you like to do?" ++ "\n"- Input.getUserChoice allAddActions--allAddActions :: [AddAction]-allAddActions = [NewDeck, ToDeck]
− src/Card.hs
@@ -1,19 +0,0 @@-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-
− src/Decks.hs
@@ -1,21 +0,0 @@-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]-
− src/Display.hs
@@ -1,5 +0,0 @@-module Display where--class (Show a) => Display a where- display :: a -> String-
− src/Input.hs
@@ -1,36 +0,0 @@-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--
src/Main.hs view
@@ -1,13 +1,19 @@ module Main where-import Decks+{-import Decks-} import Add import Input import Remove import Quiz+import Card+import Tracker import Text.Printf(printf)+import Display+import System.Environment(getArgs) import System.Directory(doesFileExist)+import Data.Maybe(isJust)+import Safe(readMay)+import Control.Monad(filterM) -import Display data Action = Quiz | Add | Remove | Show | Quit deriving (Show, Eq, Ord, Enum) instance Display Action where@@ -20,48 +26,96 @@ getAction = do Input.getUserChoice allActions -runAction :: Maybe Action -> [Deck] -> IO [Deck]-runAction (Just Quit) decks = return decks-runAction (Just Add) decks = addLoop decks >>= mainLoop-runAction (Just Quiz) decks = quizLoop decks >>= mainLoop-runAction (Just Remove) decks = removeLoop decks >>= mainLoop-runAction (Just Show) decks = do- printf $ show decks ++ "\n"- mainLoop decks-runAction Nothing decks = do+runAction :: Maybe Action -> [Card] -> IO ()+runAction (Just Quit) cards = do+ saveData cards+ return ()+runAction (Just Add) cards = addLoop cards >>= mainLoop+runAction (Just Quiz) cards = quizLoop cards >>= mainLoop+runAction (Just Remove) cards = removeLoop cards >>= mainLoop+runAction (Just Show) cards = do+ displayAllDecks cards+ mainLoop cards+runAction Nothing cards = do printf $ "Invalid input" ++ "\n"- mainLoop decks--{-showDecks decks = printf $ unlines $ map display decks-}+ mainLoop cards fileName :: String fileName = "data.clanki" --mainLoop :: [Deck] -> IO [Deck]+mainLoop :: [Card] -> IO () mainLoop decks = do action <- getAction runAction action decks --loadData :: IO [Deck]+loadData :: IO [Card] loadData = do fileExists <- doesFileExist fileName if fileExists then do x <- readFile fileName- return (read x :: [Deck])+ return (read x :: [Card]) else return [] -saveData :: [Deck] -> IO ()+saveData :: [Card] -> IO () saveData decks = writeFile fileName (show decks) +startWithArgs :: [String] -> [Card] -> IO [Card]+startWithArgs args cards+ | null args = return cards+ | "--help" `elem` args || "-h" `elem` args = + do+ displayHelp+ return cards+ | "--list" `elem` args || "-l" `elem` args =+ do+ displayAllDecks cards+ return cards+ {-| "--stats" `elem` args || "-s" `elem` args =-}+ {-do-}+ {-displayList decks-}+ {-return decks-}+ | firstOptionIsNum = do+ let numOfCardsToQuiz = read (head args) :: Int+ quizSomeCards (take numOfCardsToQuiz cards) cards+ | firstOptionIsDeck = do+ if secondOptionIsNum+ then do+ let numOfCardsToQuiz = read $ args !! 1+ let deckCards = cardsInDeck (head args) cards+ cardsToQuiz <- filterM shouldQuizCard (take numOfCardsToQuiz deckCards)+ quizSomeCards cardsToQuiz cards+ else do+ cardsToQuiz <- filterM shouldQuizCard (cardsInDeck (head args) cards)+ quizSomeCards cardsToQuiz cards+ | head args == "-add" = do+ let deckName = args !! 1+ let question = args !! 2+ let answer = args !! 3+ if length args >= 5 && args !! 4 == "-2"+ then return $ cards ++ [newCard question answer deckName] ++ [newCard answer question deckName]+ else return $ cards ++ [newCard question answer deckName]+ | otherwise = return cards+ where+ isDeckName str = hasDeckNamed str cards+ firstOptionIsNum = isJust (readMay (head args) :: Maybe Int)+ firstOptionIsDeck = isDeckName (head args)+ secondOptionIsNum = length args > 1 && isJust (readMay (args !! 1) :: Maybe Int) ++displayHelp :: IO ()+displayHelp = do+ printf $ "OPTIONS:" ++ "\n"+ printf $ "--list -l List available decks in default directory" ++ "\n"+ printf $ "--stats -s Show some stats about the decks" ++ "\n"+ printf $ "--help -h Show this help" ++ "\n"+ main :: IO () main = do- decks <- loadData- newDecks <- mainLoop decks- saveData newDecks- return ()+ cards <- loadData+ args <- getArgs+ newCards <- startWithArgs args cards+ mainLoop newCards +
− src/Quiz.hs
@@ -1,99 +0,0 @@-module Quiz where-import Card-import Decks-import Tracker-import Display-import Text.Printf(printf)-import Safe(readMay)-import Data.Time.Clock.POSIX-import qualified Input-import Control.Monad(filterM)-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 :: [Deck] -> IO [Deck]-quizLoop decks = do- quizAction <- getQuizAction decks- runQuizAction quizAction decks--anyCardsToQuiz :: [Deck] -> IO Bool-anyCardsToQuiz decks = shouldQuizList >>= return . (True `elem`)- where shouldQuizList = sequence [shouldQuizCard card | card <- allCards decks] --runQuizAction :: Maybe QuizAction -> [Deck] -> IO [Deck]-runQuizAction (Just AllCards) decks = quizDecks decks decks-runQuizAction (Just FromDeck) decks = do- input <- Input.getUserChoice decks- case input of- Just deck -> quizFromDeck deck decks- Nothing -> return decks-runQuizAction Nothing decks = 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)--cardsToQuiz :: [Deck] -> IO [Card]-cardsToQuiz decks = filterM shouldQuizCard cards- where cards = allCards decks- --{-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 $ "Rate your answer, 0-5" ++ "\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 = quizDeck deck >>= (\newDeck -> return $ replaceDeckNamed (dName deck) newDeck decks)--getQuizAction :: [Deck] -> 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
@@ -1,59 +0,0 @@-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]
− src/Tracker.hs
@@ -1,26 +0,0 @@-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 - 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