haskell-fsrs-7.0.0: app/Main.hs

{-# LANGUAGE NumericUnderscores #-}

-- | A tiny demonstration of the FSRS-7 scheduler: grade one card 'Good' every
-- time it comes due, and print what the model makes of it.
module Main (main) where

import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (NominalDiffTime, UTCTime (..))
import Numeric (showFFloat)
import Text.Printf (printf)

import FSRS

main :: IO ()
main = do
  printf "FSRS-7 — %d parameters\n\n" parameterCount
  putStrLn (unwords [showFFloat Nothing w "" | w <- parametersToList defaultParameters])
  putStrLn ""
  putStrLn " #    elapsed | state      |  stability | difficulty | next      |  R at due"
  putStrLn "----------------------------------------------------------------------------"
  go 1 epoch (newCard epoch)
  where
    reviews = 10 :: Int

    go :: Int -> UTCTime -> Card -> IO ()
    go n now card
      | n > reviews = pure ()
      | otherwise = do
          let (card', entry) = reviewCard defaultScheduler card Good now
              memory = logMemoryAfter entry
              due = cardDue card'
          printf
            "%2d %10s | %-10s | %10.4f | %10.4f | %-9s | %.4f\n"
            n
            (humanDuration (realToFrac (logElapsedDays entry * 86400) :: NominalDiffTime))
            (show (cardState card'))
            (memoryStability memory)
            (memoryDifficulty memory)
            (humanDuration (logInterval entry))
            (maybe 1 id (cardRetrievability defaultScheduler card' due))
          go (n + 1) due card'

epoch :: UTCTime
epoch = UTCTime (fromGregorian 2026 1 1) 0

humanDuration :: NominalDiffTime -> String
humanDuration dt
  | seconds < 60 = printf "%.0fs" seconds
  | seconds < 3_600 = printf "%.0fm" (seconds / 60)
  | seconds < 86_400 = printf "%.1fh" (seconds / 3_600)
  | otherwise = printf "%.2fd" (seconds / 86_400)
  where
    seconds = realToFrac dt :: Double