diff --git a/Cards.hs b/Cards.hs index e63ee30..4296c38 100644 --- a/Cards.hs +++ b/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 diff --git a/Main.hs b/Main.hs index a35a3ef..25e42f6 100644 --- a/Main.hs +++ b/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