From 7aeb998bf33ad7a90832d6e3f3ec5ee4bbdc0dd8 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 17 Jul 2018 15:48:14 -0400
Subject: [PATCH] Fix up Data.Error

---
 src/Data/Error.hs | 40 ++++++++++++++++++++++++----------------
 1 file changed, 24 insertions(+), 16 deletions(-)

diff --git a/src/Data/Error.hs b/src/Data/Error.hs
index 0a9cb9ca1..e25c34e43 100644
--- a/src/Data/Error.hs
+++ b/src/Data/Error.hs
@@ -1,31 +1,39 @@
 {-# LANGUAGE GADTs, ImplicitParams, RankNTypes, StandaloneDeriving #-}
-module Data.Error where
+module Data.Error
+  ( Error (..)
+  , formatError
+  , makeError
+  , showExpectation
+  , withCallStack
+  , withSGRCode
+  ) where
 
 import Prologue
-import Data.Blob
+
 import Data.ByteString (isSuffixOf)
 import Data.ByteString.Char8 (pack, unpack)
 import Data.Ix (inRange)
 import Data.List (intersperse)
-import Data.Source
-import Data.Span
 import System.Console.ANSI
 
+import Data.Blob
+import Data.Source
+import Data.Span
+
+-- | Rather than using the Error constructor directly, you probably
+-- want to call 'makeError', which takes care of inserting the call
+-- stack for you.
 data Error grammar = Error
-  { errorSpan :: Span
-  , errorExpected :: [grammar]
-  , errorActual :: Maybe grammar
+  { errorSpan      :: Span
+  , errorExpected  :: [grammar]
+  , errorActual    :: Maybe grammar
   , errorCallStack :: CallStack
-  } deriving (Typeable)
+  } deriving (Show, Functor, Typeable)
 
 -- | This instance does not take into account the call stack.
 instance Eq grammar => Eq (Error grammar) where
   (Error s e a _) == (Error s' e' a' _) = (s == s') && (e == e') && (a == a')
 
-deriving instance Foldable Error
-deriving instance Functor Error
-deriving instance Show grammar => Show (Error grammar)
-deriving instance Traversable Error
 instance Exception (Error String)
 
 makeError :: HasCallStack => Span -> [grammar] -> Maybe grammar -> Error grammar
@@ -70,11 +78,11 @@ showExpectation colourize = go
 
 showSymbols :: Colourize -> [String] -> ShowS
 showSymbols colourize = go
-  where go [] = showString "end of input nodes"
-        go [symbol] = showSymbol symbol
-        go [a, b] = showSymbol a . showString " or " . showSymbol b
+  where go []        = showString "end of input nodes"
+        go [symbol]  = showSymbol symbol
+        go [a, b]    = showSymbol a . showString " or " . showSymbol b
         go [a, b, c] = showSymbol a . showString ", " . showSymbol b . showString ", or " . showSymbol c
-        go (h:t) = showSymbol h . showString ", " . go t
+        go (h:t)     = showSymbol h . showString ", " . go t
         showSymbol = withSGRCode colourize [SetColor Foreground Vivid Red] . showString
 
 showSpan :: Maybe FilePath -> Span -> ShowS