remarks 0.1.3 → 0.1.4

raw patch · 7 files changed

+57/−46 lines, 7 files

Files

• LICENSE +1/−1
• app/Main.hs +4/−4
• remarks.cabal +4/−3
• src/Config.hs +4/−0
• src/PPmrk.hs +0/−35
• src/Parser/Impl.hs +4/−3
• src/PrettyPrinter.hs +40/−0

@@ -1,4 +1,4 @@-Copyright Oleks (c) 2017+Copyright DIKU (c) 2017  All rights reserved. 

@@ -3,10 +3,10 @@ import Ast import Parser import Validator-import PPmrk+import PrettyPrinter  import Control.Monad ( void, filterM )-import Data.List ( sort, partition )+import Data.List ( sort ) import System.Directory   ( doesFileExist, doesDirectoryExist, listDirectory ) import System.FilePath@@ -86,7 +86,7 @@ parseDir :: FilePath -> IO [Judgement] parseDir path = do   paths <- listDirectory path-  let (mrkPaths, otherPaths) = partition isMrkPath paths+  let mrkPaths = filter isMrkPath paths   let fullMrkPaths = map (path </>) (sort mrkPaths)   mapM parseFileInDir fullMrkPaths @@ -131,5 +131,5 @@     [] -> noCommand     ("parse" : paths) -> parsePaths paths >>= putStrLn . pretty     ("check" : paths) -> parsePaths paths >>= mapM_ check-    ("markup" : paths) -> parsePaths paths >>= mapM_ ppMarkup+    ("show" : paths) -> parsePaths paths >>= mapM_ ppMarkup     (c:args) -> invalidCommand c args

@@ -1,5 +1,5 @@ name:                remarks-version:             0.1.3+version:             0.1.4 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@@ -7,7 +7,7 @@ license-file:        LICENSE author:              Oleks maintainer:          oleks@oleks.info-copyright:           2017 Oleks+copyright:           2017 DIKU category:            Web build-type:          Simple extra-source-files:  README.md@@ -19,7 +19,8 @@                      , Parser                      , Parser.Impl                      , Validator-                     , PPmrk+                     , PrettyPrinter+                     , Config   build-depends:       base >= 4.7 && < 5                      , GenericPretty >= 1.2.1                      , pretty >= 1.1.3.3

@@ -0,0 +1,4 @@+module Config where++indentation :: String+indentation = "  "

@@ -1,35 +0,0 @@-module PPmrk (toMrk) where--import Ast--import Text.PrettyPrint--toMrk :: [Judgement] -> String-toMrk js = render $ vcat $ map (formatJudgement 1) js--formatJudgement level (Judgement (header, comments, judgements)) =-  formatHeader level header $+$-  (nest 2 $ vcat $ map (formatComment) comments) $+$-  (vcat $ map (formatJudgement (level + 1)) judgements)--isIntegral :: Double -> Bool-isIntegral x = x == fromInteger (round x)--pointsDoc :: Double -> Doc-pointsDoc v | isIntegral v = integer (round v)-pointsDoc v = double v--formatHeader level (Header (title, point, maxPoints)) =-  (text $ replicate level '#') <+> text title <> colon <+>-    pointsDoc point <> text "/" <> pointsDoc maxPoints--formatComment (Comment (mood, commentParts)) =-  formatMood mood <+> (vcat $ map formatCommentPart commentParts)--formatMood Positive  = text "+"-formatMood Negative  = text "-"-formatMood Neutral   = text "*"-formatMood Impartial = text "?"--formatCommentPart (CommentStr string)  = text string-formatCommentPart (CommentCmt comment) = nest 2 $ formatComment comment

@@ -3,6 +3,7 @@ module Parser.Impl where  import Ast+import Config import Text.ParserCombinators.ReadP import Text.PrettyPrint.GenericPretty @@ -83,13 +84,13 @@   mood <- parseMood   void $ char ' '   first <- fmap CommentStr parseLine-  rest <- many $ parseCommentPart (indent ++ "  ")+  rest <- many $ parseCommentPart (indent ++ indentation)   pure $ Comment (mood, (first : rest))  parseComment' :: ReadP Comment parseComment' = many lineBreak *> do-  void $ string "  "-  parseComment "  "+  void $ string indentation+  parseComment indentation  parseJudgement :: Int -> ReadP Judgement parseJudgement depth = skipSpaces *> do

@@ -0,0 +1,40 @@+module PrettyPrinter (toMrk) where++import Ast++import Text.PrettyPrint++toMrk :: [Judgement] -> String+toMrk js = render $ vcat $ map (formatJudgement 1) js++formatJudgement :: Int -> Judgement -> Doc+formatJudgement level (Judgement (header, comments, judgements)) =+  formatHeader level header $+$+  (nest 2 $ vcat $ map (formatComment) comments) $+$+  (vcat $ map (formatJudgement (level + 1)) judgements)++isIntegral :: Double -> Bool+isIntegral x = x == fromInteger (round x)++pointsDoc :: Double -> Doc+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 <+>+    pointsDoc point <> text "/" <> pointsDoc maxPoints++formatComment :: Comment -> Doc+formatComment (Comment (mood, commentParts)) =+  formatMood mood <+> (vcat $ map formatCommentPart commentParts)++formatMood :: Mood -> Doc+formatMood Positive  = text "+"+formatMood Negative  = text "-"+formatMood Neutral   = text "*"+formatMood Impartial = text "?"++formatCommentPart :: CommentPart -> Doc+formatCommentPart (CommentStr string)  = text string+formatCommentPart (CommentCmt comment) = nest 2 $ formatComment comment