remarks 0.1.4 → 0.1.5

raw patch · 7 files changed

+97/−39 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +27/−10
• app/Main.hs +12/−9
• remarks.cabal +1/−1
• src/Parser/Impl.hs +10/−3
• src/PrettyPrinter.hs +6/−4
• src/Validator.hs +20/−7
• test/ValidatorTests.hs +21/−5

@@ -15,9 +15,9 @@  ## Design Goals -  1. One human-readable/editable file per student.-  2. Export options to spreadsheet-formats.-  3. git-friendly file format.+  1. One, or several, human-readable/editable file(s) _per student_.+  2. git-friendly file format.+  3. Export options to spreadsheet-formats.   4. Synchronization options with Dropbox and/or Google Drive.  Goal 4 is not necessarily related to `remarks`, but is related to marking@@ -26,12 +26,16 @@  ## Status -There is a [parser](src/Parser/Impl.hs) and baseline-[validator](src/Validator.hs). These can be invoked using `remarks parse` and-`remarks check`, respectively.+There is:+* a [parser](src/Parser/Impl.hs);+* a (basic) [validator](src/Validator.hs); and+* a [pretty printer](src/PrettyPrinter.hs). +These can be invoked using `remarks parse`, `remarks check`, and `remarks+show`, respectively.+ See [Issues](https://github.com/oleks/remarks/issues) for a roadmap. Feel free-to add or fix some.+to add or fix a couple issues.  ## Installation @@ -89,14 +93,14 @@ this:  ```-## T1: 15/15+## T1: /15 -## Formal requirements: 5/5+### Formal requirements: /5   * Has code   * Has XML in a reloadable/testable form   * Has an explanation -### Quality assessment: 10/10+### Quality assessment: /10   * Understands semaphores   * Understands deadlocks   * Understands starvation@@ -143,6 +147,19 @@   * Solves the problem     + In a complicated way, but yes. ```++## Points and Sums++You do not need to manually enter sums. Points are only required for the+bottom-most judgements. Given the template above you can do a `remarks check`+to check if all necessary points have been given. This makes a "pointless"+template a rather useful starting point for grading.++Points can be integers or half-points, that is, the number may end in `.5`.+Please note, `.5` is exactly representable in an IEEE-754 (the internal+representation of points), so no numerical imprecision occurs when dealing with+half-points. Maximum points may only be integers (the internal representation+of maximum points is still an IEEE-754 double to avoid numerical conversions).  ## Files and Directories 

@@ -5,7 +5,7 @@ import Validator import PrettyPrinter -import Control.Monad ( void, filterM )+import Control.Monad ( void, filterM, liftM ) import Data.List ( sort ) import System.Directory   ( doesFileExist, doesDirectoryExist, listDirectory )@@ -63,12 +63,12 @@     Right js -> pure js     Left e -> parseError e -parseFileInDir :: FilePath -> IO Judgement+parseFileInDir :: FilePath -> IO [Judgement] parseFileInDir path = do   js <- parsePath path   case js of-    [j] -> pure j-    _ -> noTopLevelJudgement path+    [] -> noTopLevelJudgement path+    _ -> pure js  parseFileWithDir :: FilePath -> IO ([Judgement], Judgement) parseFileWithDir path = do@@ -88,7 +88,7 @@   paths <- listDirectory path   let mrkPaths = filter isMrkPath paths   let fullMrkPaths = map (path </>) (sort mrkPaths)-  mapM parseFileInDir fullMrkPaths+  liftM concat $ mapM parseFileInDir fullMrkPaths  extPaths :: FilePath -> (FilePath, FilePath) extPaths path =@@ -119,10 +119,13 @@ parsePaths = mapM parsePath  check :: [Judgement] -> IO ()-check js = putStrLn $ pretty $ map validate js+check js = do+  case mapM validate js of+    Right newJs -> printJs newJs+    Left e -> putStrLn $ show e -ppMarkup :: [Judgement] -> IO ()-ppMarkup = putStrLn . toMrk+printJs :: [Judgement] -> IO ()+printJs = putStrLn . ppJs  main :: IO () main = do@@ -131,5 +134,5 @@     [] -> noCommand     ("parse" : paths) -> parsePaths paths >>= putStrLn . pretty     ("check" : paths) -> parsePaths paths >>= mapM_ check-    ("show" : paths) -> parsePaths paths >>= mapM_ ppMarkup+    ("show" : paths) -> parsePaths paths >>= mapM_ printJs     (c:args) -> invalidCommand c args

@@ -1,5 +1,5 @@ name:                remarks-version:             0.1.4+version:             0.1.5 synopsis:            A DSL for marking student work description:         A DSL for marking student work; see README.md for further details. homepage:            https://github.com/oleks/remarks#readme

@@ -30,11 +30,18 @@ parsePoints :: ReadP Double parsePoints = do   is <- parseIntegral-  fs <- (char '.' *> parseIntegral) +++ pure "0"+  fs <- (string ".5") +++ pure "0"   case (maybeRead (is ++ "." ++ fs)) of     Just x -> pure x     _ -> pfail +parseMaxPoints :: ReadP Double+parseMaxPoints = do+  is <- parseIntegral+  case (maybeRead is) of+    Just x -> pure x+    _ -> pfail+ lineToken :: ReadP a -> ReadP a lineToken p = munch (`elem` [' ', '\t', '\r', '\v', '\f']) *> p @@ -51,9 +58,9 @@   void $ char ' '   title <- lineToken $ munchTillExcl ':' -  points <- lineToken $ parsePoints+  points <- (lineToken $ parsePoints) +++ (return $ 1/0)   void $ lineToken $ char '/'-  maxPoints <- lineToken $ parsePoints+  maxPoints <- lineToken $ parseMaxPoints    void $ lineBreak 

