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 56c153b7118c9b17561e9e587689e4a66d66072a..b00fcc4735813dd8f1d05dadb83dfc8e5565dd68 100644 (file)
--- 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 5e8608e699522e98c7a8814430990dd492baf6ae..1fd79700dd0c8c752e4871ec6b6260c1dcf566e0 100644 (file)
--- 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 8addb14444fcf8783d9cc10c71cb041a77f1580e..61c40028ee73ee6b5f5ccc9b1b64b6a647038178 100644 (file)
--- 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)