Experimenting with using Text.Trifecta to provide rich error messages

JWSParsing.hs

-- An experiment in providing more useful error messages
-- when you validate a token after parsing it,
-- as for checking that a string represents a valid filename
-- in https://github.com/idris-lang/Idris-dev/pull/2728 .
--
-- Author: Jeremy W. Sherman (@jeremy-w)
-- Date: 2015-10-16
-- License: MPL v2.0
--
-- This Source Code Form is subject to the terms of the Mozilla Public License,
-- v. 2.0. If a copy of the MPL was not distributed with this file, You can
-- obtain one at https://mozilla.org/MPL/2.0/.
module JWSParsing where

import Text.Trifecta
import Data.Text (pack)
import qualified Text.PrettyPrint.ANSI.Leijen as Doc
import qualified Data.Set
import qualified Control.Lens as Lens

expectedText = Data.Text.pack "hi"

-- How do we show a caret plus a tilde-underlined span?
underlineOnError input = parseString parser location input
    where
        location = mempty

        parser = do
            here <- position
            x <- do
                -- When this parse fails, it errors out, and nothing else runs.
                -- This means we get no chance to provide better error info
                -- from within the parser?
                t <- text $ expectedText
                return t
            there <- position
            -- If the parse above succeeds, this hardcodes the successful
            -- result to "derp".
            return "derp"


-- How do we rewind after doing some post-facto checks
-- so we point at the right place?
parseMagic input = parseString parser location input
    where
        location = mempty

        parser = do
            drawing <- rend
            here <- position
            t <- token $ integer <?> "magic number"
            there <- position
            if t == 42
            then return t
            else do
                let wasExpecting = Data.Set.fromList ["the magic number 42"]
                let basicErr = failed "should be 42"
                let footnoteErr = Lens.set expected wasExpecting $ basicErr

                let markedUpLine = addCaret here $ addSpan here there drawing
                let doc = explain markedUpLine footnoteErr

                let err = Err {
                  _reason = Nothing
                , _expected = Data.Set.fromList []
                , _footnotes = [doc]
                }
                raiseErr err

{-
What I really want is to clobber the default error message with my
own custom Err, not have my Err merged into it!

This is getting close. It shows my usful error message alongside the error
message emitted by default.

The expected field in the returned Err gets merged with the expected bit in
the first Err reported, so it's better to put our info in the footnote:

```
*JWSParsing Text.Trifecta Data.Set Control.Lens> parseMagic "434343434343"
Failure (interactive):1:13: error: expected: digit
434343434343<EOF>
            ^
(interactive):1:1: error: should
    be
    42, expected: the magic number 42
434343434343<EOF>
^~~~~~~~~~~~
*JWSParsing Text.Trifecta Data.Set Control.Lens>
```
-}