Yvee1/hascard
1
1
Fork 0
mirror of https://github.com/Yvee1/hascard.git synced 2024-11-22 04:33:06 +03:00
Code Issues Projects Releases Wiki Activity

Add setting for shuffling answers (fixes #19)

Browse Source
This commit is contained in:
Yvee1 2023-03-05 17:26:22 +01:00
parent 6e418827c7
commit 4b0981240d
5 changed files with 61 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/DeckHandling.hs
View File

@ -1,14 +1,34 @@
module DeckHandling where
import Control.Monad (forM)
import qualified Data.List.NonEmpty as NE
import Data.Random
import Lens.Micro.Platform
import States
import Types
doRandomization :: GlobalState -> [a] -> IO [a]
doRandomization gs cards =
let n = length cards in do
cards' <- if gs^.parameters.pShuffle then sampleFrom (gs^.mwc) (shuffleN n cards) else return cards
return $ maybe cards' (`take` cards') (gs^.parameters.pSubset)
doRandomization :: GlobalState -> Bool -> [Card] -> IO ([Int], [Card])
doRandomization gs shuffleAnswers cards = do
let ixs = [0..length cards - 1]
shuffledIxs <- if gs^.parameters.pShuffle then sampleFrom (gs^.mwc) (shuffle ixs) else return ixs
let cards' = map (cards !!) shuffledIxs
cards'' <- if shuffleAnswers
then sampleFrom (gs^.mwc) $ mapM shuffleCard cards'
else return cards'
return $ (shuffledIxs, cards'')
shuffleCard :: Card -> RVar Card
shuffleCard (c@MultipleAnswer{}) = do
shuffledOptions <- shuffle . NE.toList $ options c
return $ c { options = NE.fromList shuffledOptions }
shuffleCard (c@MultipleChoice{}) = do
let CorrectOption ic sc = correct c
ixs = [0..length (incorrects c)]
shuffledIxs <- shuffle ixs
let ic' = shuffledIxs !! ic
corrOpt = CorrectOption ic' sc
incOpts = map (\i -> (incorrects c !!) $ if i > ic' then i - 1 else i) (filter (/= ic') shuffledIxs)
return $ c { correct = corrOpt, incorrects = incOpts }
shuffleCard c = return c
doChunking :: Chunk -> [a] -> [a]
doChunking (Chunk i n) cards =

18
src/Runners.hs
View File

