content: {-# LANGUAGE OverloadedStrings #-}
  
  module Reporting.Error.Json
    ( toReport,
      FailureToReport (..),
      Context (..),
      Reason (..),
    )
  where
  
  import Data.ByteString qualified as BS
  import Data.ByteString.UTF8 qualified as BS_UTF8
  import Data.NonEmptyList qualified as NE
  import Json.Decode (DecodeExpectation (..), Error (..), ParseError (..), Problem (..), StringProblem (..))
  import Reporting.Annotation qualified as A
  import Reporting.Doc qualified as D
  import Reporting.Exit.Help qualified as Help
  import Reporting.Render.Code qualified as Code
  
  -- TO REPORT
  
  toReport :: FilePath -> FailureToReport x -> Error x -> Reason -> Help.Report
  toReport path ftr err reason =
    case err of
      DecodeProblem bytes problem ->
        problemToReport path ftr (Code.toSource bytes) CRoot problem reason
      ParseProblem bytes parseError ->
        parseErrorToReport path (Code.toSource bytes) parseError reason
  
  newtype Reason
    = ExplicitReason String
  
  because :: Reason -> String -> String
  because (ExplicitReason iNeedThings) problem =
    iNeedThings ++ " " ++ problem
  
  -- PARSE ERROR TO REPORT
  
  parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Report
  parseErrorToReport path source parseError reason =
    let toSnippet title row col (problem, details) =
          let pos = A.Position row col
              surroundings = A.Region (A.Position (max 1 (row - 2)) 1) pos
              region = A.Region pos pos
           in Help.jsonReport title (Just path) $
                Code.toSnippet
                  source
                  surroundings
                  (Just region)
                  ( D.reflow (because reason problem),
                    details
                  )
     in case parseError of
          Start row col ->
            toSnippet
              "EXPECTING A VALUE"
              row
              col
              ( "I was expecting to see a JSON value next:",
                D.stack
                  [ D.fillSep
                      [ "Try",
                        "something",
                        "like",
                        D.dullyellow "\"this\"",
                        "or",
                        D.dullyellow "42",
                        "to",
                        "move",
                        "on",
                        "to",
                        "better",
                        "hints!"
                      ],
                    D.toSimpleNote $
                      "The JSON specification does not allow trailing commas, so you can sometimes\
                      \ get this error in arrays that have an extra comma at the end. In that case,\
                      \ remove that last comma or add another array entry after it!"
                  ]
              )
          ObjectField row col ->
            toSnippet
              "EXTRA COMMA"
              row
              col
              ( "I was partway through parsing a JSON object when I got stuck here:",
                D.stack
                  [ D.fillSep
                      [ "I",
                        "saw",
                        "a",
                        "comma",
                        "right",
                        "before",
                        "I",
                        "got",
                        "stuck",
                        "here,",
                        "so",
                        "I",
                        "was",
                        "expecting",
                        "to",
                        "see",
                        "a",
                        "field",
                        "name",
                        "like",
                        D.dullyellow "\"type\"",
                        "or",
                        D.dullyellow "\"dependencies\"",
                        "next."
                      ],
                    D.reflow $
                      "This error is commonly caused by trailing commas in JSON objects. Those are\
                      \ actually disallowed by <https://json.org> so check the previous line for a\
                      \ trailing comma that may need to be deleted.",
                    objectNote
                  ]
              )
          ObjectColon row col ->
            toSnippet
              "EXPECTING COLON"
              row
              col
              ( "I was partway through parsing a JSON object when I got stuck here:",
                D.stack
                  [ D.reflow $ "I was expecting to see a colon next.",
                    objectNote
                  ]
              )
          ObjectEnd row col ->
            toSnippet
              "UNFINISHED OBJECT"
              row
              col
              ( "I was partway through parsing a JSON object when I got stuck here:",
                D.stack
                  [ D.reflow $
                      "I was expecting to see a comma or a closing curly brace next.",
                    D.reflow $
                      "Is a comma missing on the previous line? Is an array missing a closing square\
                      \ bracket? It is often something tricky like that!",
                    objectNote
                  ]
              )
          ArrayEnd row col ->
            toSnippet
              "UNFINISHED ARRAY"
              row
              col
              ( "I was partway through parsing a JSON array when I got stuck here:",
                D.stack
                  [ D.reflow $ "I was expecting to see a comma or a closing square bracket next.",
                    D.reflow $
                      "Is a comma missing on the previous line? It is often something like that!"
                  ]
              )
          StringProblem stringProblem row col ->
            case stringProblem of
              BadStringEnd ->
                toSnippet
                  "ENDLESS STRING"
                  row
                  col
                  ( "I got to the end of the line without seeing the closing double quote:",
                    D.fillSep $
                      [ "Strings",
                        "look",
                        "like",
                        D.green "\"this\"",
                        "with",
                        "double",
                        "quotes",
                        "on",
                        "each",
                        "end.",
                        "Is",
                        "the",
                        "closing",
                        "double",
                        "quote",
                        "missing",
                        "in",
                        "your",
                        "code?"
                      ]
                  )
              BadStringControlChar ->
                toSnippet
                  "UNEXPECTED CONTROL CHARACTER"
                  row
                  col
                  ( "I ran into a control character unexpectedly:",
                    D.reflow $
                      "These are characters that represent tabs, backspaces, newlines, and\
                      \ a bunch of other invisible characters. They all come before 20 in the\
                      \ ASCII range, and they are disallowed by the JSON specificaiton. Maybe\
                      \ a copy/paste added one of these invisible characters to your JSON?"
                  )
              BadStringEscapeChar ->
                toSnippet
                  "UNKNOWN ESCAPE"
                  row
                  col
                  ( "Backslashes always start escaped characters, but I do not recognize this one:",
                    D.stack
                      [ D.reflow $
                          "Valid escape characters include:",
                        D.dullyellow $
                          D.indent 4 $
                            D.vcat $
                              ["\\\"", "\\\\", "\\/", "\\b", "\\f", "\\n", "\\r", "\\t", "\\u003D"],
                        D.reflow $
                          "Do you want one of those instead? Maybe you need \\\\ to escape a backslash?"
                      ]
                  )
              BadStringEscapeHex ->
                toSnippet
                  "BAD HEX ESCAPE"
                  row
                  col
                  ( "This is not a valid hex escape:",
                    D.fillSep $
                      [ "Valid",
                        "hex",
                        "escapes",
                        "in",
                        "JSON",
                        "are",
                        "between",
                        D.green "\\u0000",
                        "and",
                        D.green "\\uFFFF",
                        "and",
                        "always",
                        "have",
                        "exactly",
                        "four",
                        "digits."
                      ]
                  )
          NoLeadingZeros row col ->
            toSnippet
              "BAD NUMBER"
              row
              col
              ( "Numbers cannot start with zeros like this:",
                D.reflow $ "Try deleting the leading zeros?"
              )
          NoFloats row col ->
            toSnippet
              "UNEXPECTED NUMBER"
              row
              col
              ( "I got stuck while trying to parse this number:",
                D.reflow $
                  "I do not accept floating point numbers like 3.1415 right now. That kind\
                  \ of JSON value is not needed for any of the uses that Gren has for now."
              )
          BadEnd row col ->
            toSnippet
              "JSON PROBLEM"
              row
              col
              ( "I was partway through parsing some JSON when I got stuck here:",
                D.reflow $
                  "I am not really sure what is wrong. This sometimes means there is extra\
                  \ stuff after a valid JSON value?"
              )
  
  objectNote :: D.Doc
  objectNote =
    D.stack
      [ D.toSimpleNote $ "Here is an example of a valid JSON object for reference:",
        D.vcat
          [ D.indent 4 $ "{",
            D.indent 6 $ D.dullyellow "\"name\"" <> ": " <> D.dullyellow "\"Tom\"" <> ",",
            D.indent 6 $ D.dullyellow "\"age\"" <> ": " <> D.dullyellow "42",
            D.indent 4 $ "}"
          ],
        D.reflow $
          "Notice that (1) the field names are in double quotes and (2) there is no\
          \ trailing comma after the last entry. Both are strict requirements in JSON!"
      ]
  
  -- PROBLEM TO REPORT
  
  data Context
    = CRoot
    | CField BS.ByteString Context
    | CIndex Int Context
  
  problemToReport :: FilePath -> FailureToReport x -> Code.Source -> Context -> Problem x -> Reason -> Help.Report
  problemToReport path ftr source context problem reason =
    case problem of
      Field field prob ->
        problemToReport path ftr source (CField field context) prob reason
      Index index prob ->
        problemToReport path ftr source (CIndex index context) prob reason
      OneOf p ps ->
        -- NOTE: only displays the deepest problem. This works well for the kind
        -- of JSON used by Gren, but probably would not work well in general.
        let (NE.List prob _) = NE.sortBy (negate . getMaxDepth) (NE.List p ps)
         in problemToReport path ftr source context prob reason
      Failure region x ->
        _failureToReport ftr path source context region x
      Expecting region expectation ->
        expectationToReport path source context region expectation reason
  
  getMaxDepth :: Problem x -> Int
  getMaxDepth problem =
    case problem of
      Field _ prob -> 1 + getMaxDepth prob
      Index _ prob -> 1 + getMaxDepth prob
      OneOf p ps -> maximum (getMaxDepth p : map getMaxDepth ps)
      Failure _ _ -> 0
      Expecting _ _ -> 0
  
  newtype FailureToReport x = FailureToReport {_failureToReport :: FilePath -> Code.Source -> Context -> A.Region -> x -> Help.Report}
  
  expectationToReport :: FilePath -> Code.Source -> Context -> A.Region -> DecodeExpectation -> Reason -> Help.Report
  expectationToReport path source context (A.Region start end) expectation reason =
    let (A.Position sr _) = start
        (A.Position er _) = end
  
        region =
          if sr == er then region else A.Region start start
  
        introduction =
          case context of
            CRoot ->
              "I ran into some trouble here:"
            CField field _ ->
              "I ran into trouble with the value of the \"" ++ BS_UTF8.toString field ++ "\" field:"
            CIndex index (CField field _) ->
              "When looking at the \""
                ++ BS_UTF8.toString field
                ++ "\" field, I ran into trouble with the "
                ++ D.intToOrdinal index
                ++ " entry:"
            CIndex index _ ->
              "I ran into trouble with the " ++ D.intToOrdinal index ++ " index of this array:"
  
        toSnippet title aThing =
          Help.jsonReport title (Just path) $
            Code.toSnippet
              source
              region
              Nothing
              ( D.reflow (because reason introduction),
                D.fillSep $ ["I", "was", "expecting", "to", "run", "into"] ++ aThing
              )
     in case expectation of
          TObject ->
            toSnippet "EXPECTING OBJECT" ["an", D.green "OBJECT" <> "."]
          TArray ->
            toSnippet "EXPECTING ARRAY" ["an", D.green "ARRAY" <> "."]
          TString ->
            toSnippet "EXPECTING STRING" ["a", D.green "STRING" <> "."]
          TBool ->
            toSnippet "EXPECTING BOOL" ["a", D.green "BOOLEAN" <> "."]
          TInt ->
            toSnippet "EXPECTING INT" ["an", D.green "INT" <> "."]
          TObjectWith field ->
            toSnippet
              "MISSING FIELD"
              [ "an",
                D.green "OBJECT",
                "with",
                "a",
                D.green ("\"" <> D.fromChars (BS_UTF8.toString field) <> "\""),
                "field."
              ]
          TArrayPair len ->
            toSnippet
              "EXPECTING PAIR"
              [ "an",
                D.green "ARRAY",
                "with",
                D.green "TWO",
                "entries.",
                "This",
                "array",
                "has",
                D.fromInt len,
                if len == 1 then "element." else "elements."
              ]
  