From e10e1b930a5052ddf7f8042b08cf4f4d561dd417 Mon Sep 17 00:00:00 2001
From: Joscha <brummer@migejolise.de>
Date: Fri, 5 Jan 2018 13:23:32 +0000
Subject: [PATCH] Implement show command

---
 app/Main.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 44 insertions(+), 7 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 534c3e4..946fc71 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -57,10 +57,14 @@ spanM f l@(x:xs) = do
 
 -- A few inefficient string formatting functions
 
--- A simple right justify
+-- Simple right justify
 rjust :: Char -> Int -> String -> String
 rjust c l s = replicate (max 0 $ l - length s) c ++ s
 
+-- Simple left justify
+--ljust :: Char -> Int -> String -> String
+--ljust c l s = s ++ replicate (max 0 $ l - length s) c
+
 -- Trims characters from the front and back of a string.
 trim :: Char -> String -> String
 trim c = dropWhile (== c) . reverse . dropWhile (== c) . reverse
@@ -119,6 +123,27 @@ showSide side = do
 displaySide :: String -> InputT IO ()
 displaySide side = lift (putStrLn side)
 
+{-
+ - Display stats
+ -}
+
+count :: (Card -> Bool) -> Elements -> Int
+count f = length . filter f . map snd . toCards
+
+countTier :: Elements -> Tier -> Int
+countTier e t = count (\card -> tier card == t) e
+
+printBar :: Int -> Int -> String
+printBar maxInt int =
+  let l = (30 * int) `div` maxInt
+      s = replicate l '#'
+  in rjust ' ' 30 s
+
+printLine :: Int -> String -> Int -> String
+printLine maxAmount name amount =
+  rjust ' ' 9 name ++ " | " ++
+  printBar maxAmount amount ++ " | " ++ rjust ' ' 6 (show amount)
+
 {-
  - User prompt.
  -}
@@ -129,15 +154,27 @@ learn elms = do
   askElements time elms
 
 stats :: Elements -> Input ()
-stats = undefined -- TODO: Use tierName
+stats elms = do
+  time <- lift $ getCurrentTime
+  outputStrLn $ "     tier |              graph             | amount"
+  outputStrLn $ "----------|--------------------------------|-------"
+  let total = length $ toCards elms
+      due   = length $ toDueCards time elms
+      maxAmount = maximum $ due : map (countTier elms) [minBound..maxBound]
+  mapM_ (outputStrLn . printTierLine maxAmount) [minBound..maxBound]
+  outputStrLn $ "----------|--------------------------------|-------"
+  outputStrLn $ "    total |                                | " ++ rjust ' ' 6 (show total)
+  outputStrLn $ printLine maxAmount "learn" due
+  where
+    printTierLine m t = printLine m (tierName t) (countTier elms t)
 
 help :: Input ()
 help = do
-  outputStrLn "  List of commands:"
-  outputStrLn "h, help  -> display this help"
-  outputStrLn "l, learn -> start revising cards (press ctrl+D to exit)"
-  outputStrLn "q, quit  -> exit program"
-  outputStrLn "s, show  -> show how many cards are in which tiers"
+  outputStrLn "List of commands:"
+  outputStrLn "  h, help  -> display this help"
+  outputStrLn "  l, learn -> start revising cards (press ctrl+D to exit)"
+  outputStrLn "  q, quit  -> exit program"
+  outputStrLn "  s, show  -> show how many cards are in which tiers"
 
 run :: Elements -> Input Elements
 run elms = do