Move project to stack

Main.hs

@@ -1,153 +0,0 @@
-module Main
-  ( main
-  ) where
-
-import Cards
-import Control.Monad
-import Control.Monad.Trans
-import Control.Monad.Trans.Maybe
-import Data.Char
-import Data.Maybe
-import Data.Time
-import System.Console.Haskeline
-
-inputSettings :: Settings IO
-inputSettings = Settings
-  { complete       = noCompletion
-  , historyFile    = Nothing
-  , autoAddHistory = True
-  }
-
--- The prompt functions use a MaybeT wrapper because they can fail at any time.
--- This happens when the user presses ctrl+D (EOF).
-
--- Simple yes/no prompt (defaults to yes)
-promptYesNo :: String -> MaybeT (InputT IO) Bool
-promptYesNo question = do
-  i <- MaybeT $ getInputLine $ question ++ " [Y/n] "
-  case map toLower i of
-    ""  -> return True
-    "y" -> return True
-    "n" -> return False
-    _   -> do
-      lift $ outputStrLn $ "Incorrect input: " ++ show i
-      promptYesNo question
-
--- Wait until user pressed Enter
-promptContinue :: String -> MaybeT (InputT IO) ()
-promptContinue question = void $ MaybeT $ getInputLine $ question ++ "[Enter] "
-
--- Just span, but with monads.
-spanM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])
-spanM _ [] = return ([], [])
-spanM f l@(x:xs) = do
-  result <- f x
-  if result
-    then do
-      (with, without) <- spanM f xs
-      return (x:with, without)
-    else do
-      return ([], l)
-
-{-
- - Dealing with Elements/Cards.
- -}
-
--- Generic card counting function
-countCardsBy :: (Card -> Bool) -> [Element] -> Int
-countCardsBy f = length . filter elmF
-  where elmF e = fromMaybe False (f <$> toCard e)
-
--- Ask all cards in the list of elements which are due.
--- When askNthCard fails, don't modify the rest of the list.
--- This bit uses two MaybeTs inside each other, so beware :P
-askCountdown :: UTCTime -> [Element] -> InputT IO [Element]
-askCountdown _ [] = return []
-askCountdown time elms@(e:es) =
-  defaultTo elms $ do
-    result <- runMaybeT $ do
-      card <- MaybeT $ return $ toCard e
-      guard $ isDue time card
-      card' <- lift $ askCardWithInfo time card (countCardsBy (isDue time) es)
-      lift $ lift $ (fromCard card' :) <$> askCountdown time es
-    case result of
-      Nothing -> lift $ continue
-      Just r  -> return r
-  where defaultTo what monad = fromMaybe what <$> runMaybeT monad
-        continue = (e :) <$> askCountdown time es
-
--- A simple right justify
-rjust :: Char -> Int -> String -> String
-rjust c l s = replicate (max 0 $ l - length s) c ++ s
-
--- These functions use a MaybeT wrapper because they can fail at any time,
--- because they use the prompt functions.
-
--- Print out info about a card when asking it
-askCardWithInfo :: UTCTime -> Card -> Int -> MaybeT (InputT IO) Card
-askCardWithInfo time card left = do
-  let t = rjust ' ' 9 $ tierName $ tier card
-      l = rjust ' ' 3 $ show left
-  lift $ outputStrLn ""
-  lift $ outputStrLn $ "-----< tier: " ++ t ++ ", left: " ++ l ++ " >-----"
-  askCard time card
-
--- Ask the sides on a card and reset or update the card accordingly
--- Doesn't check whether the card is due or not.
-askCard :: UTCTime -> Card -> MaybeT (InputT IO) Card
-askCard time card = do
-  (_, unasked) <- spanM askSide $ sides card
-  mapM_ showSide $ drop 1 unasked
-  if null unasked
-    then lift $ lift $ update time card
-    else return $ reset time card
-
-askSide :: String -> MaybeT (InputT IO) Bool
-askSide side = do
-  lift $ displaySide side
-  promptYesNo "Did you know that side?"
-
-showSide :: String -> MaybeT (InputT IO) ()
-showSide side = do
-  lift $ displaySide side
-  promptContinue "Continue"
-
-displaySide :: String -> InputT IO ()
-displaySide side = lift (putStrLn side)
-
-{-
- - User prompt.
- -}
-
-learn :: [Element] -> InputT IO [Element]
-learn elms = do
-  time <- lift $ getCurrentTime
-  askCountdown time elms
-
-stats :: [Element] -> InputT IO ()
-stats = undefined -- TODO: Use tierName
-
-trim :: Char -> String -> String
-trim c = dropWhile (== c) . reverse . dropWhile (== c) . reverse
-
-run :: [Element] -> InputT IO [Element]
-run elms = do
-  cmd <- getInputLine "%> "
-  case trim ' ' . map toLower <$> cmd of
-    Nothing      -> return elms
-    Just ""      -> run elms
-    Just "quit"  -> return elms
-    Just "q"     -> return elms
-    Just "learn" -> learn elms >>= run
-    Just "l"     -> learn elms >>= run
-    Just "show"  -> stats elms >> run elms
-    Just "s"     -> stats elms >> run elms
-    Just x       -> do
-      outputStrLn $ "Unknown command " ++ show x ++ "."
-      run elms
-    -- Maybe save cards?
-
-main :: IO ()
-main = do
-  elms <- runInputT inputSettings $ run testElements
-  mapM_ (putStrLn . show) elms