{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Server.Logic.Decks
( computeCardProficiencyScore
, retrieveDeckProficiency
, updateDeckProficiencyByRegisteringExerciseAttempt
, retrieveDeckPreferences
, updateDeckPreferencesByTogglingCard
, retrieveDeckActiveCards
) where

import Core
import Server.Core
import Server.Logic.Redis (encodeRedisKey)
import Data.Maybe (fromMaybe)
import Data.Either (fromRight)
import Control.Exception (assert)
import qualified Database.Redis as Redis
import qualified Data.Aeson as A
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString as BSS

-- * Logic
computeCardProficiencyScore :: CardProficiency -> Double
computeCardProficiencyScore :: CardProficiency -> Double
computeCardProficiencyScore CardProficiency
cardProficiency = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
successfulAttempts) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minimumSuccessfulAttemptsForPerfectProficiencyScore) where
    attempts :: [Bool]
attempts = Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
numberOfAttemptsUsedInProficiencyScoreCalculation ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ CardProficiency -> [Bool]
lastAttempts CardProficiency
cardProficiency [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
    successfulAttempts :: [Bool]
successfulAttempts = (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) [Bool]
attempts

computeCardProficiencyWeight :: CardProficiency -> Int
computeCardProficiencyWeight :: CardProficiency -> Int
computeCardProficiencyWeight CardProficiency
cardProficiency = Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
universalBaseWeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
universalBaseWeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
totalWeightOfFailedAttempts where
    universalBaseWeight :: Int
universalBaseWeight = Int
100 -- For context, the maximum possible `totalWeightOfFailedAttempts` (i.e. the weight for a completely new card) is 20^2 + 19^2 + ... + 1^2 = 2871
    baseWeightOfMostRecentAttempt :: Int
baseWeightOfMostRecentAttempt = Int
20
    attempts :: [Bool]
attempts = CardProficiency -> [Bool]
lastAttempts CardProficiency
cardProficiency
    weightedAttempts :: [(Int, Bool)]
weightedAttempts = Bool -> [(Int, Bool)] -> [(Int, Bool)]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
baseWeightOfMostRecentAttempt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numberOfAttemptsTracked) ([(Int, Bool)] -> [(Int, Bool)]) -> [(Int, Bool)] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
baseWeightOfMostRecentAttempt,Int
baseWeightOfMostRecentAttemptInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1..] [Bool]
attempts
    weightedFailedAttempts :: [(Int, Bool)]
weightedFailedAttempts = ((Int, Bool) -> Bool) -> [(Int, Bool)] -> [(Int, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Int, Bool) -> Bool) -> (Int, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd) [(Int, Bool)]
weightedAttempts
    totalWeightOfFailedAttempts :: Int
