From 650f3b584c7d2367f688cca94704cf9647278140 Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Wed, 9 Sep 2015 23:40:18 -0400 Subject: [PATCH] Split out DingMeta too --- lib/Grade/Grade.hs | 12 ++++++------ lib/Grade/Parse.hs | 4 ++-- lib/Grade/Types.hs | 24 ++++++++++++++++-------- 3 files changed, 24 insertions(+), 16 deletions(-) diff --git a/lib/Grade/Grade.hs b/lib/Grade/Grade.hs index 1065a16..91f4b66 100644 --- a/lib/Grade/Grade.hs +++ b/lib/Grade/Grade.hs @@ -19,8 +19,8 @@ collectErrors x = case partitionEithers x of (l, _) -> Left l lookupSectionDings :: [(DingName, loc)] - -> M.Map DingName (Ding sdt loc') - -> Either [SectionError loc] [(Ding sdt loc', loc)] + -> M.Map DingName (DingDefn sdt loc') + -> Either [SectionError loc] [(DingDefn sdt loc', loc)] lookupSectionDings dns0 sm = collectErrors $ flip evalState M.empty $ mapM look dns0 where look (d,loc) = do @@ -30,7 +30,7 @@ lookupSectionDings dns0 sm = collectErrors $ flip evalState M.empty $ mapM look Nothing -> case M.lookup d sm of Nothing -> return $ Left $ SEUndefinedDing d loc Just dd -> do - when (not $ _ding_multiple dd) $ modify (M.insert d loc) + when (not $ _dingd_multiple dd) $ modify (M.insert d loc) return $ Right (dd,loc) dingsToScore :: ExSection loc' @@ -43,15 +43,15 @@ dingsToScore es dns = (\(sc, ds) -> Right (stitle, sc, smax, map dopo ds))) $ bimap id (reduce . map fst) $ lookupSectionDings dns sdm where - reduce ds = (\x -> (x,ds)) <$> (sfn $ mconcat $ map _ding_mod ds) + reduce ds = (\x -> (x,ds)) <$> (sfn $ mconcat $ map (_dm_mod . _dingd_meta) ds) - dopo d = T.unlines $ addMod $ pure $ _ding_text d + dopo d = T.unlines $ addMod $ pure $ (_dm_text . _dingd_meta) d where addMod = if smax == 0.0 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 - (spo (_ding_mod d)) + (spo (_dm_mod $ _dingd_meta d)) processDFS :: Defines loc' -> DataFileSection loc diff --git a/lib/Grade/Parse.hs b/lib/Grade/Parse.hs index 6fa074a..21fc8f9 100644 --- a/lib/Grade/Parse.hs +++ b/lib/Grade/Parse.hs @@ -60,13 +60,13 @@ untilDotLine = toUtf8 (T.sliced (T.manyTill T.anyChar (T.try $ T.lookAhead end)) -- any number of "# comment" lines and followed by the ding text, terminated -- by a dot line. parseDingDefn :: (T.DeltaParsing f, T.LookAheadParsing f) - => f (sdt,sds) -> f (DingName, sds, Ding sdt T.Caret) + => f (sdt,sds) -> f (DingName, sds, DingDefn sdt T.Caret) parseDingDefn dl = do (dcs, reuse) <- T.try ((,) <$> many (hashComment) <*> leadchar) dn T.:^ c <- T.careted (DN <$> word) (dm, ds) <- dl dt <- untilDotLine - pure (dn, ds, Ding dm c reuse dt dcs) + pure (dn, ds, DingDefn (DingMeta dm dt) c reuse dcs) where leadchar = T.choice [ T.char ':' *> pure False , T.char ';' *> pure True diff --git a/lib/Grade/Types.hs b/lib/Grade/Types.hs index f711eef..958afdd 100644 --- a/lib/Grade/Types.hs +++ b/lib/Grade/Types.hs @@ -18,6 +18,15 @@ import Data.Typeable (Typeable) newtype DingName = DN { unDN :: Text } deriving (Eq,Ord,Show,Typeable) +-- | Things common to dings between their definition and +-- their use +data DingMeta mt = DingMeta + { _dm_mod :: mt + , _dm_text :: Text + } + deriving(Eq,Ord,Typeable) +$(LTH.makeLenses ''DingMeta) + -- | A point deduction definition -- -- A Ding is parameterized by some modifier for its section. @@ -27,15 +36,14 @@ newtype DingName = DN { unDN :: Text } -- Each Ding is associated with a location (parameterized to avoid -- dependency on any particular parsing framework) -- -data Ding mt loc = Ding - { _ding_mod :: mt - , _ding_loc :: loc - , _ding_multiple :: Bool - , _ding_text :: Text - , _ding_comment_lines :: [Text] +data DingDefn mt loc = DingDefn + { _dingd_meta :: DingMeta mt + , _dingd_loc :: loc + , _dingd_multiple :: Bool + , _dingd_comment_lines :: [Text] } deriving (Eq,Ord,{-Show-}Typeable) -$(LTH.makeLenses ''Ding) +$(LTH.makeLenses ''DingDefn) data SecMeta sdt = SecMeta { -- | Title of the section as displayed to the user, not @@ -63,7 +71,7 @@ data Section sdt loc = Sec { _sec_meta :: SecMeta sdt , _sec_hidden :: Bool , _sec_comment_lines :: [Text] - , _sec_dings :: Map DingName (Ding sdt loc) + , _sec_dings :: Map DingName (DingDefn sdt loc) } deriving (Typeable) $(LTH.makeLenses ''Section) -- 2.50.1