errata-0.1.0.0: example/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module Main where

import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import           Errata

-------------------------------------------------------------
-- Definitions from the Haddock example for 'prettyErrors' --
-------------------------------------------------------------

data ParseError = ParseError
    { peFile       :: FilePath
    , peLine       :: Int
    , peCol        :: Int
    , peUnexpected :: T.Text
    , peExpected   :: [T.Text]
    }

toErrata :: ParseError -> Errata
toErrata (ParseError fp l c unexpected expected) =
    errataSimple
        (Just "error: invalid syntax")
        (blockSimple basicStyle fp l (c, c + T.length unexpected) Nothing
            (Just $ "unexpected " <> unexpected <> "\nexpected " <> T.intercalate ", " expected))
        Nothing

printErrors :: T.Text -> [ParseError] -> IO ()
printErrors source es = TL.putStrLn $ prettyErrors source (toErrata <$> es)

--------------
-- Examples --
--------------

-- An ad-hoc errata.
adhoc :: [Pointer] -> Errata
adhoc ps = errataSimple (Just "an error") (Block fancyRedStyle ("here", 1, 1) ps (Just "pbody")) Nothing

main :: IO ()
main = do
    putStrLn "Simple single pointer:"
    putStrLn ""
    TL.putStrLn $ prettyErrors @String
        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"
        [ adhoc [Pointer 1 2 4 False (Just "x")]
        ]
    putStrLn ""

    putStrLn "Nothing is connected, some inner labels:"
    putStrLn ""
    TL.putStrLn $ prettyErrors @String
        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"
        [ adhoc
            [ Pointer 1 2 4 False (Just "x")
            , Pointer 1 6 8 False (Just "y")
            , Pointer 1 10 12 False (Just "z")
            , Pointer 2 5 8 False (Just "w")
            ]
        ]
    putStrLn ""

    putStrLn "Everything is connected."
    putStrLn ""
    TL.putStrLn $ prettyErrors @String
        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"
        [ adhoc
            [ Pointer 1 2 4 True (Just "x")
            , Pointer 1 6 8 True (Just "y")
            , Pointer 1 10 12 True (Just "z")
            , Pointer 2 5 8 True (Just "w")
            ]
        ]
    putStrLn ""

    putStrLn "Only one line is connected, and one of them is skewered through:"
    putStrLn ""
    TL.putStrLn $ prettyErrors @String
        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"
        [ adhoc
            [ Pointer 1 2 4 True (Just "x")
            , Pointer 1 6 8 False (Just "y")
            , Pointer 1 10 12 True (Just "z")
            , Pointer 2 5 8 False (Just "w")
            ]
        ]
    putStrLn ""

    putStrLn "Everything is connected except for 2. One of them does not have a label:"
    putStrLn ""
    TL.putStrLn $ prettyErrors @String
        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"
        [ adhoc
            [ Pointer 1 2 4 True (Just "x")
            , Pointer 1 6 8 True Nothing
            , Pointer 1 10 12 False (Just "z")
            , Pointer 2 5 8 False (Just "w")
            , Pointer 3 1 3 True (Just "v")
            ]
        ]
    putStrLn ""

    putStrLn "Example from the Haddock example for `prettyErrors`:"
    putStrLn ""
    printErrors
        "{\n    \"bad\": [1, 2,]\n    }"
        (pure (ParseError "./comma.json" 2 18 "]" ["null", "true", "false", "\"", "-", "digit", "[", "{"]))
    putStrLn ""

    putStrLn "Example from the readme:"
    putStrLn ""
    TL.putStrLn $ prettyErrors @String
        "foo = if 1 > 2\n    then 100\n    else \"uh oh\""
        [ Errata
            (Just "\x1b[31merror[E001]: mismatching types in `if` expression\x1b[0m")
            (Block
                fancyRedStyle
                ("file.hs", 3, 10)
                [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m")
                , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m")
                ]
                Nothing)
            [ Block
                fancyYellowStyle
                ("file.hs", 1, 7)
                [ Pointer 1 7 9 True Nothing
                , Pointer 2 5 9 True Nothing
                , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m")
                ]
                Nothing
            ]
            (Just "\x1b[33mnote: use --explain E001 to learn more\x1b[0m")
        ]
    putStrLn ""