From 8d882cf8612d3554174ccc8269a6b9f27cbcce7b Mon Sep 17 00:00:00 2001
From: Joscha <brummer@migejolise.de>
Date: Fri, 5 Jan 2018 17:04:08 +0000
Subject: [PATCH] Randomize learn order and offsets

---
 app/Main.hs  |  6 +++---
 package.yaml |  2 ++
 src/Cards.hs | 18 +++++++++++++-----
 3 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 946fc71..f62ba2e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -10,6 +10,7 @@ import           Data.Char
 import           Data.Time
 import           System.Console.Haskeline
 import           System.Console.Haskeline.History
+import           System.Random.Shuffle
 
 type Input = InputT IO
 
@@ -75,9 +76,8 @@ trim c = dropWhile (== c) . reverse . dropWhile (== c) . reverse
 
 askElements :: UTCTime -> Elements -> Input Elements
 askElements time elms = do
-  let l = toDueCards time elms
-  -- TODO: Randomize order
-  newCards <- askCountdown time l
+  cards <- lift $ shuffleM $ toDueCards time elms
+  newCards <- askCountdown time cards
   return $ updateElements elms (fromCards newCards)
 
 askCountdown :: UTCTime -> [(Integer, Card)] -> Input [(Integer, Card)]
diff --git a/package.yaml b/package.yaml
index 38fe331..6b5f1bb 100644
--- a/package.yaml
+++ b/package.yaml
@@ -26,6 +26,8 @@ dependencies:
 - transformers
 - haskeline
 - megaparsec
+- random
+- random-shuffle
 
 library:
   source-dirs: src
diff --git a/src/Cards.hs b/src/Cards.hs
index 48b38ea..b84b5e3 100644
--- a/src/Cards.hs
+++ b/src/Cards.hs
@@ -1,3 +1,4 @@
+-- | Index-card-like system.
 module Cards
   ( Elements -- Elements stuff
   , updateElements
@@ -30,6 +31,7 @@ import qualified Data.Map.Strict            as Map
 import           Data.Time
 import           Data.Time.Clock.POSIX
 import           Data.Void
+import           System.Random
 import           Text.Megaparsec
 import           Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as L
@@ -143,11 +145,11 @@ isDue time Card{tier=t, lastChecked=lc, offset=o} =
   diffUTCTime time lc >= o + tierDiff t
 
 -- These functions use the IO monad for generating random offsets.
---
--- TODO: actually implement random offset
 updateOffset :: Card -> IO Card
 updateOffset Card{sides=s, tier=t, lastChecked=lc} = do
-  return Card{sides=s, tier=t, lastChecked=lc, offset=0}
+  let maxOffset = tierDiff t / 4
+  o <- integerToNom <$> randomRIO (0, nomToInteger maxOffset)
+  return Card{sides=s, tier=t, lastChecked=lc, offset=o}
 
 -- | Reset a card's 'Tier'.
 --
@@ -210,6 +212,12 @@ tierName SixtyFourDays = "64d"
  - Converting to String
  -}
 
+integerToNom :: Integer -> NominalDiffTime
+integerToNom = fromInteger
+
+nomToInteger :: NominalDiffTime -> Integer
+nomToInteger = (truncate :: Double -> Integer) . realToFrac
+
 -- | Convert an 'Elements' to a string which can be parsed by 'parseElements'.
 --
 -- This string can then be written to a text file for storage.
@@ -226,7 +234,7 @@ cardToString :: Card -> String
 cardToString Card{sides=s, tier=t, lastChecked=lc, offset=o} =
   let info = ":: {\"level\": " ++ (show $ fromEnum t) ++
              ", \"last_checked\": " ++ formatTime defaultTimeLocale "%s" lc ++
-             ", \"delay\": " ++ (show $ fromEnum o) ++
+             ", \"delay\": " ++ (show $ nomToInteger o) ++
              "}"
   in unlines $ info : intersperse "::" s
 
@@ -295,7 +303,7 @@ lastCheckedInfo = do
 offsetInfo :: Parser (Card -> Card)
 offsetInfo = do
   number <- field "delay"
-  let o = fromInteger number
+  let o = integerToNom number
   return (\card -> card {offset=o})
 
 -- sides of a card