Optionally show points when generating feedback

app/Main.hs

@@ -202,10 +202,10 @@ export_pdfMark js = do
     -- Right newJs -> putStrLn $ show newJs
     Left e -> report $ reportInvalid e
 
-export_feedback :: [Judgement] -> IO ()
-export_feedback js = do
+export_feedback :: FeedbackOpts -> [Judgement] -> IO ()
+export_feedback opts js = do
   case (mapM interpProps js) of
-    Right newJs -> putStrLn $ exportFeedback newJs
+    Right newJs -> putStrLn $ exportFeedback opts newJs
     -- Right newJs -> putStrLn $ show newJs
     Left e -> report $ reportInvalid e
 
@@ -244,8 +244,12 @@ main = do
     [] -> noCommand
     ("parse" : paths) ->
       with paths $ putStrLn . pretty
+    ("feedback" : "--with-points" : paths) ->
+      with paths $ mapM_ (export_feedback $
+        FeedbackOpts { withPoints = True })
     ("feedback" : paths) ->
-      with paths $ mapM_ export_feedback
+      with paths $ mapM_ (export_feedback $
+        FeedbackOpts { withPoints = False })
     ("check" : paths) ->
       with paths $ mapM_ check
     ("valid" : paths) ->

src/Export.hs

@@ -1,4 +1,4 @@
-module Export (exportFeedback, exportHTML, exportCSV, exportHTMLTable, exportResultsTable, exportMD, unify, summary, exportPdfMark) where
+module Export (FeedbackOpts(..), exportFeedback, exportHTML, exportCSV, exportHTMLTable, exportResultsTable, exportMD, unify, summary, exportPdfMark) where
 
 import Ast
 import Invalid
@@ -25,8 +25,8 @@ exportHTMLTable js = toHTML $ transp $ htmlTableRemarks js
 exportMD :: [Judgement] -> String
 exportMD js = mdRemarks js
 
-exportFeedback :: [Judgement] -> String
-exportFeedback js = feedbackRemarks js
+exportFeedback :: FeedbackOpts -> [Judgement] -> String
+exportFeedback opts js = feedbackRemarks opts js
 
 exportResultsTable :: [Judgement] -> String
 exportResultsTable js = toCSV ";" $ transp $ resultsTableRemarks js

src/Export/Feedback.hs

@@ -1,25 +1,34 @@
-module Export.Feedback (feedbackRemarks) where
+module Export.Feedback (FeedbackOpts(..), feedbackRemarks) where
 
 import Ast
 import Export.Generic
 
 import Prelude hiding ((<>))
 import Text.PrettyPrint
 
-feedbackRemarks :: [Judgement] -> String
-feedbackRemarks = render . vcat . map (formatJudgement 1)
+newtype FeedbackOpts
+  = FeedbackOpts {
+      withPoints :: Bool
+    }
 
-formatJudgement :: Int -> Judgement -> Doc
-formatJudgement _ (Feedback (_, t)) = text t
-formatJudgement _ (Bonus (_, _, _)) = empty
-formatJudgement depth (j @ (Judgement (_, _, _, judgements))) =
+feedbackRemarks :: FeedbackOpts -> [Judgement] -> String
+feedbackRemarks opts = render . vcat . map (formatJudgement opts 1)
+
+formatJudgement :: FeedbackOpts -> Int -> Judgement -> Doc
+formatJudgement _ _ (Feedback (_, t)) = text t
+formatJudgement _ _ (Bonus (_, _, _)) = empty
+formatJudgement opts depth (j @ (Judgement (_, _, _, judgements))) =
   case isEmpty subj of
     True -> empty
-    False -> formatHeader depth j $+$ text "" $+$ subj $+$ text ""
+    False -> formatHeader (withPoints opts) depth j
+              $+$ text "" $+$ subj $+$ text ""
   where
-    subj = vcat $ map (formatJudgement (depth + 1)) judgements
-
-formatHeader :: Int -> Judgement -> Doc
-formatHeader depth j =
-  (text $ replicate depth '#') <+> lookupTitle j
+    subj = vcat $ map (formatJudgement opts (depth + 1)) judgements
 
+formatHeader :: Bool -> Int -> Judgement -> Doc
+formatHeader showPoints depth j =
+  let points =  if showPoints
+              then colon <> space <>
+                lookupTotal j <> text "/" <> lookupMaxPoints j
+              else empty
+  in (text $ replicate depth '#') <+> lookupTitle j <> points