totalWeightOfFailedAttempts = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, Bool) -> Int) -> [(Int, Bool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Bool) -> Int
forall a b. (a, b) -> a
fst [(Int, Bool)]
weightedFailedAttempts

computeCardLastAttemptCorrectness :: CardProficiency -> Bool
computeCardLastAttemptCorrectness :: CardProficiency -> Bool
computeCardLastAttemptCorrectness CardProficiency
cardProficiency = Bool
lastAttempt where
    attempts :: [Bool]
attempts = CardProficiency -> [Bool]
lastAttempts CardProficiency
cardProficiency
    lastAttempt :: Bool
lastAttempt = if [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
attempts then Bool
False else [Bool] -> Bool
forall a. (?callStack::CallStack) => [a] -> a
head [Bool]
attempts

-- * Configuration

-- | Last X attempts will be saved into the database.
numberOfAttemptsTracked :: Int
numberOfAttemptsTracked :: Int
numberOfAttemptsTracked = Int
20

-- | Last Y (Y <= X) attempts will be used to compute the user's proficiency score.
numberOfAttemptsUsedInProficiencyScoreCalculation :: Int
numberOfAttemptsUsedInProficiencyScoreCalculation :: Int
numberOfAttemptsUsedInProficiencyScoreCalculation = Int
10

minimumSuccessfulAttemptsForPerfectProficiencyScore :: Int
minimumSuccessfulAttemptsForPerfectProficiencyScore :: Int
minimumSuccessfulAttemptsForPerfectProficiencyScore = Int
8

-- * Redis bindings

deckPreferencesKey :: UserIdentifier -> Deck -> T.Text
deckPreferencesKey :: UserIdentifier -> Deck -> Text
deckPreferencesKey UserIdentifier
userIdentifier Deck
deck = Text
"DeckPreferences" Text -> Text -> Text
`T.append` UserIdentifier -> Deck -> Text
deckKey UserIdentifier
userIdentifier Deck
deck

deckProficiencyKey :: UserIdentifier -> Deck -> T.Text
deckProficiencyKey :: UserIdentifier -> Deck -> Text
deckProficiencyKey UserIdentifier
userIdentifier Deck
deck = Text
"DeckProficiency" Text -> Text -> Text
`T.append` UserIdentifier -> Deck -> Text
deckKey UserIdentifier
userIdentifier Deck
deck

deckKey :: UserIdentifier -> Deck -> T.Text
deckKey :: UserIdentifier -> Deck -> Text
deckKey UserIdentifier
userIdentifier Deck
deck = [(Text, Text)] -> Text
encodeRedisKey
    [ (Text
"provider", UserIdentifier -> Text
userIdentifierProvider UserIdentifier
userIdentifier)
    , (Text
"subject", UserIdentifier -> Text
userIdentifierSubject UserIdentifier
userIdentifier)
    , (Text
"deck", Deck -> Text
deckId Deck
deck)
    ]

retrieveDeckPreferences :: UserIdentifier -> Deck -> Redis.Redis DeckPreferences
retrieveDeckPreferences :: UserIdentifier -> Deck -> Redis DeckPreferences
retrieveDeckPreferences UserIdentifier
userIdentifier Deck
deck = do
    let key :: Text
key = UserIdentifier -> Deck -> Text
deckPreferencesKey UserIdentifier
userIdentifier Deck
deck
    let defaultDeckPreferences :: DeckPreferences
defaultDeckPreferences = Map Text CardPreferences -> DeckPreferences
DeckPreferences Map Text CardPreferences
forall k a. Map k a
M.empty
    let defaultCardPreferences :: CardPreferences
defaultCardPreferences = CardStatus -> CardPreferences
CardPreferences CardStatus
CardNotStarted
    DeckPreferences
originalDeckPreferences :: DeckPreferences <- DeckPreferences -> Maybe DeckPreferences -> DeckPreferences
forall a. a -> Maybe a -> a
fromMaybe DeckPreferences
defaultDeckPreferences (Maybe DeckPreferences -> DeckPreferences)
-> (Either Reply (Maybe ByteString) -> Maybe DeckPreferences)
-> Either Reply (Maybe ByteString)
-> DeckPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe DeckPreferences
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe DeckPreferences)
-> (Either Reply (Maybe ByteString) -> ByteString)
-> Either Reply (Maybe ByteString)
-> Maybe DeckPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.fromStrict (ByteString -> ByteString)
-> (Either Reply (Maybe ByteString) -> ByteString)
-> Either Reply (Maybe ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
BSS.empty (Maybe ByteString -> ByteString)
-> (Either Reply (Maybe ByteString) -> Maybe ByteString)
-> Either Reply (Maybe ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString
-> Either Reply (Maybe ByteString) -> Maybe ByteString
forall b a. b -> Either a b -> b
fromRight Maybe ByteString
forall a. Maybe a
Nothing (Either Reply (Maybe ByteString) -> DeckPreferences)
-> Redis (Either Reply (Maybe ByteString)) -> Redis DeckPreferences
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get (Text -> ByteString
TE.encodeUtf8 Text
key)
    let originalCardPreferences :: Map Text CardPreferences
originalCardPreferences = DeckPreferences -> Map Text CardPreferences
cardPreferences DeckPreferences
originalDeckPreferences
    let adjustedCardPreferences :: Map Text CardPreferences
adjustedCardPreferences = [(Text, CardPreferences)] -> Map Text CardPreferences
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, CardPreferences)] -> Map Text CardPreferences)
-> [(Text, CardPreferences)] -> Map Text CardPreferences
forall a b. (a -> b) -> a -> b
$ (((Text -> (Text, CardPreferences))
 -> [Text] -> [(Text, CardPreferences)])
-> [Text]
-> (Text -> (Text, CardPreferences))
-> [(Text, CardPreferences)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> (Text, CardPreferences))
-> [Text] -> [(Text, CardPreferences)]
forall a b. (a -> b) -> [a] -> [b]
map) ((Card -> Text) -> [Card] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Card -> Text
cardTitle ([Card] -> [Text]) -> [Card] -> [Text]
forall a b. (a -> b) -> a -> b
$ Deck -> [Card]
deckCards Deck
deck) ((Text -> (Text, CardPreferences)) -> [(Text, CardPreferences)])
-> (Text -> (Text, CardPreferences)) -> [(Text, CardPreferences)]
forall a b. (a -> b) -> a -> b
$ \Text
title -> (Text
title, CardPreferences
-> Text -> Map Text CardPreferences -> CardPreferences
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault CardPreferences
defaultCardPreferences Text
title Map Text CardPreferences
originalCardPreferences)
    let adjustedCardPreferences' :: Map Text CardPreferences
