From: Nathaniel Wesley Filardo Date: Fri, 11 Sep 2015 23:57:26 +0000 (-0400) Subject: Add support for section arguments in data file X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=9c3e91adf4814f8d9f6f862518efb7bf5b9b20f6;p=grade Add support for section arguments in data file See Grade.Section.SectionOnly for an example of how this could be used. While here, break SecCallback into a core and existential wrapper; this makes it a little easier for the scoring modules to write down meaningful types as a kind of machine-checked documentation. --- diff --git a/examples/data b/examples/data index 7a39030..f101905 100644 --- a/examples/data +++ b/examples/data @@ -16,7 +16,7 @@ $END_COMMENTS :misc_ding # But uncommenting this would give an error! -# :simple_test +#:simple_test $BEGIN_COMMENTS More grader comments in a different section @@ -29,6 +29,12 @@ $END_COMMENTS # If we had this, we'd get an unknown section error #@foo +@justScoreMe 8 + +$BEGIN_COMMENTS +abcd +$END_COMMENTS + @tests2 :some_other_test -#:yet_another_test +:yet_another_test diff --git a/examples/defines.conf b/examples/defines.conf index ca4cede..963164c 100644 --- a/examples/defines.conf +++ b/examples/defines.conf @@ -5,6 +5,11 @@ The submission failed to compile. . +# Here is a section without any dings; it uses a different +# section definition to take an argument directly in the +# data file. +@justScoreMe seconly 10 - One Last Thing + # Manual test result section @tests bounding simple 40 - Functionality Tests # Un-comment the appropriate directive for each test failed. diff --git a/grade.cabal b/grade.cabal index 6e34951..9e91b67 100644 --- a/grade.cabal +++ b/grade.cabal @@ -19,6 +19,7 @@ library Grade.Score.Zeroing, Grade.Score.Setting, Grade.Score.Bounding, + Grade.Score.SectionOnly, Grade.Score.Simple, Grade.Score.EqualWeighted, Grade.Score.EqualWeightedCounting, diff --git a/lib/Grade/Grade.hs b/lib/Grade/Grade.hs index 19ee24f..9ffab2e 100644 --- a/lib/Grade/Grade.hs +++ b/lib/Grade/Grade.hs @@ -18,8 +18,8 @@ collectErrors x = case partitionEithers x of processDFS :: ExDFS loc -> Either String ReportFileSection -processDFS (ExDFS (DFS (SecMeta stitle smax sfn sdpo) _ dds dgcs)) = do - sscore <- sfn $ mconcat $ (_dm_mod . _dfd_meta) <$> dds +processDFS (ExDFS (DFS (SecMeta stitle smax sfn sdpo) sat _ dds dgcs)) = do + sscore <- sfn sat $ mconcat $ (_dm_mod . _dfd_meta) <$> dds pure $ RFS stitle sscore smax (dopo <$> dds) dgcs where dopo d = T.unlines $ addMod $ pure $ (_dm_text . _dfd_meta) d @@ -28,9 +28,9 @@ processDFS (ExDFS (DFS (SecMeta stitle smax sfn sdpo) _ dds dgcs)) = do then id -- Don't print if section is worthless else maybe id -- Don't print if the section chooses to not ((:) . T.cons '(' . flip T.snoc ')' . T.pack) -- Add parens otherwise - (sdpo (_dm_mod $ _dfd_meta d)) + (sdpo sat (_dm_mod $ _dfd_meta d)) -gradeOne :: Defines loc' -> DataFile loc -> Either [ReportError loc] ReportFile +gradeOne :: Defines f loc' -> DataFile loc -> Either [ReportError loc] ReportFile gradeOne (Defs defs _) (DF dfss) = let availScores = collectErrors $ fmap processSec dfss in let residualSecs = M.keysSet $ foldr (\(k,_) f -> (M.delete k) . f) id dfss defs in diff --git a/lib/Grade/Parse.hs b/lib/Grade/Parse.hs index 9aa7cfc..15f3cf1 100644 --- a/lib/Grade/Parse.hs +++ b/lib/Grade/Parse.hs @@ -95,7 +95,7 @@ parseDingDefn dl = do parseSectionDefn :: (T.DeltaParsing f, T.MarkParsing T.Delta f, T.Errable f, T.LookAheadParsing f) - => f (SecCallback f) -> f (SecName, ExSection T.Caret) + => f (ExSecCallback f) -> f (SecName, ExSection f T.Caret) parseSectionDefn fsdap = do scs <- many hashComment _ T.:^ c <- T.careted (T.symbolic '@') @@ -106,18 +106,18 @@ parseSectionDefn fsdap = do stitle <- toUtf8 (T.sliced (T.manyTill T.anyChar (T.lookAhead T.newline))) _ <- T.newline case esdp of - SC fsdt sdpo sfn smaxfn -> do + ExSecCB (SC mfss fsdt sdpo sfn smaxfn) -> do (sstate, sdings) <- getDings fsdt M.empty _ <- T.whiteSpace return (sname, ExSec $ - Sec (SecMeta stitle (smaxfn sstate) (sfn sstate) (sdpo sstate)) c shidden scs sdings) + Sec (SecMeta stitle (smaxfn sstate) (sfn sstate) (sdpo sstate)) c shidden scs sdings mfss) where - getDings sdp = go mempty + getDings fsdt = go mempty where go s m = nextDing s m <|> return (s,m) nextDing s m = do - (dn, ds, db) <- parseDingDefn sdp + (dn, ds, db) <- parseDingDefn fsdt case M.lookup dn m of Nothing -> go (s `mappend` ds) (M.insert dn db m) Just _ -> do @@ -125,7 +125,7 @@ parseSectionDefn fsdap = do -- | Parse a definitions file parseDefns :: (T.DeltaParsing f, T.MarkParsing T.Delta f, T.Errable f, T.LookAheadParsing f) - => f (SecCallback f) -> f (Defines T.Caret) + => f (ExSecCallback f) -> f (Defines f T.Caret) parseDefns sectys = T.whiteSpace *> go M.empty [] <* T.eof where go m l = nextSection m l <|> return (Defs m (reverse l)) @@ -142,7 +142,7 @@ parseDefns sectys = T.whiteSpace *> go M.empty [] <* T.eof -- | Parse a grader data file parseData :: forall f loc . (T.DeltaParsing f, T.LookAheadParsing f) - => Defines loc -> f (DataFile T.Caret, [ReportError T.Caret]) + => Defines f loc -> f (DataFile T.Caret, [ReportError T.Caret]) parseData defs = do _ <- T.whiteSpace (ss, fsm) <- sections defs @@ -159,13 +159,14 @@ parseData defs = do another already = do (sn,esb) T.:^ sc <- get >>= \sm -> sectionDirective sm case esb of - ExSec (Sec smeta _ _ _ sdm) -> do + ExSec (Sec smeta _ _ _ sdm (_,fsat)) -> do + sat <- lift fsat ds <- sectionDings sdm mcs <- T.optional $ T.string commentStart *> T.newline *> toUtf8 (T.sliced (T.manyTill T.anyChar (T.lookAhead cend))) <* cend _ <- T.whiteSpace - ((sn, ExDFS $ DFS smeta sc ds mcs) :) + ((sn, ExDFS $ DFS smeta sat sc ds mcs) :) <$> (modify (M.delete sn) >> go (M.insert sn () already)) cend = T.string commentEnd *> T.newline diff --git a/lib/Grade/Score/Bounding.hs b/lib/Grade/Score/Bounding.hs index 09902bc..38d3745 100644 --- a/lib/Grade/Score/Bounding.hs +++ b/lib/Grade/Score/Bounding.hs @@ -1,15 +1,16 @@ -- | Bound scores both above (by section max) and below (by zero) module Grade.Score.Bounding (BoundHow(..), bounding) where -import Grade.Types (SecCallback(..)) +import Grade.Types (ExSecCallback(..), SecCallback(..)) data BoundHow = Below | Above | Both +bound :: BoundHow -> Double -> Double -> Double bound Below _ = max 0.0 bound Above m = min m bound Both m = max 0.0 . min m -bounding :: BoundHow -> SecCallback f -> SecCallback f +bounding :: BoundHow -> ExSecCallback f -> ExSecCallback f bounding how s = case s of - SC pa po g pm -> - SC pa po (\sps sdt -> bound how (pm sps) <$> g sps sdt) pm + ExSecCB (SC ps pa po g pm) -> + ExSecCB (SC ps pa po (\sps sat sdt -> bound how (pm sps) <$> g sps sat sdt) pm) diff --git a/lib/Grade/Score/EqualWeighted.hs b/lib/Grade/Score/EqualWeighted.hs index 835d969..71b771d 100644 --- a/lib/Grade/Score/EqualWeighted.hs +++ b/lib/Grade/Score/EqualWeighted.hs @@ -8,7 +8,7 @@ module Grade.Score.EqualWeighted (sectyEqualWeighted) where import Control.Exception (assert) import Data.Monoid (Sum(getSum)) import Numeric -import Grade.Types (SecCallback(..)) +import Grade.Types (ExSecCallback(..), SecCallback(..)) import qualified Text.Trifecta as T efid :: (T.TokenParsing f) => f Double @@ -22,12 +22,15 @@ impact smax ntotal ndinged = smax / fis ntotal * fis ndinged where fis = fromIntegral . getSum -printDing :: Double -> Sum Int -> Sum Int -> Maybe String -printDing smax ntotal ding = assert (getSum ding == 1) - $ Just (showFFloat (Just 1) (0.0 - impact smax ntotal ding) "") +printDing :: Double -> Sum Int -> () -> Sum Int -> Maybe String +printDing smax ntotal () ding = assert (getSum ding == 1) + $ Just (showFFloat (Just 1) (0.0 - impact smax ntotal ding) "") -scorefn :: Double -> Sum Int -> Sum Int -> Either String Double -scorefn smax ntotal ndinged = Right $ smax - impact smax ntotal ndinged +scorefn :: Double -> Sum Int -> () -> Sum Int -> Either String Double +scorefn smax ntotal () ndinged = Right $ smax - impact smax ntotal ndinged -sectyEqualWeighted :: (T.TokenParsing f) => f (SecCallback f) -sectyEqualWeighted = (\smax -> SC parseDing (printDing smax) (scorefn smax) (\_ -> smax)) <$> efid +sectyEqualWeighted_ :: (T.TokenParsing f) => f (SecCallback f (Sum Int) () (Sum Int)) +sectyEqualWeighted_ = (\smax -> SC (Nothing, pure ()) parseDing (printDing smax) (scorefn smax) (\_ -> smax)) <$> efid + +sectyEqualWeighted :: (T.TokenParsing f) => f (ExSecCallback f) +sectyEqualWeighted = ExSecCB <$> sectyEqualWeighted_ diff --git a/lib/Grade/Score/EqualWeightedCounting.hs b/lib/Grade/Score/EqualWeightedCounting.hs index 79eb3e6..1ab89fb 100644 --- a/lib/Grade/Score/EqualWeightedCounting.hs +++ b/lib/Grade/Score/EqualWeightedCounting.hs @@ -8,7 +8,7 @@ module Grade.Score.EqualWeightedCounting (sectyEqualWeighted) where import Control.Exception (assert) import Data.Monoid (Sum(getSum)) import Numeric -import Grade.Types (SecCallback(..)) +import Grade.Types (ExSecCallback(..), SecCallback(..)) import qualified Text.Trifecta as T parseDing :: (Applicative f) => f (Sum Int,Sum Int) @@ -17,11 +17,11 @@ parseDing = pure (1, 1) fis :: Sum Int -> Double fis = fromIntegral . getSum -printDing :: Sum Int -> Sum Int -> Maybe String -printDing _ ding = assert (getSum ding == 1) $ Just "-1" +printDing :: Sum Int -> () -> Sum Int -> Maybe String +printDing _ () ding = assert (getSum ding == 1) $ Just "-1" -scorefn :: Sum Int -> Sum Int -> Either String Double -scorefn ntotal ndinged = Right $ fis $ ntotal - ndinged +scorefn :: Sum Int -> () -> Sum Int -> Either String Double +scorefn ntotal () ndinged = Right $ fis $ ntotal - ndinged -sectyEqualWeighted :: (T.TokenParsing f) => f (SecCallback f) -sectyEqualWeighted = pure $ SC parseDing printDing scorefn (fromIntegral . getSum) +sectyEqualWeighted :: (T.TokenParsing f) => f (ExSecCallback f) +sectyEqualWeighted = pure $ ExSecCB (SC (Nothing, pure ()) parseDing printDing scorefn (fromIntegral . getSum)) diff --git a/lib/Grade/Score/SectionOnly.hs b/lib/Grade/Score/SectionOnly.hs new file mode 100644 index 0000000..5997825 --- /dev/null +++ b/lib/Grade/Score/SectionOnly.hs @@ -0,0 +1,21 @@ +module Grade.Score.SectionOnly (sectySectionOnly) where + +import qualified Text.Trifecta as T +import Grade.Types (ExSecCallback(..), SecCallback(..)) + +efid :: (T.TokenParsing f) => f Double +efid = (either fromIntegral id) <$> T.integerOrDouble + +parseDataScore :: (T.TokenParsing f) => f (Maybe Double) +parseDataScore = T.choice [ Just <$> efid, T.symbolic '!' *> pure Nothing ] + +sectySectionOnly_ :: (T.TokenParsing f) => f (SecCallback f () (Maybe Double) ()) +sectySectionOnly_ = (\smax -> SC (Just $ "", parseDataScore) + (T.unexpected "Section-only sections do not define dings") + (\_ _ _ -> Nothing) + (\_ d _ -> maybe (Left "No score given for a SectionOnly section!") Right d) + (\_ -> smax) + ) <$> efid + +sectySectionOnly :: (T.TokenParsing f) => f (ExSecCallback f) +sectySectionOnly = ExSecCB <$> sectySectionOnly_ diff --git a/lib/Grade/Score/Setting.hs b/lib/Grade/Score/Setting.hs index 69a8576..14742a8 100644 --- a/lib/Grade/Score/Setting.hs +++ b/lib/Grade/Score/Setting.hs @@ -5,7 +5,7 @@ module Grade.Score.Setting (sectySetting) where import Numeric import qualified Text.Trifecta as T -import Grade.Types (SecCallback(..)) +import Grade.Types (ExSecCallback(..), SecCallback(..)) data Setting a = SetTwice | Set Double | Earned a deriving (Show) @@ -33,19 +33,19 @@ parseSet ps pd = T.choice (\(a,b) -> (Earned a, b)) <$> pd ] -printSet :: (sds -> sdt -> Maybe String) - -> sds -> Setting sdt -> Maybe String -printSet po ss r = case r of - SetTwice -> error "Score.Setting was asked to print out impossible state" - Set v -> Just $ showFFloat (Just 1) v "Score set to " - Earned v -> po ss v - -scoreSet :: (sds -> sdt -> Either String Double) - -> sds -> Setting sdt -> Either String Double -scoreSet ug ss r = case r of - SetTwice -> Left "Multiple score-setting dings in section" - Set v -> Right v - Earned r' -> ug ss r' - -sectySetting :: (T.TokenParsing f) => f Double -> SecCallback f -> SecCallback f -sectySetting ps (SC up uo ug um) = SC (parseSet ps up) (printSet uo) (scoreSet ug) um +printSet :: (sds -> sat -> sdt -> Maybe String) + -> sds -> sat -> Setting sdt -> Maybe String +printSet po ss sa r = case r of + SetTwice -> error "Score.Setting was asked to print out impossible state" + Set v -> Just $ showFFloat (Just 1) v "Score set to " + Earned v -> po ss sa v + +scoreSet :: (sds -> sat -> sdt -> Either String Double) + -> sds -> sat -> Setting sdt -> Either String Double +scoreSet ug ss sa r = case r of + SetTwice -> Left "Multiple score-setting dings in section" + Set v -> Right v + Earned r' -> ug ss sa r' + +sectySetting :: (T.TokenParsing f) => f Double -> ExSecCallback f -> ExSecCallback f +sectySetting ps (ExSecCB (SC uh up uo ug um)) = ExSecCB (SC uh (parseSet ps up) (printSet uo) (scoreSet ug) um) diff --git a/lib/Grade/Score/Simple.hs b/lib/Grade/Score/Simple.hs index 723b06b..9116665 100644 --- a/lib/Grade/Score/Simple.hs +++ b/lib/Grade/Score/Simple.hs @@ -9,7 +9,7 @@ module Grade.Score.Simple (sectySimple) where import Numeric import qualified Text.Trifecta as T -import Grade.Types (SecCallback(..)) +import Grade.Types (ExSecCallback(..), SecCallback(..)) data Score = S Double Double deriving (Show) @@ -33,22 +33,26 @@ parseDingScore = (\x -> (x,())) <$> T.choice impact :: Double -> Score -> Double impact sm (S a r) = a + (sm * r) -printfn :: Double -> () -> Score -> Maybe String -printfn sm () s = Just $ case s of - (S 0.0 0.0) -> "0" - (S 0.0 r) -> (p (r*100)) ++ "% == " ++ si - (S _ 0.0) -> si - (S a r ) -> (p a) ++ " and " ++ (p r) ++ "% == " ++ si +printfn :: Double -> () -> () -> Score -> Maybe String +printfn sm () () s = Just $ case s of + (S 0.0 0.0) -> "0" + (S 0.0 r) -> (p (r*100)) ++ "% == " ++ si + (S _ 0.0) -> si + (S a r ) -> (p a) ++ " and " ++ (p r) ++ "% == " ++ si where si = p $ impact sm s p x = showFFloat (Just 1) x "" -scorefn :: Double -> () -> Score -> Either String Double -scorefn sm () s = Right $ sm + impact sm s +scorefn :: Double -> () -> () -> Score -> Either String Double +scorefn sm () () s = Right $ sm + impact sm s -sectySimple :: (T.TokenParsing f) => f (SecCallback f) -sectySimple = (\smax -> SC parseDingScore - (printfn smax) - (scorefn smax) - (\_ -> smax)) - <$> efid +sectySimple_ :: (T.TokenParsing f) => f (SecCallback f () () Score) +sectySimple_ = (\smax -> SC (Nothing, pure ()) + parseDingScore + (printfn smax) + (scorefn smax) + (\_ -> smax)) + <$> efid + +sectySimple :: (T.TokenParsing f) => f (ExSecCallback f) +sectySimple = ExSecCB <$> sectySimple_ diff --git a/lib/Grade/Score/Zeroing.hs b/lib/Grade/Score/Zeroing.hs index 8605df9..1688c65 100644 --- a/lib/Grade/Score/Zeroing.hs +++ b/lib/Grade/Score/Zeroing.hs @@ -2,7 +2,7 @@ module Grade.Score.Zeroing (zeroing) where import qualified Text.Trifecta as T -import Grade.Types (SecCallback(..)) +import Grade.Types (ExSecCallback(..), SecCallback(..)) data Zeroing a = Zeroed | Earned a deriving (Show) @@ -25,23 +25,24 @@ parseZeroed pz pd = T.choice (\(a,b) -> (Earned a, b)) <$> pd ] -printZeroed :: (sds -> sdt -> Maybe String) - -> sds -> Zeroing sdt -> Maybe String -printZeroed po ss r = case r of - Zeroed -> Just "Score set to 0" - Earned v -> po ss v +printZeroed :: (sds -> sat -> sdt -> Maybe String) + -> sds -> sat -> Zeroing sdt -> Maybe String +printZeroed po ss sa r = case r of + Zeroed -> Just "Score set to 0" + Earned v -> po ss sa v -scoreZeroed :: (sds -> sdt -> Either String Double) - -> sds -> Zeroing sdt -> Either String Double -scoreZeroed ug ss r = case r of - Zeroed -> Right 0.0 - Earned r' -> ug ss r' +scoreZeroed :: (sds -> sat -> sdt -> Either String Double) + -> sds -> sat -> Zeroing sdt -> Either String Double +scoreZeroed ug ss sa r = case r of + Zeroed -> Right 0.0 + Earned r' -> ug ss sa r' -zeroing :: (T.TokenParsing f) => f () -> SecCallback f -> SecCallback f +zeroing :: (T.TokenParsing f) => f () -> ExSecCallback f -> ExSecCallback f zeroing pz shp = case shp of - SC up uo ug um -> - SC (parseZeroed pz up) - (printZeroed uo) - (scoreZeroed ug) - um + ExSecCB (SC us up uo ug um) -> + ExSecCB (SC us + (parseZeroed pz up) + (printZeroed uo) + (scoreZeroed ug) + um) diff --git a/lib/Grade/Skeleton.hs b/lib/Grade/Skeleton.hs index 66fc4d9..5e8608e 100644 --- a/lib/Grade/Skeleton.hs +++ b/lib/Grade/Skeleton.hs @@ -19,16 +19,16 @@ interpSectionComments f0 = vcat . go f0 go False (b:bs) = pretty b : go False bs go True (_:bs) = go True bs -makeSkel :: Defines loc -> Doc e +makeSkel :: Defines f loc -> Doc e makeSkel (Defs _ sl) = vcat $ punctuate line $ flip fmap sl - $ \(sn, ExSec (Sec _ _ shidden scl sdm)) -> + $ \(sn, ExSec (Sec _ _ shidden scl sdm msh)) -> let scl' = interpSectionComments shidden scl in if shidden then scl' else scl' - `above` "@" <> pretty (unSN sn) + `above` "@" <> pretty (unSN sn) <> maybe empty ((empty <+>) . pretty) (fst msh) `above` prettyDingMap sdm (vcat [empty, commentStart, empty, commentEnd]) where diff --git a/lib/Grade/Types.hs b/lib/Grade/Types.hs index 8354d61..57b3a2c 100644 --- a/lib/Grade/Types.hs +++ b/lib/Grade/Types.hs @@ -45,7 +45,7 @@ data DingDefn mt loc = DingDefn deriving (Eq,Ord,{-Show-}Typeable) $(LTH.makeLenses ''DingDefn) -data SecMeta sdt = SecMeta +data SecMeta sat sdt = SecMeta { -- | Title of the section as displayed to the user, not -- necessarily the internal name _sm_title :: Text @@ -53,10 +53,10 @@ data SecMeta sdt = SecMeta _sm_max :: Double , -- | Given a reduced sdsdum, format the score for presentation -- or indicate that there has been an error. - _sm_scorefn :: sdt -> Either String Double + _sm_scorefn :: sat -> sdt -> Either String Double , -- | Provide text for printing out the impact of a particular -- score adjustment. - _sm_dingprinter :: sdt -> Maybe String + _sm_dingprinter :: sat -> sdt -> Maybe String } $(LTH.makeLenses ''SecMeta) @@ -67,12 +67,13 @@ $(LTH.makeLenses ''SecMeta) -- -- It also conains a section scoring function, which -- reduces dingmods to a score. -data Section sdt loc = Sec - { _sec_meta :: SecMeta sdt +data Section f sat sdt loc = Sec + { _sec_meta :: SecMeta sat sdt , _sec_loc :: loc , _sec_hidden :: Bool , _sec_comment_lines :: [Text] , _sec_dings :: Map DingName (DingDefn sdt loc) + , _sec_datline_parse :: (Maybe String, f sat) } deriving (Typeable) $(LTH.makeLenses ''Section) @@ -89,7 +90,7 @@ instance (Show sdt, Show loc) => Show (Section sdt loc) where -} -- | Existentially quantify the section data type for a given section -data ExSection loc = forall sdt . ({-Show sdt,-} Monoid sdt) => ExSec (Section sdt loc) +data ExSection f loc = forall sat sdt . ({-Show sdt,-} Monoid sdt) => ExSec (Section f sat sdt loc) {- instance (Show loc) => Show (ExSection loc) where @@ -97,20 +98,29 @@ instance (Show loc) => Show (ExSection loc) where -} -- | A Section Callback object, as returned by a section type parser -data SecCallback f = forall sps sdt . ({-Show sdt,-} Monoid sdt, Monoid sps) => SC - { -- | Parse section-specific ding weights +data SecCallback f sps sat sdt = SC + { -- | Section header parser for data file. This allows one to + -- have sections whose score is influenced by the @-line in the + -- *data* file. + -- + -- The String is for use by the skeleton generator. + sc_datline_parse :: (Maybe String, f sat) + , -- | Parse section-specific ding weights sc_ding_parse :: f (sdt,sps) , -- | Optional printout of the sdt data, given -- the section's final sps. - sc_show_sdt :: sps -> sdt -> Maybe String + sc_show_sdt :: sps -> sat -> sdt -> Maybe String , -- | Scoring function, given section maximum -- value and the monoidal summary of section-specific dings - sc_score :: sps -> sdt -> Either String Double + sc_score :: sps -> sat -> sdt -> Either String Double , -- | Maximum scoring function sc_max :: sps -> Double } deriving (Typeable) +data ExSecCallback f = forall sps sat sdt . ({-Show sdt,-} Monoid sdt, Monoid sps) + => ExSecCB (SecCallback f sps sat sdt) + newtype SecName = SN { unSN :: Text } deriving (Eq,Ord,Show,Typeable) @@ -119,9 +129,9 @@ newtype SecName = SN { unSN :: Text } -- -- The same collection is indexed by name and presented in order. -- -data Defines loc = Defs - { _def_section_by_name :: Map SecName (ExSection loc) - , _def_sections :: [(SecName, ExSection loc)] +data Defines f loc = Defs + { _def_section_by_name :: Map SecName (ExSection f loc) + , _def_sections :: [(SecName, ExSection f loc)] } deriving ({-Show,-} Typeable) $(LTH.makeLenses ''Defines) @@ -136,8 +146,9 @@ data DataFileDing mt loc = DFD } $(LTH.makeLenses ''DataFileDing) -data DataFileSection sdt loc = DFS - { _dfs_meta :: SecMeta sdt +data DataFileSection sat sdt loc = DFS + { _dfs_meta :: SecMeta sat sdt + , _dfs_sec_arg :: sat , _dfs_loc :: loc , _dfs_dings :: [DataFileDing sdt loc] , _dfs_grader_comments :: Maybe Text @@ -145,7 +156,7 @@ data DataFileSection sdt loc = DFS deriving (Typeable) $(LTH.makeLenses ''DataFileSection) -data ExDFS loc = forall sdt . Monoid sdt => ExDFS (DataFileSection sdt loc) +data ExDFS loc = forall sat sdt . Monoid sdt => ExDFS (DataFileSection sat sdt loc) -- | A report for a student, as produced by a TA newtype DataFile loc = DF [(SecName, ExDFS loc)] diff --git a/prog/Grade.hs b/prog/Grade.hs index 7eb7f40..33fa5a6 100644 --- a/prog/Grade.hs +++ b/prog/Grade.hs @@ -24,7 +24,7 @@ import qualified Grade.Score.Bounding as GSB import qualified Grade.Score.Zeroing as GSZ import Grade.Types -sectys :: T.TokenParsing m => m (SecCallback m) +sectys :: T.TokenParsing m => m (ExSecCallback m) sectys = T.choice [ -- A shortcut T.symbolic '0' *> (GSZ.zeroing zs <$> GSB.bounding GSB.Both <$> GSS.sectySimple)