From 827b2bfd216d14bfdeb0d3c4550fc690c81913c0 Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Mon, 14 Sep 2015 18:58:47 -0400 Subject: [PATCH] Add grade-dir command for bulk processing --- grade.cabal | 2 + prog/Grade.hs | 111 +++++++++++++++++++++++++++++++++++++------------- 2 files changed, 85 insertions(+), 28 deletions(-) diff --git a/grade.cabal b/grade.cabal index 126b613..b13d23d 100644 --- a/grade.cabal +++ b/grade.cabal @@ -45,6 +45,8 @@ executable grade other-extensions: CPP build-depends: base >=4.6 && <5, cmdlib >= 0.3 && <1, + directory >= 1.2 && <2, + filepath >= 1.4 && <2, trifecta >=1.5 && <2, ansi-wl-pprint >= 0.6 && <1, wl-pprint-extras >=3.5 && <4, diff --git a/prog/Grade.hs b/prog/Grade.hs index e7a867b..195c6bc 100644 --- a/prog/Grade.hs +++ b/prog/Grade.hs @@ -1,8 +1,12 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where +import Control.Monad (when) import Data.Data (Data) import qualified Text.PrettyPrint.ANSI.Leijen as TPP @@ -11,6 +15,9 @@ import qualified Text.Trifecta as T import qualified Text.Trifecta.Delta as T import qualified System.Console.CmdLib as C +import System.Directory +import System.FilePath +import System.Exit import System.IO import Grade.Parse @@ -59,54 +66,102 @@ doMakeSkeleton defi = do T.Failure f -> hPutStrLn stderr (show f) T.Success d -> print $ makeSkel d -doGradeOne :: String -> String -> IO () -doGradeOne defi dati = do +withDefinesOrElse :: FilePath -> (Defines T.Parser T.Caret -> IO a) -> IO a +withDefinesOrElse defi act = do mdefines <- T.parseFromFileEx (parseDefns sectys) defi case mdefines of - T.Failure f -> hPutStrLn stderr "Error while parsing defines:" - *> hPutStrLn stderr (show f) - T.Success defs -> do - mdata <- T.parseFromFileEx (parseData defs) dati - case mdata of - T.Failure f -> hPutStrLn stderr "Error while parsing data:" - *> hPutStrLn stderr (show f) - T.Success (dats, errs) -> case errs of - [] -> case gradeOne defs dats of - Left e -> do - hPutStrLn stderr "Error while grading:" - hPutStrLn stderr $ show $ PP.vcat - $ map (printReportError showcaret) e - Right r -> print $ printReport r - _ -> do - hPutStrLn stderr "Error while parsing data:" - hPutStrLn stderr $ show $ PP.vcat - $ map (printReportError showcaret) errs + T.Failure f -> do + hPutStrLn stderr "Error while parsing defines:" + hPutStrLn stderr (show f) + exitWith (ExitFailure 2) + T.Success defs -> act defs + +grade :: Defines T.Parser T.Caret -> FilePath -> (forall e . PP.Doc e -> IO Bool) -> IO Bool +grade defs dati act = do + mdata <- T.parseFromFileEx (parseData defs) dati + case mdata of + T.Failure f -> do + hPutStrLn stderr $ "Error while parsing data file " ++ dati ++ ":" + hPutStrLn stderr (show f) + pure False + T.Success (dats, errs) -> + case errs of + [] -> case gradeOne defs dats of + Left e -> do + hPutStrLn stderr $ "Error while grading " ++ dati ++ ":" + hPutStrLn stderr $ show $ PP.vcat + $ map (printReportError showcaret) e + pure False + Right r -> act (printReport r) + _ -> do + hPutStrLn stderr $ "Error while parsing data file " ++ dati ++ ":" + hPutStrLn stderr $ show $ PP.vcat + $ map (printReportError showcaret) errs + pure False where showcaret = PP.text . show . TPP.pretty . T.delta +doGradeOne :: FilePath -> FilePath -> IO () +doGradeOne defi dati = withDefinesOrElse defi $ \defs -> do + grade defs dati (\d -> PP.hPutDoc stdout d *> pure True) >>= \case + True -> pure () + False -> exitWith (ExitFailure 1) + +doGradeDir :: Int -> String -> FilePath -> FilePath -> IO () +doGradeDir verbose defi datd outd = withDefinesOrElse defi $ \defs -> do + createDirectoryIfMissing True outd + dentries <- getDirectoryContents datd + oks <- flip mapM dentries $ \dentry -> do + doesFileExist (datd dentry) >>= \ case + False -> do + when (verbose > 1) $ hPutStrLn stderr $ "Skipping " ++ dentry ++ ": is directory" + pure True -- Skip inner directories + True -> do + when (verbose > 0) $ hPutStrLn stderr $ "Grading " ++ dentry + grade defs (datd dentry) + (\d -> withFile (outd dentry) WriteMode (flip PP.hPutDoc d) *> pure True) + exitWith $ if and oks then ExitSuccess else ExitFailure 1 data Cmd = MakeSkeleton { defines :: String } | GradeOne { defines :: String, datafile :: String } - -- XXX TODO | GradeDir { defines :: String, in_dir :: String, out_dir :: String } + | GradeDir { defines :: String, inDir :: String, outDir :: String, verbose :: Int } deriving (Data,Eq,Show) instance C.Attributes Cmd instance C.RecordCommand Cmd where mode_summary (MakeSkeleton {}) = "Make grader skeleton from defines file" mode_summary (GradeOne {}) = "Grade one student file" + mode_summary (GradeDir {}) = "Grade a directory of student files" - rec_options (MakeSkeleton {}) = defines C.%> C.Default ("/dev/fd/0" :: String) - C.%+ C.Positional 0 - C.%+ C.Required True - rec_options (GradeOne {}) = (defines C.%> C.Positional 0 - C.%+ C.Required True) + rec_options (MakeSkeleton {}) = (defines C.%> C.Default ("/dev/fd/0" :: String) + C.%+ C.Positional 0 + C.%+ C.Required True) + + rec_options (GradeOne {}) = (defines C.%> C.Positional 0 + C.%+ C.Required True) C.%% (datafile C.%> C.Long ["data"] C.%+ C.Help "grade data file" C.%+ C.Default ("/dev/fd/0" :: String)) - run' (MakeSkeleton {defines = i}) _ = doMakeSkeleton i - run' (GradeOne { defines = defi, datafile = dati }) _ = doGradeOne defi dati + rec_options (GradeDir {}) = (defines C.%> C.Positional 0 + C.%+ C.Required True) + C.%% + (outDir C.%> C.Positional 1 + C.%+ C.Required True) + C.%% + (inDir C.%> C.Positional 2 + C.%+ C.Help "defaults to $PWD" + C.%+ C.Default ("." :: FilePath)) + C.%% + (verbose C.%> C.Long ["verbose"] + C.%+ C.ArgHelp "V" + C.%+ C.Help "be chatty (0 to 2)" + C.%+ C.Default (1 :: Int)) + + run' (MakeSkeleton {defines}) _ = doMakeSkeleton defines + run' (GradeOne {defines, datafile}) _ = doGradeOne defines datafile + run' (GradeDir {defines, inDir, outDir, verbose}) _ = doGradeDir verbose defines inDir outDir main' :: [String] -> IO () main' ars = C.dispatchR [] ars >>= \(x :: Cmd) -> C.run' x [] -- 2.50.1