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.
:misc_ding
# But uncommenting this would give an error!
-# :simple_test
+#:simple_test
$BEGIN_COMMENTS
More grader comments in a different section
# 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
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.
Grade.Score.Zeroing,
Grade.Score.Setting,
Grade.Score.Bounding,
+ Grade.Score.SectionOnly,
Grade.Score.Simple,
Grade.Score.EqualWeighted,
Grade.Score.EqualWeightedCounting,
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
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
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 '@')
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
-- | 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))
-- | 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
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
-- | 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)
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
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_
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)
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))
--- /dev/null
+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 $ "<score out of " ++ show smax ++ ">", 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_
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)
(\(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)
import Numeric
import qualified Text.Trifecta as T
-import Grade.Types (SecCallback(..))
+import Grade.Types (ExSecCallback(..), SecCallback(..))
data Score = S Double Double
deriving (Show)
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_
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)
(\(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)
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
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
_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)
--
-- 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)
-}
-- | 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
-}
-- | 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)
--
-- 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)
}
$(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
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)]
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)
projects / grade / commitdiff