{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
module Reporting.Error.Pattern
  ( P.Error(..)
  , toReport
  )
  where

import qualified Data.List as List

import qualified Nitpick.PatternMatches as P
import Reporting.Doc ((<>))
import qualified Reporting.Doc as D
import qualified Reporting.Report as Report
import qualified Reporting.Render.Code as Code



-- TO REPORT


toReport :: Code.Source -> P.Error -> Report.Report
toReport source err =
  case err of
    P.Redundant caseRegion patternRegion index ->
      Report.Report "REDUNDANT PATTERN" patternRegion [] $
        Report.toCodeSnippet source caseRegion (Just patternRegion)
          (
            D.reflow $
              "The " <> D.intToOrdinal index <> " pattern is redundant:"
          ,
            D.reflow $
              "Any value with this shape will be handled by a previous\
              \ pattern, so it should be removed."
          )

    P.Incomplete region context unhandled ->
      case context of
        P.BadArg ->
          Report.Report "UNSAFE PATTERN" region [] $
            Report.toCodeSnippet source region Nothing
              (
                "This pattern does not cover all possiblities:"
              ,
                D.stack
                  [ "Other possibilities include:"
                  , unhandledPatternsToDocBlock unhandled
                  , D.reflow $
                      "I would have to crash if I saw one of those! So rather than\
                      \ pattern matching in function arguments, put a `case` in\
                      \ the function body to account for all possibilities."
                  ]
              )

        P.BadDestruct ->
          Report.Report "UNSAFE PATTERN" region [] $
            Report.toCodeSnippet source region Nothing
              (
                "This pattern does not cover all possible values:"
              ,
                D.stack
                  [ "Other possibilities include:"
                  , unhandledPatternsToDocBlock unhandled
                  , D.reflow $
                      "I would have to crash if I saw one of those! You can use\
                      \ `let` to deconstruct values only if there is ONE possiblity.\
                      \ Switch to a `case` expression to account for all possibilities."
                  , D.toSimpleHint $
                      "Are you calling a function that definitely returns values\
                      \ with a very specific shape? Try making the return type of\
                      \ that function more specific!"
                  ]
              )

        P.BadCase ->
          Report.Report "MISSING PATTERNS" region [] $
            Report.toCodeSnippet source region Nothing
              (
                "This `case` does not have branches for all possibilities:"
              ,
                D.stack
                  [ "Missing possibilities include:"
                  , unhandledPatternsToDocBlock unhandled
                  , D.reflow $
                      "I would have to crash if I saw one of those. Add branches for them!"
                  , D.link "Hint"
                      "If you want to write the code for each branch later, use `Debug.todo` as a placeholder. Read"
                      "missing-patterns"
                      "for more guidance on this workflow."
                  ]
              )



-- PATTERN TO DOC


unhandledPatternsToDocBlock :: [P.Pattern] -> D.Doc
unhandledPatternsToDocBlock unhandledPatterns =
  D.indent 4 $ D.dullyellow $ D.vcat $
    map (patternToDoc Unambiguous) unhandledPatterns


data Context
  = Arg
  | Head
  | Unambiguous
  deriving (Eq)


patternToDoc :: Context -> P.Pattern -> D.Doc
patternToDoc context pattern =
  case delist pattern [] of
    NonList P.Anything ->
      "_"

    NonList (P.Literal literal) ->
      case literal of
        P.Chr chr ->
          "'" <> D.fromUtf8 chr <> "'"

        P.Str str ->
          "\"" <> D.fromUtf8 str <> "\""

        P.Int int ->
          D.fromInt int

    NonList (P.Ctor _ "#0" []) ->
      "()"

    NonList (P.Ctor _ "#2" [a,b]) ->
      "( " <> patternToDoc Unambiguous a <>
      ", " <> patternToDoc Unambiguous b <>
      " )"

    NonList (P.Ctor _ "#3" [a,b,c]) ->
      "( " <> patternToDoc Unambiguous a <>
      ", " <> patternToDoc Unambiguous b <>
      ", " <> patternToDoc Unambiguous c <>
      " )"

    NonList (P.Ctor _ name args) ->
      let
        ctorDoc =
          D.hsep (D.fromName name : map (patternToDoc Arg) args)
      in
      if context == Arg && length args > 0 then
        "(" <> ctorDoc <> ")"
      else
        ctorDoc

    FiniteList [] ->
      "[]"

    FiniteList entries ->
      let entryDocs = map (patternToDoc Unambiguous) entries in
      "[" <> D.hcat (List.intersperse "," entryDocs) <> "]"

    Conses conses finalPattern ->
      let
        consDoc =
          foldr
            (\hd tl -> patternToDoc Head hd <> " :: " <> tl)
            (patternToDoc Unambiguous finalPattern)
            conses
      in
      if context == Unambiguous then
        consDoc
      else
        "(" <> consDoc <> ")"


data Structure
  = FiniteList [P.Pattern]
  | Conses [P.Pattern] P.Pattern
  | NonList P.Pattern


delist :: P.Pattern -> [P.Pattern] -> Structure
delist pattern revEntries =
  case pattern of
    P.Ctor _ "[]" [] ->
      FiniteList revEntries

    P.Ctor _ "::" [hd,tl] ->
      delist tl (hd:revEntries)

    _ ->
      case revEntries of
        [] ->
          NonList pattern

        _ ->
          Conses (reverse revEntries) pattern