adjustedCardPreferences' = if (CardPreferences -> Bool) -> [CardPreferences] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CardPreferences -> Bool
isCardEnabled (Map Text CardPreferences -> [CardPreferences]
forall k a. Map k a -> [a]
M.elems Map Text CardPreferences
adjustedCardPreferences)
        then Map Text CardPreferences
adjustedCardPreferences
        else Text
-> CardPreferences
-> Map Text CardPreferences
-> Map Text CardPreferences
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Card -> Text
cardTitle (Card -> Text) -> Card -> Text
forall a b. (a -> b) -> a -> b
$ [Card] -> Card
forall a. (?callStack::CallStack) => [a] -> a
head ([Card] -> Card) -> [Card] -> Card
forall a b. (a -> b) -> a -> b
$ Deck -> [Card]
deckCards Deck
deck) (CardStatus -> CardPreferences
CardPreferences CardStatus
CardCurrentlyLearning) Map Text CardPreferences
adjustedCardPreferences
    let adjustedDeckPreferences :: DeckPreferences
adjustedDeckPreferences = Map Text CardPreferences -> DeckPreferences
DeckPreferences Map Text CardPreferences
adjustedCardPreferences'
    DeckPreferences -> Redis DeckPreferences
forall a. a -> Redis a
forall (m :: * -> *) a. Monad m => a -> m a
return DeckPreferences
adjustedDeckPreferences

saveDeckPreferences :: UserIdentifier -> Deck -> DeckPreferences -> Redis.Redis (Either Redis.Reply Redis.Status)
saveDeckPreferences :: UserIdentifier
-> Deck -> DeckPreferences -> Redis (Either Reply Status)
saveDeckPreferences UserIdentifier
userIdentifier Deck
deck DeckPreferences
deckPreferences = do
    let key :: Text
