diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Oleks (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Oleks name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,194 @@ +# `remarks` — A DSL for marking student work + +[![License: BSD 3-Clause](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](LICENSE) +[![Travis CI (Linux + macOS) Status](https://travis-ci.org/oleks/remarks.svg)](https://travis-ci.org/oleks/remarks) +[![AppVeyor (Windows) Status"](https://ci.appveyor.com/api/projects/status/g0hviw442o2bl8yi?svg=true)](https://ci.appveyor.com/project/oleks/remarks) + +When judging student performance, it is useful to have both small, composable, +quantitative judgements, and qualitative remarks. This makes both spreadsheets +and mere text-files ill-suited for marking student work. Although +[org-mode](http://orgmode.org/) can solve this problem to a great extent, it +becomes a heavy tool in the light of having to mark hundreds of students in a +distributed fashion. With org-mode, everything is in one file, while global, +intra-student statistics are not needed until all the students have been fully +marked. + +## Design Goals + + 1. One human-readable/editable file per student. + 2. Export options to spreadsheet-formats. + 3. git-friendly file format. + 4. Synchronization options with Dropbox and/or Google Drive. + +Goal 4 is not necessarily related to `remarks`, but is related to marking +student work with external examiners, who are not always willing to use more +explicit version-control systems, such as git. + +## 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. + +See [Issues](https://github.com/oleks/remarks/issues) for a roadmap. Feel free +to add or fix some. + +## Syntax + +A `.mrk` file is a list of judgements. + +A judgement starts with a header mark (a sequence of `#`), a title (followed by +a `:`), given points (followed by `/`), and maximum points (followed by a line +break). The number of `#` determines the /depth/ of the header, and every file +/must/ start at depth 1, but may have multiple depth 1 judgements. Headings may +be arbitrarily nested, but must sum up correctly. For instance, here is a file +containing only quantitative remarks: + +``` +# Theory: 27/50 +## Question 1: 10/10 +## Question 2: 10/20 +## Question 3: 7/20 +# Practice: 35/50 +## Task 1: 20/25 +## Task 2: 15/25 +``` + +The header of a judgement may be followed by qualitative remarks. Remarks begin +with an indent (two spaces), and a mood mark: + + * `*` for neutral/structural remarks; + * `+` for positive remarks; + * `-` for negative remarks; + * `?` for impartial remarks. + +Impartial remarks are good for judgements where the mood is left to be judged +by a higher authority. For instance, when a teaching assistant is uncertain, +and would like to let the teacher decide, or the solution cannot be used to +make a judgement about this point. + +Structural remarks are good for listing things to look for. For instance, a +(template) judgement for an operating systems exercise may look something like +this: + +``` +## T1: 15/15 + +## Formal requirements: 5/5 + * Has code + * Has XML in a reloadable/testable form + * Has an explanation + +### Quality assessment: 10/10 + * Understands semaphores + * Understands deadlocks + * Understands starvation + * Avoids deadlocks + * Avoids starvation + * Avoids race conditions + * Has a good degree of multiprogramming + * Solves the problem +``` + +Once filled in by a teaching assistant, this may look something like this: + +``` +## T1: 7/15 + +### Formal requirements: 5/5 + * Has code + + Yes. + * Has XML in a reloadable/testable form + + Yes. + * Has an explanation + + Yes. + +### Quality assessment: 2/10 + * Understands semaphores + - Seems to treat them as counters. Report doesn't talk about procuring or + vacating at all. + - Checks semaphore value directly. + - Seems to have mixed up procure and vacate. + * Understands deadlocks + - If more than 5 cars arrive, then only 5 cars will be allowed to drive + through, and everything will then deadlock. + * Understands starvation + ? Seems to, but this is hard to judge. + * Avoids deadlocks + ? See above. + * Avoids starvation + ? Can't judge this. + * Avoids race conditions + - Uses a busy loop in attempt to synchronize. + - There is a race condition after the busy loop. + * Has a good degree of multiprogramming + + It's a ticket system, so it could be okay. + * Solves the problem + + In a complicated way, but yes. +``` + +## Files and Directories + +The file-format is kept "git-friendly" by keeping it comprehensible in +plain-text, and allowing for independent marking by splitting the remarks for a +student into multiple files. + +The simplest setup is to have one `.mrk` file per student (e.g. +[basic.mrk](samples/organization/basic.mrk)). + +To support more exotic setups, `remarks` can also work with directories: + + * If supplied with a directory path, `remarks` looks for files ending in + `.mrk` inside that directory, and comprehends the files, as above, in + lexicographic filename order (e.g., + [directory-with-mrk-files](samples/organization/directory-with-mrk-files)). + + * If there exists a directory `` for any `.mrk`, + `` is recursively searched for further `.mrk` files. Their + contents is appended, in lexicographic filename order, to the last + top-level judgement of `.mrk` + [mixed-directory](samples/organization/mixed-directory)). + +See the [organization samples](samples/organization) for some examples of how +judgements may be structured using files and directories. + +``` +├── basic.mrk +├── directory-with-mrk-files +│   ├── 01-theory.mrk +│   └── 02-practice.mrk +└── mixed-directory + ├── 01-theory.mrk + ├── 02-practice + │   ├── Task1.mrk + │   └── Task2.mrk + └── 02-practice.mrk +``` + +`basic.mrk`, `directory-with-mrk-files`, and `mixed-directory` all parse to the +same judgements. In particular, the output from the following `remarks` +commands is identical: + +``` +$ cd samples/organization/ +$ remarks parse basic.mrk +$ remarks parse directory-with-mrk-files +$ remarks parse mixed-directory +``` + +## Installation + +[`remarks` is on Hackage](http://hackage.haskell.org/package/remarks), so you +can just use [Cabal](https://www.haskell.org/cabal/): + +``` +$ cabal install remarks +``` + +You can also clone this repository and use +[Stack](https://docs.haskellstack.org/en/stable/README/): + +``` +$ stack build +$ stack install +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,130 @@ +module Main where + +import Ast +import Parser +import Validator + +import Control.Monad ( void, filterM ) +import Data.List ( sort, partition ) +import System.Directory + ( doesFileExist, doesDirectoryExist, listDirectory ) +import System.FilePath + ( (<.>), (), takeDirectory, takeExtension, dropExtension ) +import System.Environment( getArgs ) +import System.Exit ( exitWith, ExitCode ( ExitFailure ) ) +import System.IO ( hPutStrLn, stderr ) + +import Text.PrettyPrint.GenericPretty + +report :: String -> IO () +report = hPutStrLn stderr + +noCommand :: IO a +noCommand = do + report "Tell me what to do!" + exitWith (ExitFailure 1) + +notAPath :: String -> IO a +notAPath s = do + report $ s ++ " is not a filesystem path!" + exitWith (ExitFailure 1) + +invalidCommand :: String -> [String] -> IO a +invalidCommand c _ = do + report $ c ++ " is not a valid command." + exitWith (ExitFailure 1) + +noMrkFile :: FilePath -> IO a +noMrkFile path = do + report $ "Can't find a .mrk file\n" ++ path + exitWith (ExitFailure 1) + +noTopLevelJudgement :: FilePath -> IO a +noTopLevelJudgement path = do + report $ path ++ " has no top-level judgement." + report "I don't know how to handle this, sorry." + exitWith (ExitFailure 1) + +mustHaveJudgement :: FilePath -> IO a +mustHaveJudgement path = do + report $ path ++ " must have at least one judgement." + exitWith (ExitFailure 1) + +parseError :: ParseError -> IO a +parseError e = do + report $ show e + exitWith (ExitFailure 1) + +parseTopFile :: FilePath -> IO [Judgement] +parseTopFile path = do + p <- parseFile path + case p of + Right js -> pure js + Left e -> parseError e + +parseFileInDir :: FilePath -> IO Judgement +parseFileInDir path = do + js <- parsePath path + case js of + [j] -> pure j + _ -> noTopLevelJudgement path + +parseFileWithDir :: FilePath -> IO ([Judgement], Judgement) +parseFileWithDir path = do + p <- parseFile path + case p of + Right js -> + case length js of + 0 -> mustHaveJudgement path + n -> pure $ (take (n - 1) js, last js) + Left e -> parseError e + +isMrkPath :: FilePath -> Bool +isMrkPath = (== ".mrk") . takeExtension + +parseDir :: FilePath -> IO [Judgement] +parseDir path = do + paths <- listDirectory path + let (mrkPaths, otherPaths) = partition isMrkPath paths + let fullMrkPaths = map (path ) (sort mrkPaths) + mapM parseFileInDir fullMrkPaths + +extPaths :: FilePath -> (FilePath, FilePath) +extPaths path = + if isMrkPath path + then (path, dropExtension path) + else (path <.> "mrk", path) + +parsePath :: FilePath -> IO [Judgement] +parsePath path = do + let (pathWithExt, pathWithoutExt) = extPaths path + hasFile <- doesFileExist pathWithExt + hasDir <- doesDirectoryExist pathWithoutExt + + if not hasFile + then + if hasDir + then parseDir path + else noMrkFile pathWithExt + else -- we have a .mrk file + if not hasDir + then parseTopFile pathWithExt + else do -- we now also have directory + (fjs, (Judgement (h, cs, js))) <- parseFileWithDir pathWithExt + dirJs <- parseDir pathWithoutExt + pure $ fjs ++ [Judgement (h, cs, js ++ dirJs)] + +parsePaths :: [FilePath] -> IO [[Judgement]] +parsePaths = mapM parsePath + +check :: [Judgement] -> IO () +check js = putStrLn $ pretty $ map validate js + +main :: IO () +main = do + args <- getArgs + case args of + [] -> noCommand + ("parse" : paths) -> parsePaths paths >>= putStrLn . pretty + ("check" : paths) -> parsePaths paths >>= mapM_ check + (c:args) -> invalidCommand c args diff --git a/remarks.cabal b/remarks.cabal new file mode 100644 --- /dev/null +++ b/remarks.cabal @@ -0,0 +1,54 @@ +name: remarks +version: 0.1.0 +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 +license: BSD3 +license-file: LICENSE +author: Oleks +maintainer: oleks@oleks.info +copyright: 2017 Oleks +category: Web +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Ast + , Parser + , Parser.Impl + , Validator + build-depends: base >= 4.7 && < 5 + , GenericPretty >= 1.2.1 + default-language: Haskell2010 + +executable remarks + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , remarks + , GenericPretty >= 1.2.1 + , directory >= 1.2.6.2 + , filepath >= 1.4.1.0 + default-language: Haskell2010 + +test-suite remarks-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Tests.hs + other-modules: Parser.BlackBoxTests + ValidatorTests + build-depends: base + , remarks + , GenericPretty >= 1.2.1 + , tasty >= 0.11.0.4 + , tasty-hunit >= 0.9.2 + , tasty-golden >= 2.3.1.1 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/oleks/remarks diff --git a/src/Ast.hs b/src/Ast.hs new file mode 100644 --- /dev/null +++ b/src/Ast.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Ast where + +import Text.PrettyPrint.GenericPretty + +newtype Header + = Header (String, Double, Double) + deriving (Eq, Show, Generic) + +instance Out Header + +data Mood + = Positive + | Negative + | Neutral + | Impartial + deriving (Eq, Show, Generic) + +instance Out Mood + +data CommentPart + = CommentStr String + | CommentCmt Comment + deriving (Eq, Show, Generic) + +instance Out CommentPart + +newtype Comment + = Comment (Mood, [CommentPart]) + deriving (Eq, Show, Generic) + +instance Out Comment + +newtype Judgement + = Judgement (Header, [Comment], [Judgement]) + deriving (Eq, Show, Generic) + +instance Out Judgement diff --git a/src/Parser.hs b/src/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Parser.hs @@ -0,0 +1,11 @@ +module Parser + ( ParseError + , parseString + , parseFile + ) where + +import Parser.Impl + ( ParseError + , parseString + , parseFile + ) diff --git a/src/Parser/Impl.hs b/src/Parser/Impl.hs new file mode 100644 --- /dev/null +++ b/src/Parser/Impl.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Parser.Impl where + +import Ast +import Text.ParserCombinators.ReadP +import Text.PrettyPrint.GenericPretty + +import Control.Monad ( void ) +import Data.Maybe ( listToMaybe ) + +data ParseErrorImpl a + = NoParse + | AmbiguousGrammar [a] + | NotImplemented + deriving (Eq, Show, Generic) + +instance (Out a) => Out (ParseErrorImpl a) + +type ParseError = ParseErrorImpl [Judgement] + +parseIntegral :: ReadP String +parseIntegral = munch1 (`elem` ['0'..'9']) + +-- Source: http://hackage.haskell.org/package/cgi-3001.3.0.2/docs/src/Network-CGI-Protocol.html#maybeRead +maybeRead :: Read a => String -> Maybe a +maybeRead = fmap fst . listToMaybe . reads + +parsePoints :: ReadP Double +parsePoints = do + is <- parseIntegral + fs <- (char '.' *> parseIntegral) +++ pure "0" + case (maybeRead (is ++ "." ++ fs)) of + Just x -> pure x + _ -> pfail + +lineToken :: ReadP a -> ReadP a +lineToken p = munch (`elem` [' ', '\t', '\r', '\v', '\f']) *> p + +lineBreak :: ReadP () +lineBreak = void $ lineToken $ char '\n' + +munchTillExcl :: Char -> ReadP String +munchTillExcl c = munch (/= c) <* char c + +parseHeader :: Int -> ReadP Header +parseHeader depth = do + let mark = take depth $ repeat '#' + void $ string mark + void $ char ' ' + title <- lineToken $ munchTillExcl ':' + + points <- lineToken $ parsePoints + void $ lineToken $ char '/' + maxPoints <- lineToken $ parsePoints + + void $ lineBreak + + pure $ Header (title, points, maxPoints) + +parseMood :: ReadP Mood +parseMood = choice + [ char '+' *> pure Positive + , char '-' *> pure Negative + , char '*' *> pure Neutral + , char '?' *> pure Impartial + ] + +parseLine :: ReadP String +parseLine = munchTillExcl '\n' + +parseLines :: String -> ReadP [String] +parseLines indent = many $ string indent *> parseLine + +parseCommentPart :: String -> ReadP CommentPart +parseCommentPart indent = many lineBreak *> do + void $ string indent + (fmap CommentCmt $ parseComment indent) <++ + (fmap CommentStr parseLine) + +parseComment :: String -> ReadP Comment +parseComment indent = do + mood <- parseMood + void $ char ' ' + first <- fmap CommentStr parseLine + rest <- many $ parseCommentPart (indent ++ " ") + pure $ Comment (mood, (first : rest)) + +parseComment' :: ReadP Comment +parseComment' = many lineBreak *> do + void $ string " " + parseComment " " + +parseJudgement :: Int -> ReadP Judgement +parseJudgement depth = skipSpaces *> do + header <- parseHeader depth + comments <- many parseComment' + subjs <- many $ parseJudgement (depth + 1) + pure $ Judgement (header, comments, subjs) + +parseJudgements :: Int -> ReadP [Judgement] +parseJudgements depth = many $ parseJudgement depth + +parse :: ReadP a -> String -> [(a, String)] +parse = readP_to_S + +fullParse :: ReadP a -> String -> [a] +fullParse p s = fmap fst $ parse (p <* (skipSpaces >> eof)) s + +parseString' :: ReadP a -> String -> Either (ParseErrorImpl a) a +parseString' p s = + case fullParse p s of + [] -> Left NoParse + [a] -> Right a + as -> Left $ AmbiguousGrammar as + +parseEntry :: ReadP [Judgement] +parseEntry = parseJudgements 1 <* skipSpaces + +parseString :: String -> Either ParseError [Judgement] +parseString = parseString' parseEntry + +parseFile' :: ReadP a -> FilePath -> IO (Either (ParseErrorImpl a) a) +parseFile' p path = fmap (parseString' p) $ readFile path + +parseFile :: FilePath -> IO (Either ParseError [Judgement]) +parseFile = parseFile' parseEntry diff --git a/src/Validator.hs b/src/Validator.hs new file mode 100644 --- /dev/null +++ b/src/Validator.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Validator ( validate, Invalid(..) ) where + +import Ast + +import Control.Monad ( forM_ ) + +import Text.PrettyPrint.GenericPretty + +data Invalid + = PointsExceedMaxPoints Header + | BadSubJudgementPointsSum Judgement + | BadSubJudgementMaxPointsSum Judgement + deriving (Eq, Show, Generic) + +instance Out Invalid + +try :: Bool -> Invalid -> Either Invalid () +try True = \_ -> Right () +try False = Left + +infix 4 ~= +(~=) :: Double -> Double -> Bool +x ~= y = abs (x - y) <= 0.01 + +validate :: Judgement -> Either Invalid () +validate j @ (Judgement (h @ (Header (_, p, maxP)), _, subjs)) = do + try (p <= maxP) + (PointsExceedMaxPoints h) + try ((sum $ map points subjs) ~= p) + (BadSubJudgementPointsSum j) + try ((sum $ map maxPoints subjs) ~= maxP) + (BadSubJudgementMaxPointsSum j) + forM_ subjs validate + +points :: Judgement -> Double +points (Judgement (Header (_, v, _), _, _)) = v + +maxPoints :: Judgement -> Double +maxPoints (Judgement (Header (_, _, v), _, _)) = v diff --git a/test/Parser/BlackBoxTests.hs b/test/Parser/BlackBoxTests.hs new file mode 100644 --- /dev/null +++ b/test/Parser/BlackBoxTests.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Parser.BlackBoxTests ( allTests ) where + +import Ast +import Parser + +import Test.Tasty +import Test.Tasty.HUnit +-- import Test.Tasty.QuickCheck +import Test.Tasty.Golden + +import Text.PrettyPrint.GenericPretty + +unitTests :: TestTree +unitTests = testGroup "Unit tests" + [ testCase "Lone header line" $ + parseString "# A: 0/0\n" @?= + Right + [ Judgement (Header ("A",0.0,0.0), [], []) + ] + , testCase "A couple same-depth header lines" $ + parseString "# A: 0/0\n# B: 0/0\n" @?= + Right + [ Judgement (Header ("A",0.0,0.0), [], []) + , Judgement (Header ("B",0.0,0.0), [], []) + ] + , testCase "A simple hierarchy of headers" $ + parseString "# A: 0/0\n## B: 0/0\n" @?= + Right + [ Judgement (Header ("A",0.0,0.0), [], + [ Judgement (Header ("B",0.0,0.0), [], []) + ]) + ] + , testCase "A couple simple hierarchies" $ + parseString "# A: 0/0\n## B: 0/0\n# C: 0/0\n" @?= + Right + [ Judgement (Header ("A",0.0,0.0), [], + [ Judgement (Header ("B",0.0,0.0), [], []) + ]) + , Judgement (Header ("C",0.0,0.0), [], []) + ] + ] + +qcTests :: TestTree +qcTests = testGroup "QuickCheck tests" [] + +golden' :: String -> TestTree +golden' basename = + goldenVsFile name fref fout $ do + p <- parseFile fin + writeFile fout $ (pretty p) ++ "\n" + where + prefix = "test/golden/" + name = basename ++ ".mrk" + fin = prefix ++ name + fref = prefix ++ basename ++ ".ref" + fout = prefix ++ basename ++ ".out" + +goldenTests :: TestTree +goldenTests = testGroup "Golden tests" + [ golden' "deep-judgement" + , golden' "some-top-level-judgements" + , golden' "some-judgements" + ] + +allTests :: TestTree +allTests = testGroup "Black-box parser tests" + [ unitTests, qcTests, goldenTests ] diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Tests.hs @@ -0,0 +1,10 @@ +module Main where + +import Test.Tasty + +import qualified Parser.BlackBoxTests as PBBT +import qualified ValidatorTests as VT + +main :: IO () +main = defaultMain $ testGroup "All Tests" + [ PBBT.allTests, VT.allTests ] diff --git a/test/ValidatorTests.hs b/test/ValidatorTests.hs new file mode 100644 --- /dev/null +++ b/test/ValidatorTests.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DeriveGeneric #-} + +module ValidatorTests ( allTests ) where + +import Ast +import Parser +import Validator + +import Test.Tasty +import Test.Tasty.HUnit +-- import Test.Tasty.QuickCheck +import Test.Tasty.Golden + +import Text.PrettyPrint.GenericPretty + +validateStr :: String -> [Either Invalid ()] +validateStr s = + case parseString s of + Right js -> map validate js + Left e -> [] + +posUnitTests :: TestTree +posUnitTests = testGroup "Positive Unit Tests" + [ testCase "Lone header line" $ + validateStr "# A: 0/0\n" @?= + [Right ()] + , testCase "A couple same-depth header lines" $ + validateStr "# A: 0/0\n# B: 0/0\n" @?= + [Right (), Right ()] + , testCase "A simple hierarchy of headers" $ + validateStr "# A: 0/0\n## B: 0/0\n" @?= + [Right ()] + , testCase "A couple simple hierarchies" $ + validateStr "# A: 0/0\n## B: 0/0\n# C: 0/0\n" @?= + [Right (), Right ()] + ] + +negUnitTests :: TestTree +negUnitTests = testGroup "Positive Unit Tests" + [ testCase "Points exceed max points" $ + validateStr "# A: 1/0\n" @?= + [Left $ PointsExceedMaxPoints (Header ("A", 1.0, 0.0))] + , testCase "Sub-judgement points don't sum up to points" $ + validateStr "# A: 0/0\n## B: 1/0\n" @?= + [Left $ BadSubJudgementPointsSum + (Judgement (Header ("A", 0.0, 0.0), [], + [Judgement (Header ("B", 1.0, 0.0), [], [])]))] + , testCase "Sub-judgement max-points don't sum up to max-points" $ + validateStr "# A: 0/0\n## B: 0/1\n" @?= + [Left $ BadSubJudgementMaxPointsSum + (Judgement (Header ("A", 0.0, 0.0), [], + [Judgement (Header ("B", 0.0, 1.0), [], [])]))] + ] + +qcTests :: TestTree +qcTests = testGroup "QuickCheck tests" [] + +goldenTests :: TestTree +goldenTests = testGroup "Golden tests" [] + +allTests :: TestTree +allTests = testGroup "Validator tests" + [ posUnitTests, negUnitTests, qcTests, goldenTests ]