New String function: parseErrorHuman

Author: jamesdbrock

src/Parsing.purs

@@ -50,9 +50,11 @@ import Data.Tuple (Tuple(..), fst)
 -- | the position in the input stream at which the error occurred.
 data ParseError = ParseError String Position
 
+-- | Get the `Message` from a `ParseError`
 parseErrorMessage :: ParseError -> String
 parseErrorMessage (ParseError msg _) = msg
 
+-- | Get the `Position` from a `ParseError`.
 parseErrorPosition :: ParseError -> Position
 parseErrorPosition (ParseError _ pos) = pos
 

src/Parsing/String.purs

@@ -1,4 +1,5 @@
--- | Primitive parsers for working with an input stream of type `String`.
+-- | Primitive parsers and functions for working with an input stream of
+-- | type `String`.
 -- |
 -- | All of these primitive parsers will consume when they succeed.
 -- |
@@ -47,15 +48,18 @@ module Parsing.String
   , regex
   , anyTill
   , consumeWith
+  , parseErrorHuman
   ) where
 
 import Prelude hiding (between)
 
 import Control.Monad.Rec.Class (Step(..), tailRecM)
+import Data.Array (replicate)
 import Data.Array.NonEmpty as NonEmptyArray
 import Data.Either (Either(..))
 import Data.Enum (fromEnum, toEnum)
 import Data.Function.Uncurried (mkFn5, runFn2)
+import Data.Int (odd)
 import Data.Maybe (Maybe(..), fromJust)
 import Data.String (CodePoint, Pattern(..), codePointAt, length, null, splitAt, stripPrefix, uncons)
 import Data.String as String
@@ -339,4 +343,48 @@ anyTill p = do
     ( do
         _ <- anyCodePoint
         pure $ Loop unit
-    )
+    )
+
+-- | Returns three `String`s which, when printed line-by-line, will show
+-- | a nice human-readable parsing error message.
+-- |
+-- | The first argument is the input `String` given to the parser which
+-- | errored.
+-- |
+-- | The second argument is a positive `Int` which indicates how many
+-- | characters of input `String` context are wanted around the parsing error.
+-- |
+-- | The third argument is the `ParseError` for the input `String`.
+-- |
+-- | #### Example
+-- |
+-- | ```
+-- | let input = "12345six789"
+-- | case runParser input (replicateA 9 String.Basic.digit) of
+-- |   Left err -> log $ String.joinWith "\n" $ parseErrorHuman input 20 err
+-- | ```
+-- | ---
+-- | ```
+-- | Expected more phrases at position index:5 (line:1, column:6)
+-- |      ▼
+-- | 12345six789
+-- | ```
+parseErrorHuman :: String -> Int -> ParseError -> Array String
+parseErrorHuman input contextSize (ParseError msg (Position { line, column, index })) =
+  -- inspired by
+  -- https://github.com/elm/parser/blob/master/README.md#tracking-context
+  --
+  -- TODO
+  -- * constrain the context window to enclosing newlines
+  -- * grow the context window to contextSize if the error is at beginning or end of input
+  [ msg <> " at position index:" <> show index <> " (line:" <> show line <> ", column:" <> show column <> ")"
+  , (String.joinWith "" (replicate (index - minPosBefore) " ")) <> "▼"
+  , inputContext
+  ]
+  where
+  inputLength = String.length input
+  -- position minus half of context until the prior newline
+  minPosBefore = max 0 (index - (contextSize / 2) - if odd contextSize then 1 else 0)
+  -- position plus half of context until the following newline
+  maxPosAfter = min inputLength (index + (contextSize / 2))
+  inputContext = String.take (maxPosAfter - minPosBefore) (String.drop minPosBefore input)

test/Main.purs

@@ -23,6 +23,7 @@ import Data.NonEmpty ((:|))
 import Data.Number (infinity, nan)
 import Data.Number as Data.Number
 import Data.String (toUpper)
+import Data.String as String
 import Data.String.CodePoints as SCP
 import Data.String.CodeUnits (fromCharArray, singleton)
 import Data.String.CodeUnits as SCU
@@ -34,12 +35,13 @@ import Effect.Console (log, logShow)
 import Effect.Unsafe (unsafePerformEffect)
 import Node.Process (lookupEnv)
 import Parsing (ParseError(..), ParseState(..), Parser, ParserT, Position(..), consume, fail, getParserT, initialPos, parseErrorMessage, parseErrorPosition, position, region, runParser)
-import Parsing.Combinators (advance, between, chainl, chainl1, chainr, chainr1, choice, empty, endBy, endBy1, lookAhead, many, many1, many1Till, many1Till_, manyIndex, manyTill, manyTill_, notFollowedBy, optionMaybe, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipMany1, try, (<?>), (<??>), (<~?>))
+import Parsing.Combinators (advance, between, chainl, chainl1, chainr, chainr1, choice, empty, endBy, endBy1, lookAhead, many, many1, many1Till, many1Till_, manyIndex, manyTill, manyTill_, notFollowedBy, optionMaybe, replicateA, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipMany1, try, (<?>), (<??>), (<~?>))
 import Parsing.Combinators.Array as Combinators.Array
 import Parsing.Expr (Assoc(..), Operator(..), buildExprParser)
 import Parsing.Language (haskellDef, haskellStyle, javaStyle)
-import Parsing.String (anyChar, anyCodePoint, anyTill, char, eof, match, regex, rest, satisfy, string, takeN)
+import Parsing.String (anyChar, anyCodePoint, anyTill, char, eof, match, parseErrorHuman, regex, rest, satisfy, string, takeN)
 import Parsing.String.Basic (intDecimal, letter, noneOfCodePoints, number, oneOfCodePoints, skipSpaces, whiteSpace)
+import Parsing.String.Basic as String.Basic
 import Parsing.String.Replace (breakCap, replace, replaceT, splitCap, splitCapT)
 import Parsing.Token (TokenParser, makeTokenParser, token, when)
 import Parsing.Token as Token
@@ -1070,3 +1072,11 @@ main = do
     { actual: lmap parseErrorPosition $ runParser "aa" $ advance consume
     , expected: Left (Position { index: 0, line: 1, column: 1 })
     }
+
+  log "\nTESTS error messages\n"
+  do
+    let input = "12345six789"
+    -- case runParser input (manyIndex 9 9 \_ -> String.Basic.digit) of
+    case runParser input (replicateA 9 String.Basic.digit) of
+      Right (_ :: Array Char) -> pure unit
+      Left err -> log $ String.joinWith "\n" $ parseErrorHuman input 20 err