Wait a while when asking cards

Cards.hs

@@ -12,12 +12,21 @@ module Cards
   , showElements
   , parseElement
   , parseElements
+  , testElements
   ) where
 
 import Data.List
 import Data.Time
 
-wee = EComment $ Comment "wee"
+testElements =
+  [ card ["first card", "really"]
+  , card ["second card", "really"]
+  , comment "first comment"
+  , card ["third card", "really"]
+  , comment "second comment"
+  ]
+  where card = ECard . Unrevised
+        comment = EComment . Comment
 
 data Element = ECard Card | EComment Comment
   deriving (Show)
@@ -25,12 +34,11 @@ data Element = ECard Card | EComment Comment
 data Comment = Comment String
   deriving (Show)
 
-type LastChecked = Integer
-type Delay = Integer
-data Card = Card Tier LastChecked Delay [String]
+data Card = Unrevised [String]
+          | Revised [String] Tier UTCTime NominalDiffTime
   deriving (Show)
 
-data Tier = Zero | One | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten
+data Tier = One | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten
   deriving (Show, Eq, Ord, Enum, Bounded)
 
 {-
@@ -48,17 +56,51 @@ fromElement  _        = Nothing
 toElement :: Card -> Element
 toElement = ECard
 
+tierDiff :: Tier -> NominalDiffTime
+tierDiff One   = 60 * 10
+tierDiff Two   = 60 * 20
+tierDiff Three = 60 * 40
+tierDiff Four  = 3600 * ( 1 * 24 - 8)
+tierDiff Five  = 3600 * ( 2 * 24 - 8)
+tierDiff Six   = 3600 * ( 4 * 24 - 8)
+tierDiff Seven = 3600 * ( 8 * 24 - 8)
+tierDiff Eight = 3600 * (16 * 24 - 8)
+tierDiff Nine  = 3600 * (32 * 24 - 8)
+tierDiff Ten   = 3600 * (64 * 24 - 8)
+
+tierName :: Tier -> String
+tierName One   = "10min"
+tierName Two   = "20min"
+tierName Three = "40min"
+tierName Four  =  "1d"
+tierName Five  =  "2d"
+tierName Six   =  "4d"
+tierName Seven =  "8d"
+tierName Eight = "16d"
+tierName Nine  = "32d"
+tierName Ten   = "64d"
+
 isDue :: UTCTime -> Card -> Bool
-isDue = undefined
+isDue _ (Unrevised _) = True
+isDue time (Revised _ tier ctime cdiff) =
+  let tdiff = tierDiff tier
+  in  diffUTCTime time ctime >= cdiff + tdiff 
 
 sides :: Card -> [String]
-sides (Card _ _ _ s) = s
+sides (Unrevised s)     = s
+sides (Revised s _ _ _) = s
 
 reset :: Card -> Card
-reset (Card t l d s) = Card minBound l d s
+reset (Revised s _ _ _) = Unrevised s
+reset c@(Unrevised _)   = c
 
-update :: UTCTime -> Card -> Card
-update = undefined
+-- Uses the global RNG.
+-- TODO: Add random offset based on tierDiff.
+update :: UTCTime -> Card -> IO Card
+update time (Unrevised s)     =
+  return $ Revised s minBound                             time (fromInteger 0)
+update time (Revised s t _ _) =
+  return $ Revised s (if t < maxBound then succ t else t) time (fromInteger 0)
 
 showElements :: [Element] -> String
 showElements = intercalate "\n\n" . map showElement

Main.hs

@@ -69,9 +69,6 @@ mapWhileJustM f l = uncurry (++) <$> spanJustM f l
  - Dealing with Elements/Cards.
  -}
 
-learn :: UTCTime -> [Element] -> InputT IO [Element]
-learn time = mapWhileJustM (runMaybeT . askElement time)
-
 askElement :: UTCTime -> Element -> MaybeT (InputT IO) Element
 askElement time elem =
   case fromElement elem of
@@ -83,8 +80,10 @@ askCard time card = do
   if isDue time card
     then do
       (asked, unasked) <- spanM askSide $ sides card
-      mapM_ showSide $ tail unasked
-      return $ if null unasked then update time card else reset card
+      mapM_ showSide $ drop 1 unasked
+      if null unasked
+        then lift $ lift $ update time card
+        else return $ reset card
     else do
       return card
 
@@ -101,8 +100,15 @@ showSide side = do
 displaySide :: String -> InputT IO ()
 displaySide side = lift (putStrLn side)
 
-displayStats :: [Element] -> InputT IO ()
-displayStats = undefined
+{-
+ - User prompt.
+ -}
+
+learn :: UTCTime -> [Element] -> InputT IO [Element]
+learn time = mapWhileJustM (runMaybeT . askElement time)
+
+stats :: [Element] -> InputT IO ()
+stats = undefined -- TODO: Use tierName
 
 run :: UTCTime -> [Element] -> InputT IO [Element]
 run time elem = do
@@ -113,16 +119,15 @@ run time elem = do
     Just "q"     -> return elem
     Just "learn" -> learn time elem >>= run time
     Just "l"     -> learn time elem >>= run time
-    Just "show"  -> displayStats elem >> run time elem
-    Just "s"     -> displayStats elem >> run time elem
+    Just "show"  -> stats elem >> run time elem
+    Just "s"     -> stats elem >> run time elem
     Just x       -> do
       outputStrLn $ "Unknown command " ++ show x ++ "."
       run time elem
     -- Maybe save cards?
 
 main :: IO ()
-main = runInputT inputSettings loop
-  where loop :: InputT IO ()
-        loop = do
-          f <- runMaybeT $ promptYesNo "Hey, do you want apples?"
-          outputStrLn $ show f
+main = do
+  time <- getCurrentTime
+  elems <- runInputT inputSettings $ run time testElements
+  mapM_ (putStrLn . show) elems