From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Sun, 25 Sep 2016 02:56:13 +0000 (-0400)
Subject: Modernize trifecta
X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=13fac220c29a24b4c17fdb0a9f1b3b63cb3d6c00;p=grade

Modernize trifecta
---

diff --git a/grade.cabal b/grade.cabal
index b62ba7a..7d9e33c 100644
--- a/grade.cabal
+++ b/grade.cabal
@@ -37,7 +37,7 @@ library
                        mtl >=2.2 && <3,
                        parsers >=0.12 && <1,
                        text >=1.2 && <2,
-                       trifecta >=1.5 && <2,
+                       trifecta >=1.6 && <1.7,
                        ansi-wl-pprint >= 0.6 && <1,
                        wl-pprint-extras >=3.5 && <4
 
@@ -50,7 +50,7 @@ executable grade
                        cmdlib >= 0.3 && <1,
                        directory >= 1.2 && <2,
                        filepath >= 1.4 && <2,
-                       trifecta >=1.5 && <2,
+                       trifecta >=1.6 && <1.7,
                        ansi-wl-pprint >= 0.6 && <1,
                        wl-pprint-extras >=3.5 && <4,
                        grade >=0.1
diff --git a/lib/Grade/GradeIO.hs b/lib/Grade/GradeIO.hs
index 6bb9b48..36ad57f 100644
--- a/lib/Grade/GradeIO.hs
+++ b/lib/Grade/GradeIO.hs
@@ -26,7 +26,7 @@ withDefines :: T.Parser (ExSecCallback T.Parser)
 withDefines sectys defi act = do
   mdefines <- T.parseFromFileEx (parseDefns sectys) defi
   case mdefines of
-    T.Failure f -> parseErr f
+    T.Failure f -> parseErr (T._errDoc f)
     T.Success defs -> Right <$> act defs
  where
   parseErr f = pure $ Left (        "Error while parsing defines" TPP.<+> TPP.pretty defi TPP.<> ":"
diff --git a/lib/Grade/Parse.hs b/lib/Grade/Parse.hs
index b00fcc4..9dd6eef 100644
--- a/lib/Grade/Parse.hs
+++ b/lib/Grade/Parse.hs
@@ -25,7 +25,7 @@ import           Data.Maybe (isJust)
 import qualified Text.Trifecta         as T
 import qualified Text.Trifecta.Delta   as T
 import qualified Text.Parser.LookAhead as T
--- import qualified Text.PrettyPrint.ANSI.Leijen as PP
+import qualified Text.PrettyPrint.ANSI.Leijen as PP
 
 import Grade.Types
 import Grade.ParseUtils
@@ -57,6 +57,7 @@ parseDingDefn dl = do
   (dcs, reuse) <- T.try ((,) <$> many (hashComment) <*> leadchar)
   dn T.:^ c <- T.careted (DN <$> word)
   (dm, ds) <- dl
+  -- XXX optional comment here?
   dt <- untilDotLine
   pure (dn, ds, DingDefn (DingMeta dm dt) c reuse dcs)
  where
@@ -98,8 +99,12 @@ parseSectionDefn fsdap = do
      (dn, ds, db) <- parseDingDefn fsdt
      case M.lookup dn m of
        Nothing -> go (s `mappend` ds) (M.insert dn db m) ((dn,db):l)
-       Just _ -> do
-         T.raiseErr (T.Err (Just "Duplicate ding definition") [] mempty)
+       Just d -> do
+		 -- XXX this causes an error to be printed out *after* the ding,
+		 -- typically at the beginning of the next line.  Argh.  It's also
+		 -- really ugly but more informative than it was.
+         T.raiseErr (T.Err (Just $ "Duplicate ding definition" PP.<+> (PP.pretty $ show $ unDN dn) PP.<+> "original at"
+                                   PP.<+> (PP.pretty $ show $ _dingd_loc d)) [] mempty [])
 
 -- | Parse a definitions file
 parseDefns :: (T.DeltaParsing f, T.MarkParsing T.Delta f, T.Errable f, T.LookAheadParsing f)
@@ -113,7 +118,7 @@ parseDefns sectys = T.whiteSpace *> go M.empty [] <* T.eof
        Nothing -> go (M.insert sn sb m) ((sn,sb):l)
        Just _  -> do
          T.release (T.delta $ case sb of ExSec s -> _sec_loc s)
-         T.raiseErr (T.Err (Just "Duplicate section definition") [] mempty)
+         T.raiseErr (T.Err (Just "Duplicate section definition") [] mempty [])
 
 ------------------------------------------------------------------------ }}}
 -- Data ---------------------------------------------------------------- {{{