{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

-- | Format Angle errors to dispay in the terminal
module Glean.Shell.Error
  ( Ann
  , BadQuery(..)
  , prettyBadQuery
  ) where

import Control.Exception
import Control.Applicative ((<|>))
import Text.Read (readMaybe)
import Data.Maybe (isJust)
import Data.Text (Text)
import Compat.Prettyprinter as Pretty hiding ((<>), pageWidth)

import qualified Data.Text as Text
import qualified Prettyprinter.Render.Terminal as Pretty
import qualified Text.Parsec as Parsec

import Glean.Angle.Types

type Ann = Pretty.AnsiStyle

data BadQuery = BadQuery { angleSource :: Text, angleError :: Text }
  deriving Show

instance Exception BadQuery

prettyBadQuery :: BadQuery -> Doc Ann
prettyBadQuery (BadQuery source rawErr) =
    case parseSrcSpan rawErr of
      Nothing -> pretty rawErr
      Just (span, err) -> prettyErrorAt span source err

parseSrcSpan :: Text -> Maybe (SrcSpan, Text)
parseSrcSpan  e =
  let (s, description) = Text.drop 1 <$> Text.breakOn "\n" e

      number = do
        n <- Parsec.many Parsec.digit
        maybe (fail "no parse") return $ readMaybe n

      srcLoc = SrcLoc
        <$> (Parsec.string "line " *> number)
        <*> (Parsec.string ", column " *> number)

      srcSpan = do
        start <- srcLoc
        end <- (Parsec.string " - " *> srcLoc) <|> return start
        return $ SrcSpan start end
  in
  case Parsec.runParser srcSpan () "<input>" s of
    Left _ -> Nothing
    Right span -> Just (span, description)

-- | Number of lines to show before and after the target
-- source span to give more context to the error.
newtype Context = Context { unContext :: Int }

prettyErrorAt :: SrcSpan -> Text -> Text -> Doc Ann
prettyErrorAt span source err = vcat
  [ pretty err
  , prettySource
  ]
  where
    prettySource = vcat
      [ numberCol ctx span Nothing
      , relevantLines
      , numberCol ctx span Nothing <>
        if isSingleLine
          then underline span
          else mempty
      ]
    -- number of lines before and after the error to show
    ctx = Context $ if isSingleLine then 0 else 1
    isSingleLine    = sline span == eline span
    firstLineToShow = sline span - unContext ctx
    lastLineToShow  = eline span + unContext ctx
    shouldShow line = firstLineToShow <= line && line <= lastLineToShow
    relevantLines = vcat
      [ prettyLine ctx span n line
      | (n, line) <- zip [1..] (Text.lines source)
      , shouldShow n
      ]

prettyLine :: Context -> SrcSpan -> Int -> Text -> Doc Ann
prettyLine ctx span n line =
  numberCol ctx span (Just n)
  <> pretty before
  <> red (pretty within)
  <> pretty after
  where
    before
      | n == sline span = Text.take (scol span - 1) line
      | n < sline span = line
      | otherwise = mempty
    after
      | n == eline span = Text.drop (ecol span - 1) line
      | n > eline span = line
      | otherwise = mempty
    within
      = Text.dropEnd (Text.length after)
      $ Text.drop (Text.length before) line

-- | only to be used for single line SrcSpan
underline :: SrcSpan -> Doc Ann
underline span = pretty spaces <> red (pretty zigzag)
  where
    spaces = Text.replicate (scol span - 1) " "
    zigzag = Text.replicate (max 1 $ ecol span - scol span) "^"

numberCol :: Context -> SrcSpan -> Maybe Int -> Doc Ann
numberCol (Context ctx) span mline =
  pretty spaces <> pretty number <> divider <> indicator
  where
    hasContext = ctx > 0
    isSourceLine = isJust mline
    isProblemLine = case mline of
      Nothing -> False
      Just n -> sline span <= n && n <= eline span

    maxNumber = show (eline span)
    divider = if isSourceLine then " |" else "  "
    number = maybe "" show mline
    spaces = Text.replicate (length maxNumber - length number) " "
    indicator =
      if hasContext && isProblemLine
         then red "> "
         else "  " -- no context. No need to point out which lines have errors.

red :: Doc Ann -> Doc Ann
red = Pretty.annotate (Pretty.color Pretty.Red)

sline, eline, scol, ecol :: SrcSpan -> Int
sline (SrcSpan (SrcLoc l _) _) = l
eline (SrcSpan _ (SrcLoc l _)) = l
scol (SrcSpan (SrcLoc _ c) _) = c
ecol (SrcSpan _ (SrcLoc _ c)) = c