@ -42,18 +42,20 @@ safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x
cardsState :: Bool -> FilePath -> [Card] -> IO State
cardsState doReview fp deck = do
cardsState :: Bool -> FilePath -> [Card] -> [Card] -> [Int] -> IO State
cardsState doReview fp originalDeck shuffledDeck ixs = do
hints <- getShowHints
controls <- getShowControls
caseSensitive <- getCaseSensitive
let mFirstCard = safeHead deck
let mFirstCard = safeHead shuffledDeck
firstCard = fromMaybe (Definition "Empty deck" Nothing "Click enter to go back.") mFirstCard
deck' = maybe [firstCard] (const deck) mFirstCard
deck' = maybe [firstCard] (const shuffledDeck) mFirstCard
initialState =
CS { _cards = deck'
CS { _originalCards = originalDeck
, _shownCards = deck'
, _indexMapping = ixs
, _index = 0
, _currentCard = firstCard
, _cardState = defaultCardState firstCard
@ -72,7 +74,11 @@ cardsState doReview fp deck = do
cardsWithOptionsState :: GlobalState -> FilePath -> [Card] -> IO State
cardsWithOptionsState gs fp cards =
let chunked = doChunking (gs^.parameters.pChunk) cards
in doRandomization gs chunked >>= cardsState (gs^.parameters.pReviewMode) fp
trimmed = maybe id take (gs^.parameters.pSubset) chunked
in do
shuffleAnswers <- getShuffleAnswers
(ixs, shuffledCards) <- doRandomization gs shuffleAnswers trimmed
cardsState (gs^.parameters.pReviewMode) fp trimmed shuffledCards ixs
infoState :: State
infoState = InfoState ()

9
src/Settings.hs
View File

@ -29,6 +29,11 @@ getCaseSensitive = do
settings <- getSettings
return $ settings ^. caseSensitive
getShuffleAnswers :: IO Bool
getShuffleAnswers = do
settings <- getSettings
return $ settings ^. shuffleAnswers
getUseEscapeCode :: IO Bool
getUseEscapeCode = do
settings <- getSettings
@ -65,7 +70,8 @@ getSettingsFile = do
return (dir </> "settings")
defaultSettings :: Settings
defaultSettings = FormState { _hints=False, _controls=True, _caseSensitive=True, _escapeCode=False, _maxRecents=5}
defaultSettings = FormState { _hints=False, _controls=True, _caseSensitive=True,
_shuffleAnswers=False, _escapeCode=False, _maxRecents=5}
setSettings :: Settings -> IO ()
setSettings settings = do
@ -83,6 +89,7 @@ mkForm =
[ label "Draw hints using underscores for definition cards" @@= yesnoField False hints HintsField ""
, label "Show controls at the bottom of screen" @@= yesnoField False controls ControlsField ""
, label "Open questions are case sensitive" @@= yesnoField False caseSensitive CaseSensitiveField ""
, label "Shuffle answers to multiple choice questions" @@= yesnoField False shuffleAnswers ShuffleAnswersField ""
, label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField False escapeCode EscapeCodeField ""
, label "Maximum number of recently selected files stored" @@= naturalNumberField 999 maxRecents MaxRecentsField "" ]

6
src/States.hs
View File

@ -20,6 +20,7 @@ data Name =
HintsField
| ControlsField
| CaseSensitiveField
| ShuffleAnswersField
| EscapeCodeField
| MaxRecentsField
@ -129,7 +130,9 @@ defaultCardState Reorder{elements=elts} = ReorderState
, _number = NE.length elts }
data CS = CS
{ _cards :: [Card] -- list of flashcards
{ _originalCards :: [Card] -- the deck as it was parsed
, _shownCards :: [Card] -- the deck after shuffling answers and cards
, _indexMapping :: [Int] -- contains the order that shownCards has wrt originalCards
, _index :: Int -- current card index
, _nCards :: Int -- number of cards
, _currentCard :: Card
@ -175,6 +178,7 @@ data Settings = FormState
{ _hints :: Bool
, _controls :: Bool
, _caseSensitive :: Bool
, _shuffleAnswers :: Bool
, _escapeCode :: Bool
, _maxRecents :: Int }
deriving (Read, Show)

18
src/UI/Cards.hs
View File

@ -8,10 +8,12 @@ import Types
import States
import StateManagement
import Data.Char (isSpace, toLower)
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Maybe
import Data.List.Split
import Debug
import Text.Wrap
import Data.Text (pack)
import UI.Attributes
@ -64,7 +66,7 @@ drawFooter s = if s^.reviewMode
drawCardUI :: CS -> Widget Name
drawCardUI s = let p = 1 in
joinBorders $ drawCardBox $ (<=> drawFooter s) $
case (s ^. cards) !! (s ^. index) of
case (s ^. shownCards) !! (s ^. index) of
Definition title _ descr -> drawHeader title
<=> B.hBorder
<=> padLeftRight p (drawDef s descr <=> str " ")
@ -424,22 +426,22 @@ handleEvent gs _ _ = continue gs
next :: GlobalState -> CS -> EventM Name (Next GlobalState)
next gs s
| s ^. index + 1 < length (s ^. cards) = liftIO (openCardExternal (takeDirectory (s^.pathToFile)) ((s^.cards) !! (s^.index + 1))) *> (continue . updateCS gs . straightenState $ s & index +~ 1)
| s ^. index + 1 < length (s ^. shownCards) = liftIO (openCardExternal (takeDirectory (s^.pathToFile)) ((s^.shownCards) !! (s^.index + 1))) *> (continue . updateCS gs . straightenState $ s & index +~ 1)
| s ^. reviewMode =
let thePopup =
if null (s^.correctCards) || length (s^. correctCards) == length (s^.cards)
if null (s^.correctCards) || length (s^. correctCards) == length (s^.shownCards)
then finalPopup
else deckMakerPopup
in continue . updateCS gs $ s & popup ?~ thePopup
| otherwise = halt' gs
previous :: GlobalState -> CS -> EventM Name (Next GlobalState)
previous gs s | s ^. index > 0 = liftIO (openCardExternal (takeDirectory (s^.pathToFile)) ((s^.cards) !! (s^.index - 1))) *> (continue . updateCS gs . straightenState $ s & index -~ 1)
previous gs s | s ^. index > 0 = liftIO (openCardExternal (takeDirectory (s^.pathToFile)) ((s^.shownCards) !! (s^.index - 1))) *> (continue . updateCS gs . straightenState $ s & index -~ 1)
| otherwise = continue gs
straightenState :: CS -> CS
straightenState s =
let card = (s ^. cards) !! (s ^. index) in s
let card = (s ^. shownCards) !! (s ^. index) in s
& currentCard .~ card
& cardState .~ defaultCardState card
@ -547,6 +549,7 @@ deckMakerPopup = Popup drawer eventHandler initialState
continue' = continue . update
p = fromJust (s ^. popup)
state = p ^. popupState
originalCorrects = sortOn negate (map ((s ^. indexMapping) !!) (s ^. correctCards))
in case state ^?! popupSelected of
0 -> case ev of
V.EvKey V.KEnter [] -> continue' $ s & popup ?~ (p & popupState.makeDeckIncorrect %~ not)
@ -561,7 +564,8 @@ deckMakerPopup = Popup drawer eventHandler initialState
V.EvKey (V.KChar 'k') [] -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)
_ -> continue' s
2 -> case ev of
V.EvKey V.KEnter [] -> liftIO (generateDecks (s ^. pathToFile) (s ^. cards) (s ^. correctCards) (state ^?! makeDeckCorrect) (state ^?! makeDeckIncorrect))
V.EvKey V.KEnter [] -> liftIO (generateDecks (s ^. pathToFile)
(s ^. originalCards) originalCorrects (state ^?! makeDeckCorrect) (state ^?! makeDeckIncorrect))
*> halt' gs
V.EvKey V.KUp [] -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)
V.EvKey (V.KChar 'k') [] -> continue' $ s & popup ?~ (p & popupState.popupSelected -~ 1)
@ -574,7 +578,7 @@ generateDecks fp cards corrects makeCorrect makeIncorrect =
when makeCorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "+")) (cardsToString correct)
when makeIncorrect $ writeFile (replaceBaseName fp (takeBaseName fp <> "-")) (cardsToString incorrect)
-- gets list of cards, list of indices of correct cards; returns (correct, incorrect)
-- gets list of cards, list of indices of correct cards in decreasing order; returns (correct, incorrect)
splitCorrectIncorrect :: [Card] -> [Int] -> ([Card], [Card])
splitCorrectIncorrect cards indices = doSplit [] [] (zip [0..] cards) (reverse indices)
where doSplit cs ws [] _ = (reverse cs, reverse ws)