@@ -1,11 +1,12 @@-module PrettyPrinter (toMrk) where+module PrettyPrinter (ppJs) where  import Ast  import Text.PrettyPrint+import Data.List (intersperse) -toMrk :: [Judgement] -> String-toMrk js = render $ vcat $ map (formatJudgement 1) js+ppJs :: [Judgement] -> String+ppJs = render . vcat . intersperse (text "") . map (formatJudgement 1)  formatJudgement :: Int -> Judgement -> Doc formatJudgement level (Judgement (header, comments, judgements)) =@@ -17,12 +18,13 @@ isIntegral x = x == fromInteger (round x)  pointsDoc :: Double -> Doc+pointsDoc v | isNaN v = empty pointsDoc v | isIntegral v = integer (round v) pointsDoc v = double v  formatHeader :: Int -> Header -> Doc formatHeader level (Header (title, point, maxPoints)) =-  (text $ replicate level '#') <+> text title <> colon <+>+  (text $ replicate level '#') <+> text title <> colon <> space <>     pointsDoc point <> text "/" <> pointsDoc maxPoints  formatComment :: Comment -> Doc

@@ -12,6 +12,7 @@   = PointsExceedMaxPoints Header   | BadSubJudgementPointsSum Judgement   | BadSubJudgementMaxPointsSum Judgement+  | NoPointsInBottomJudgement Judgement   deriving (Eq, Show, Generic)  instance Out Invalid@@ -24,18 +25,30 @@ (~=) :: Double -> Double -> Bool x ~= y = abs (x - y) <= 0.01 -validate :: Judgement -> Either Invalid ()-validate j @ (Judgement (h @ (Header (_, p, maxP)), _, subjs)) = do+validateSubJs :: Judgement -> Either Invalid Judgement+validateSubJs (Judgement (h @ (Header (t, _, maxP)), cs, subJs)) = do+  newSubJs <- mapM validate subJs+  let newP = sum $ map points newSubJs+  pure $ Judgement (Header (t, newP, maxP), cs, newSubJs)++validate :: Judgement -> Either Invalid Judgement+validate j @ (Judgement (h @ (Header (_, p, maxP)), _, [])) | isInfinite p = do+  Left $ NoPointsInBottomJudgement j+validate j @ (Judgement (h @ (Header (_, p, maxP)), _, subJs @ (_:_))) | isInfinite p = do+  try ((sum $ map maxPoints subJs) ~= maxP)+    (BadSubJudgementMaxPointsSum j)+  validateSubJs j+validate j @ (Judgement (h @ (Header (_, p, maxP)), _, subJs)) = do   try (p <= maxP)     (PointsExceedMaxPoints h)-  case subjs of-    [] -> return ()+  case subJs of+    [] -> pure j     _ -> do-      try ((sum $ map points subjs) ~= p)+      try ((sum $ map points subJs) ~= p)         (BadSubJudgementPointsSum j)-      try ((sum $ map maxPoints subjs) ~= maxP)+      try ((sum $ map maxPoints subJs) ~= maxP)         (BadSubJudgementMaxPointsSum j)-  forM_ subjs validate+      validateSubJs j  points :: Judgement -> Double points (Judgement (Header (_, v, _), _, _)) = v

@@ -13,7 +13,7 @@  import Text.PrettyPrint.GenericPretty -validateStr :: String -> [Either Invalid ()]+validateStr :: String -> [Either Invalid Judgement] validateStr s =   case parseString s of     Right js -> map validate js@@ -23,16 +23,28 @@ posUnitTests = testGroup "Positive Unit Tests"   [ testCase "Lone header line" $       validateStr "# A: 0/0\n" @?=-        [Right ()]+        [ Right $+          Judgement (Header ("A", 0.0, 0.0), [], [])]   , testCase "A couple same-depth header lines" $       validateStr "# A: 0/0\n# B: 0/0\n" @?=-        [Right (), Right ()]+        [ Right $+          Judgement (Header ("A", 0.0, 0.0), [], [])+        , Right $+          Judgement (Header ("B", 0.0, 0.0), [], [])+        ]   , testCase "A simple hierarchy of headers" $       validateStr "# A: 0/0\n## B: 0/0\n" @?=-        [Right ()]+        [ Right $+          Judgement (Header ("A", 0.0, 0.0), [],+            [Judgement (Header ("B", 0.0, 0.0), [], [])])]   , testCase "A couple simple hierarchies" $       validateStr "# A: 0/0\n## B: 0/0\n# C: 0/0\n" @?=-        [Right (), Right ()]+        [ Right $+          Judgement (Header ("A", 0.0, 0.0), [],+            [Judgement (Header ("B", 0.0, 0.0), [], [])])+        , Right $+          Judgement (Header ("C", 0.0, 0.0), [], [])+        ]   ]  negUnitTests :: TestTree@@ -50,6 +62,10 @@         [Left $ BadSubJudgementMaxPointsSum           (Judgement (Header ("A", 0.0, 0.0), [],             [Judgement (Header ("B", 0.0, 1.0), [], [])]))]+  , testCase "Single judgement with no points" $+      validateStr "# A: /0\n" @?=+        [Left $ NoPointsInBottomJudgement+          (Judgement (Header ("A", 1/0, 0.0), [], []))]   ]  qcTests :: TestTree