key = UserIdentifier -> Deck -> Text
deckPreferencesKey UserIdentifier
userIdentifier Deck
deck
    ByteString -> ByteString -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set (Text -> ByteString
TE.encodeUtf8 Text
key) (ByteString -> Redis (Either Reply Status))
-> (DeckPreferences -> ByteString)
-> DeckPreferences
-> Redis (Either Reply Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (DeckPreferences -> ByteString) -> DeckPreferences -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeckPreferences -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (DeckPreferences -> Redis (Either Reply Status))
-> DeckPreferences -> Redis (Either Reply Status)
forall a b. (a -> b) -> a -> b
$ DeckPreferences
deckPreferences

retrieveDeckProficiency :: UserIdentifier -> Deck -> Redis.Redis DeckProficiency
retrieveDeckProficiency :: UserIdentifier -> Deck -> Redis DeckProficiency
retrieveDeckProficiency UserIdentifier
userIdentifier Deck
deck = do
    let key :: Text
key = UserIdentifier -> Deck -> Text
deckProficiencyKey UserIdentifier
userIdentifier Deck
deck
    let defaultDeckProficiency :: DeckProficiency
defaultDeckProficiency = Map Text CardProficiency -> DeckProficiency
DeckProficiency Map Text CardProficiency
forall k a. Map k a
M.empty
    let defaultCardProficiency :: CardProficiency
defaultCardProficiency = [Bool] -> CardProficiency
CardProficiency []
    DeckProficiency
originalDeckProficiency :: DeckProficiency <- DeckProficiency -> Maybe DeckProficiency -> DeckProficiency
forall a. a -> Maybe a -> a
fromMaybe DeckProficiency
defaultDeckProficiency (Maybe DeckProficiency -> DeckProficiency)
-> (Either Reply (Maybe ByteString) -> Maybe DeckProficiency)
-> Either Reply (Maybe ByteString)
-> DeckProficiency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe DeckProficiency
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe DeckProficiency)
-> (Either Reply (Maybe ByteString) -> ByteString)
-> Either Reply (Maybe ByteString)
-> Maybe DeckProficiency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.fromStrict (ByteString -> ByteString)
-> (Either Reply (Maybe ByteString) -> ByteString)
-> Either Reply (Maybe ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
BSS.empty (Maybe ByteString -> ByteString)
-> (Either Reply (Maybe ByteString) -> Maybe ByteString)
-> Either Reply (Maybe ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString
-> Either Reply (Maybe ByteString) -> Maybe ByteString
forall b a. b -> Either a b -> b
fromRight Maybe ByteString
forall a. Maybe a
Nothing (Either Reply (Maybe ByteString) -> DeckProficiency)
-> Redis (Either Reply (Maybe ByteString)) -> Redis DeckProficiency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get (Text -> ByteString
TE.encodeUtf8 Text
key)
    let originalCardProficiencies :: Map Text CardProficiency
originalCardProficiencies = DeckProficiency -> Map Text CardProficiency
cardProficiencies DeckProficiency
originalDeckProficiency
    let adjustedCardProficiencies :: Map Text CardProficiency
adjustedCardProficiencies = [(Text, CardProficiency)] -> Map Text CardProficiency
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, CardProficiency)] -> Map Text CardProficiency)
-> [(Text, CardProficiency)] -> Map Text CardProficiency
forall a b. (a -> b) -> a -> b
$ (((Text -> (Text, CardProficiency))
 -> [Text] -> [(Text, CardProficiency)])
-> [Text]
-> (Text -> (Text, CardProficiency))
-> [(Text, CardProficiency)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> (Text, CardProficiency))
-> [Text] -> [(Text, CardProficiency)]
forall a b. (a -> b) -> [a] -> [b]
map) ((Card -> Text) -> [Card] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Card -> Text
cardTitle ([Card] -> [Text]) -> [Card] -> [Text]
forall a b. (a -> b) -> a -> b
$ Deck -> [Card]
deckCards Deck
deck) ((Text -> (Text, CardProficiency)) -> [(Text, CardProficiency)])
-> (Text -> (Text, CardProficiency)) -> [(Text, CardProficiency)]
forall a b. (a -> b) -> a -> b
$ \Text
title -> (Text
title, CardProficiency
-> Text -> Map Text CardProficiency -> CardProficiency
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault CardProficiency
defaultCardProficiency Text
title Map Text CardProficiency
originalCardProficiencies)
    let adjustedDeckProficiency :: DeckProficiency
adjustedDeckProficiency = Map Text CardProficiency -> DeckProficiency
DeckProficiency Map Text CardProficiency
adjustedCardProficiencies
    DeckProficiency -> Redis DeckProficiency
forall a. a -> Redis a
forall (m :: * -> *) a. Monad m => a -> m a
return DeckProficiency
adjustedDeckProficiency

saveDeckProficiency :: UserIdentifier -> Deck -> DeckProficiency -> Redis.Redis (Either Redis.Reply Redis.Status)
saveDeckProficiency :: UserIdentifier
-> Deck -> DeckProficiency -> Redis (Either Reply Status)
saveDeckProficiency UserIdentifier
userIdentifier Deck
deck DeckProficiency
deckProficiency = do
    let key :: Text
