From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Mon, 21 Sep 2015 19:01:53 +0000 (-0400)
Subject: Print dings in order in the defines
X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=2e221f9a1f2ab273505908faae524c73ddb50ccf;p=grade

Print dings in order in the defines

Rather than in sorted order by key.
---

diff --git a/lib/Grade/Parse.hs b/lib/Grade/Parse.hs
index 56c153b..b00fcc4 100644
--- a/lib/Grade/Parse.hs
+++ b/lib/Grade/Parse.hs
@@ -79,19 +79,25 @@ parseSectionDefn fsdap = do
   _       <- T.whiteSpace
   case esdp of
     ExSecCB (SC mfss fsdt sdpo sfn smaxfn) -> do
-      (sstate, sdings) <- getDings fsdt M.empty
+      (sstate, sdingsm, revsdings) <- getDings fsdt M.empty []
       _ <- T.whiteSpace
       return (sname, ExSec $
-               Sec (SecMeta stitle (smaxfn sstate) (sfn sstate) (sdpo sstate)) c shidden scs sdings mfss)
+               Sec (SecMeta stitle (smaxfn sstate) (sfn sstate) (sdpo sstate))
+                   c
+                   shidden
+                   scs
+                   sdingsm
+                   (reverse revsdings)
+                   mfss)
  where
   getDings fsdt = go mempty
    where
-    go s m = nextDing s m <|> return (s,m)
+    go s m l = nextDing s m l <|> return (s,m,l)
 
-    nextDing s m = do
+    nextDing s m l = do
      (dn, ds, db) <- parseDingDefn fsdt
      case M.lookup dn m of
-       Nothing -> go (s `mappend` ds) (M.insert dn db m)
+       Nothing -> go (s `mappend` ds) (M.insert dn db m) ((dn,db):l)
        Just _ -> do
          T.raiseErr (T.Err (Just "Duplicate ding definition") [] mempty)
 
@@ -131,7 +137,7 @@ parseData defs = do
     another already = do
       (sn,esb) T.:^ sc <- get >>= \sm -> sectionDirective sm
       case esb of
-        ExSec (Sec smeta _ _ _ sdm (_,fsat)) -> do
+        ExSec (Sec smeta _ _ _ sdm _ (_,fsat)) -> do
           sat <- lift fsat
           ds  <- sectionDings sdm
           mcs <- T.optional $
diff --git a/lib/Grade/Skeleton.hs b/lib/Grade/Skeleton.hs
index 5e8608e..1fd7970 100644
--- a/lib/Grade/Skeleton.hs
+++ b/lib/Grade/Skeleton.hs
@@ -23,17 +23,16 @@ makeSkel :: Defines f loc -> Doc e
 makeSkel (Defs _ sl) =
   vcat $ punctuate line
   $ flip fmap sl
-  $ \(sn, ExSec (Sec _ _ shidden scl sdm msh)) ->
+  $ \(sn, ExSec (Sec _ _ shidden scl _ sds msh)) ->
     let scl' = interpSectionComments shidden scl in
     if shidden
      then scl'
      else scl'
           `above` "@" <> pretty (unSN sn) <> maybe empty ((empty <+>) . pretty) (fst msh)
-          `above` prettyDingMap sdm (vcat [empty, commentStart, empty, commentEnd])
+          `above` prettyDings sds (vcat [empty, commentStart, empty, commentEnd])
 
  where
-  prettyDingMap dm = if M.null dm
-                      then id
-                      else (indent 1 (vcat $ map prettyDing (M.toList dm)) `above`)
+  prettyDings [] = id
+  prettyDings ds = (indent 1 (vcat $ map prettyDing ds) `above`)
 
   prettyDing (dn, _) = "#:" <> pretty (unDN dn)
diff --git a/lib/Grade/Types.hs b/lib/Grade/Types.hs
index 8addb14..61c4002 100644
--- a/lib/Grade/Types.hs
+++ b/lib/Grade/Types.hs
@@ -72,7 +72,8 @@ data Section f sat sdt loc = Sec
   , _sec_loc           :: loc
   , _sec_hidden        :: Bool
   , _sec_comment_lines :: [Text]
-  , _sec_dings         :: Map DingName (DingDefn sdt loc)
+  , _sec_ding_by_name  :: Map DingName (DingDefn sdt loc)
+  , _sec_dings         :: [(DingName, DingDefn sdt loc)]
   , _sec_datline_parse :: (Maybe String, f sat)
   }
  deriving (Typeable)