From 5b4b1350a9b01ac9e9dcd1271758694106734f35 Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Tue, 22 Sep 2015 22:59:29 -0400 Subject: [PATCH] Factor out parsing core to Grade.GradeIO --- grade.cabal | 2 ++ lib/Grade/GradeIO.hs | 77 ++++++++++++++++++++++++++++++++++++++++++++ prog/Grade.hs | 52 ++++-------------------------- 3 files changed, 85 insertions(+), 46 deletions(-) create mode 100644 lib/Grade/GradeIO.hs diff --git a/grade.cabal b/grade.cabal index 06335f4..b62ba7a 100644 --- a/grade.cabal +++ b/grade.cabal @@ -17,6 +17,7 @@ library Grade.ParseUtils, Grade.Parse, Grade.Grade, + Grade.GradeIO, Grade.Score.Zeroing, Grade.Score.Setting, Grade.Score.Bounding, @@ -37,6 +38,7 @@ library parsers >=0.12 && <1, text >=1.2 && <2, trifecta >=1.5 && <2, + ansi-wl-pprint >= 0.6 && <1, wl-pprint-extras >=3.5 && <4 executable grade diff --git a/lib/Grade/GradeIO.hs b/lib/Grade/GradeIO.hs new file mode 100644 index 0000000..6bb9b48 --- /dev/null +++ b/lib/Grade/GradeIO.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Grade.GradeIO ( + withDefines, withDefinesOrElse, + withReport, withReportDoc +) where + +import System.Exit (ExitCode(..), exitWith) +import System.IO (hPutStrLn, stderr) +import qualified Text.PrettyPrint.ANSI.Leijen as TPP +import qualified Text.PrettyPrint.Free as PP +import qualified Text.Trifecta as T +import qualified Text.Trifecta.Delta as T + +import Grade.Types +import Grade.Parse +import Grade.Print +import Grade.Grade + + +withDefines :: T.Parser (ExSecCallback T.Parser) + -> FilePath + -> (Defines T.Parser T.Caret -> IO a) + -> IO (Either TPP.Doc a) +withDefines sectys defi act = do + mdefines <- T.parseFromFileEx (parseDefns sectys) defi + case mdefines of + T.Failure f -> parseErr f + T.Success defs -> Right <$> act defs + where + parseErr f = pure $ Left ( "Error while parsing defines" TPP.<+> TPP.pretty defi TPP.<> ":" + TPP. f) + + +withDefinesOrElse :: T.Parser (ExSecCallback T.Parser) + -> FilePath + -> (Defines T.Parser T.Caret -> IO a) + -> IO a +withDefinesOrElse sectys defi act = withDefines sectys defi act >>= eh + where + eh (Left f) = do + hPutStrLn stderr (show f) + exitWith (ExitFailure 2) + eh (Right a) = pure a + +withReport :: Defines T.Parser T.Caret + -> FilePath + -> (ReportFile -> IO r) + -> IO (Either (PP.Doc e) r) +withReport defs dati act = do + mdata <- T.parseFromFileEx (parseData defs) dati + case mdata of + T.Failure e -> parseErr (PP.pretty $ show e) -- XXX; sadness and woe + T.Success (dats, errs) -> + case errs of + [] -> case gradeOne defs dats of + Left e -> gradeErr (vmpesc e) + Right r -> Right <$> act r + _ -> parseErr (vmpesc errs) + + where + parseErr e = pure $ Left ("Error while parsing data file" PP.<+> PP.pretty dati PP.<> ":" PP. e) + gradeErr e = pure $ Left ("Error while grading" PP.<+> PP.pretty dati PP.<> ":" PP. e) + vmpesc e = PP.vcat (map (printReportError showcaret) e) + showcaret = PP.text . show . TPP.pretty . T.delta + +withReportDoc :: Defines T.Parser T.Caret + -> FilePath + -> (forall e . PP.Doc e -> IO ()) + -> IO Bool +withReportDoc defs dati act = withReport defs dati (act . printReport) >>= eh + where + eh (Left d) = PP.hPutDoc stderr d >> pure False + eh (Right ()) = pure True + + diff --git a/prog/Grade.hs b/prog/Grade.hs index 195c6bc..dd3d44f 100644 --- a/prog/Grade.hs +++ b/prog/Grade.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where @@ -9,10 +8,8 @@ module Main where import Control.Monad (when) import Data.Data (Data) -import qualified Text.PrettyPrint.ANSI.Leijen as TPP import qualified Text.PrettyPrint.Free as PP import qualified Text.Trifecta as T -import qualified Text.Trifecta.Delta as T import qualified System.Console.CmdLib as C import System.Directory @@ -21,9 +18,8 @@ import System.Exit import System.IO import Grade.Parse -import Grade.Grade import Grade.Skeleton -import Grade.Print +import Grade.GradeIO import qualified Grade.Score.EqualWeighted as GSE import qualified Grade.Score.Simple as GSS @@ -66,50 +62,14 @@ doMakeSkeleton defi = do T.Failure f -> hPutStrLn stderr (show f) T.Success d -> print $ makeSkel d -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 -> 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 +doGradeOne defi dati = withDefinesOrElse sectys defi $ \defs -> do + withReportDoc defs dati (\d -> PP.hPutDoc stdout d) >>= \case True -> pure () False -> exitWith (ExitFailure 1) doGradeDir :: Int -> String -> FilePath -> FilePath -> IO () -doGradeDir verbose defi datd outd = withDefinesOrElse defi $ \defs -> do +doGradeDir verbose defi datd outd = withDefinesOrElse sectys defi $ \defs -> do createDirectoryIfMissing True outd dentries <- getDirectoryContents datd oks <- flip mapM dentries $ \dentry -> do @@ -119,8 +79,8 @@ doGradeDir verbose defi datd outd = withDefinesOrElse defi $ \defs -> do 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) + withReportDoc defs (datd dentry) $ \d -> + withFile (outd dentry) WriteMode (flip PP.hPutDoc d) exitWith $ if and oks then ExitSuccess else ExitFailure 1 data Cmd = MakeSkeleton { defines :: String } -- 2.50.1