key = UserIdentifier -> Deck -> Text
deckProficiencyKey UserIdentifier
userIdentifier Deck
deck
    ByteString -> ByteString -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set (Text -> ByteString
TE.encodeUtf8 Text
key) (ByteString -> Redis (Either Reply Status))
-> (DeckProficiency -> ByteString)
-> DeckProficiency
-> Redis (Either Reply Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (DeckProficiency -> ByteString) -> DeckProficiency -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeckProficiency -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (DeckProficiency -> Redis (Either Reply Status))
-> DeckProficiency -> Redis (Either Reply Status)
forall a b. (a -> b) -> a -> b
$ DeckProficiency
deckProficiency

updateDeckProficiencyByRegisteringExerciseAttempt :: UserIdentifier -> Deck -> T.Text -> Bool -> Redis.Redis (Either Redis.Reply Redis.Status)
updateDeckProficiencyByRegisteringExerciseAttempt :: UserIdentifier
-> Deck -> Text -> Bool -> Redis (Either Reply Status)
updateDeckProficiencyByRegisteringExerciseAttempt UserIdentifier
userIdentifier Deck
deck Text
cardTitle Bool
success =
    let
        updateCardProficiency :: CardProficiency -> CardProficiency
        updateCardProficiency :: CardProficiency -> CardProficiency
updateCardProficiency CardProficiency
oldCardProficiency = [Bool] -> CardProficiency
CardProficiency [Bool]
newLastAttempts where
            oldLastAttempts :: [Bool]
oldLastAttempts = CardProficiency -> [Bool]
lastAttempts CardProficiency
oldCardProficiency
            newLastAttempts :: [Bool]
newLastAttempts = Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
numberOfAttemptsTracked ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Bool
success Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
oldLastAttempts
    in do
        DeckProficiency
oldDeckProficiency <- UserIdentifier -> Deck -> Redis DeckProficiency
retrieveDeckProficiency UserIdentifier
userIdentifier Deck
deck
        let oldCardProficiencies :: Map Text CardProficiency
oldCardProficiencies = DeckProficiency -> Map Text CardProficiency
cardProficiencies DeckProficiency
oldDeckProficiency
        let newCardProficiencies :: Map Text CardProficiency
newCardProficiencies = (CardProficiency -> CardProficiency)
-> Text -> Map Text CardProficiency -> Map Text CardProficiency
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust CardProficiency -> CardProficiency
updateCardProficiency Text
cardTitle Map Text CardProficiency
oldCardProficiencies
        let newDeckProficiency :: DeckProficiency
newDeckProficiency = Map Text CardProficiency -> DeckProficiency
DeckProficiency Map Text CardProficiency
newCardProficiencies
        UserIdentifier
-> Deck -> DeckProficiency -> Redis (Either Reply Status)
saveDeckProficiency UserIdentifier
userIdentifier Deck
deck DeckProficiency
newDeckProficiency

updateDeckPreferencesByTogglingCard :: UserIdentifier -> Deck -> T.Text -> CardStatus -> Redis.Redis (Either Redis.Reply Redis.Status)
updateDeckPreferencesByTogglingCard :: UserIdentifier
-> Deck -> Text -> CardStatus -> Redis (Either Reply Status)
updateDeckPreferencesByTogglingCard UserIdentifier
userIdentifier Deck
deck Text
cardTitle CardStatus
cardNewStatus = do
        DeckPreferences
oldDeckPreferences <- UserIdentifier -> Deck -> Redis DeckPreferences
retrieveDeckPreferences UserIdentifier
userIdentifier Deck
deck
        let oldCardPreferences :: Map Text CardPreferences
oldCardPreferences = DeckPreferences -> Map Text CardPreferences
cardPreferences DeckPreferences
oldDeckPreferences
        let newCardPreferences :: Map Text CardPreferences
newCardPreferences = Text
-> CardPreferences
-> Map Text CardPreferences
-> Map Text CardPreferences
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
cardTitle (CardStatus -> CardPreferences
CardPreferences CardStatus
cardNewStatus) Map Text CardPreferences
oldCardPreferences
        let newDeckPreferences :: DeckPreferences
newDeckPreferences = Map Text CardPreferences -> DeckPreferences
DeckPreferences Map Text CardPreferences
newCardPreferences
        UserIdentifier
-> Deck -> DeckPreferences -> Redis (Either Reply Status)
saveDeckPreferences UserIdentifier
userIdentifier Deck
deck DeckPreferences
newDeckPreferences

retrieveDeckActiveCards :: UserIdentifier -> Deck -> Redis.Redis [CardWithUserFeatures]
retrieveDeckActiveCards :: UserIdentifier -> Deck -> Redis [CardWithUserFeatures]
retrieveDeckActiveCards UserIdentifier
userIdentifier Deck
deck = do
    -- Retrieve enabled cards
    Map Text CardPreferences
preferencesMap <- DeckPreferences -> Map Text CardPreferences
cardPreferences (DeckPreferences -> Map Text CardPreferences)
-> Redis DeckPreferences -> Redis (Map Text CardPreferences)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIdentifier -> Deck -> Redis DeckPreferences
retrieveDeckPreferences UserIdentifier
userIdentifier Deck
deck
    let allCards :: [Card]
allCards = Deck -> [Card]
deckCards Deck
deck
    let enabledCards :: [Card]
enabledCards = (((Card -> Bool) -> [Card] -> [Card])
-> [Card] -> (Card -> Bool) -> [Card]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Card -> Bool) -> [Card] -> [Card]
forall a. (a -> Bool) -> [a] -> [a]
filter) [Card]
allCards ((Card -> Bool) -> [Card]) -> (Card -> Bool) -> [Card]
forall a b. (a -> b) -> a -> b
$ \Card
card ->
            let
                title :: Text
