]> hydra-www.ietfng.org Git - grade/commitdiff
Modernize trifecta
authorNathaniel Wesley Filardo <nwf@cs.jhu.edu>
Sun, 25 Sep 2016 02:56:13 +0000 (22:56 -0400)
committerNathaniel Wesley Filardo <nwf@cs.jhu.edu>
Sun, 25 Sep 2016 03:15:32 +0000 (23:15 -0400)
grade.cabal
lib/Grade/GradeIO.hs
lib/Grade/Parse.hs

index b62ba7a50b0a75e78e1ca83a72c22bcac126a6e1..7d9e33cd6180cdb2645bd1904b62aed74148ae3f 100644 (file)
@@ -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
index 6bb9b48bfb042ca8277badd5ffe50c5a2654fe7d..36ad57f37d1ecc27e4b94d5214e29cd0e7829ac3 100644 (file)
@@ -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.<> ":"
index b00fcc4735813dd8f1d05dadb83dfc8e5565dd68..9dd6eefa75cec9bbc3b9c4e9e928ced5edc0a695 100644 (file)
@@ -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 ---------------------------------------------------------------- {{{