title = Card -> Text
cardTitle Card
card
                preferences :: Maybe CardPreferences
preferences = Text -> Map Text CardPreferences -> Maybe CardPreferences
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
title Map Text CardPreferences
preferencesMap
            in
                Bool -> (CardPreferences -> Bool) -> Maybe CardPreferences -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False CardPreferences -> Bool
isCardEnabled Maybe CardPreferences
preferences
    -- Retrieve weights for cards
    Map Text CardProficiency
proficiencyMap <- DeckProficiency -> Map Text CardProficiency
cardProficiencies (DeckProficiency -> Map Text CardProficiency)
-> Redis DeckProficiency -> Redis (Map Text CardProficiency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIdentifier -> Deck -> Redis DeckProficiency
retrieveDeckProficiency UserIdentifier
userIdentifier Deck
deck
    [CardWithUserFeatures] -> Redis [CardWithUserFeatures]
forall a. a -> Redis a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CardWithUserFeatures] -> Redis [CardWithUserFeatures])
-> [CardWithUserFeatures] -> Redis [CardWithUserFeatures]
forall a b. (a -> b) -> a -> b
$ (((Card -> CardWithUserFeatures)
 -> [Card] -> [CardWithUserFeatures])
-> [Card]
-> (Card -> CardWithUserFeatures)
-> [CardWithUserFeatures]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Card -> CardWithUserFeatures) -> [Card] -> [CardWithUserFeatures]
forall a b. (a -> b) -> [a] -> [b]
map) [Card]
enabledCards ((Card -> CardWithUserFeatures) -> [CardWithUserFeatures])
-> (Card -> CardWithUserFeatures) -> [CardWithUserFeatures]
forall a b. (a -> b) -> a -> b
$ \Card
card ->
            let
                title :: Text
title = Card -> Text
cardTitle Card
card
                proficiency :: Maybe CardProficiency
proficiency = Text -> Map Text CardProficiency -> Maybe CardProficiency
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
title Map Text CardProficiency
proficiencyMap
                proficiencyWeight :: Int
proficiencyWeight = Int -> (CardProficiency -> Int) -> Maybe CardProficiency -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 CardProficiency -> Int
computeCardProficiencyWeight Maybe CardProficiency
proficiency
                proficiencyScore :: Double
proficiencyScore = Double
-> (CardProficiency -> Double) -> Maybe CardProficiency -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 CardProficiency -> Double
computeCardProficiencyScore Maybe CardProficiency
proficiency
                shouldDisplayHint :: Bool
shouldDisplayHint = case Maybe CardProficiency
proficiency of
                    Maybe CardProficiency
Nothing -> Bool
True
                    Just CardProficiency
proficiency' -> (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CardProficiency -> Bool
computeCardLastAttemptCorrectness CardProficiency
proficiency') Bool -> Bool -> Bool
&& (Int
proficiencyWeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1500)
            in
                Card -> Int -> Double -> Bool -> CardWithUserFeatures
CardWithUserFeatures Card
card Int
proficiencyWeight Double
proficiencyScore Bool
shouldDisplayHint

isCardEnabled :: CardPreferences -> Bool
isCardEnabled :: CardPreferences -> Bool
isCardEnabled = (CardStatus -> CardStatus -> Bool
forall a. Eq a => a -> a -> Bool
== CardStatus
CardCurrentlyLearning) (CardStatus -> Bool)
-> (CardPreferences -> CardStatus) -> CardPreferences -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardPreferences -> CardStatus
cardStatus