{-# LANGUAGE TemplateHaskell #-}

module Language.PureScript.Errors.JSON where

import Prelude

import Data.Aeson.TH qualified as A
import Data.List.NonEmpty qualified as NEL
import Data.Text (Text)

import Language.PureScript qualified as P

data ErrorPosition = ErrorPosition
  { ErrorPosition -> Int
startLine :: Int
  , ErrorPosition -> Int
startColumn :: Int
  , ErrorPosition -> Int
endLine :: Int
  , ErrorPosition -> Int
endColumn :: Int
  } deriving (Int -> ErrorPosition -> ShowS
[ErrorPosition] -> ShowS
ErrorPosition -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ErrorPosition] -> ShowS
$cshowList :: [ErrorPosition] -> ShowS
show :: ErrorPosition -> FilePath
$cshow :: ErrorPosition -> FilePath
showsPrec :: Int -> ErrorPosition -> ShowS
$cshowsPrec :: Int -> ErrorPosition -> ShowS
Show, ErrorPosition -> ErrorPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorPosition -> ErrorPosition -> Bool
$c/= :: ErrorPosition -> ErrorPosition -> Bool
== :: ErrorPosition -> ErrorPosition -> Bool
$c== :: ErrorPosition -> ErrorPosition -> Bool
Eq, Eq ErrorPosition
ErrorPosition -> ErrorPosition -> Bool
ErrorPosition -> ErrorPosition -> Ordering
ErrorPosition -> ErrorPosition -> ErrorPosition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorPosition -> ErrorPosition -> ErrorPosition
$cmin :: ErrorPosition -> ErrorPosition -> ErrorPosition
max :: ErrorPosition -> ErrorPosition -> ErrorPosition
$cmax :: ErrorPosition -> ErrorPosition -> ErrorPosition
>= :: ErrorPosition -> ErrorPosition -> Bool
$c>= :: ErrorPosition -> ErrorPosition -> Bool
> :: ErrorPosition -> ErrorPosition -> Bool
$c> :: ErrorPosition -> ErrorPosition -> Bool
<= :: ErrorPosition -> ErrorPosition -> Bool
$c<= :: ErrorPosition -> ErrorPosition -> Bool
< :: ErrorPosition -> ErrorPosition -> Bool
$c< :: ErrorPosition -> ErrorPosition -> Bool
compare :: ErrorPosition -> ErrorPosition -> Ordering
$ccompare :: ErrorPosition -> ErrorPosition -> Ordering
Ord)

data ErrorSuggestion = ErrorSuggestion
  { ErrorSuggestion -> Text
replacement :: Text
  , ErrorSuggestion -> Maybe ErrorPosition
replaceRange :: Maybe ErrorPosition
  } deriving (Int -> ErrorSuggestion -> ShowS
[ErrorSuggestion] -> ShowS
ErrorSuggestion -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ErrorSuggestion] -> ShowS
$cshowList :: [ErrorSuggestion] -> ShowS
show :: ErrorSuggestion -> FilePath
$cshow :: ErrorSuggestion -> FilePath
showsPrec :: Int -> ErrorSuggestion -> ShowS
$cshowsPrec :: Int -> ErrorSuggestion -> ShowS
Show, ErrorSuggestion -> ErrorSuggestion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorSuggestion -> ErrorSuggestion -> Bool
$c/= :: ErrorSuggestion -> ErrorSuggestion -> Bool
== :: ErrorSuggestion -> ErrorSuggestion -> Bool
$c== :: ErrorSuggestion -> ErrorSuggestion -> Bool
Eq)

data JSONError = JSONError
  { JSONError -> Maybe ErrorPosition
position :: Maybe ErrorPosition
  , JSONError -> FilePath
message :: String
  , JSONError -> Text
errorCode :: Text
  , JSONError -> Text
errorLink :: Text
  , JSONError -> Maybe FilePath
filename :: Maybe String
  , JSONError -> Maybe Text
moduleName :: Maybe Text
  , JSONError -> Maybe ErrorSuggestion
suggestion :: Maybe ErrorSuggestion
  , JSONError -> [SourceSpan]
allSpans :: [P.SourceSpan]
  } deriving (Int -> JSONError -> ShowS
[JSONError] -> ShowS
JSONError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JSONError] -> ShowS
$cshowList :: [JSONError] -> ShowS
show :: JSONError -> FilePath
$cshow :: JSONError -> FilePath
showsPrec :: Int -> JSONError -> ShowS
$cshowsPrec :: Int -> JSONError -> ShowS
Show, JSONError -> JSONError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONError -> JSONError -> Bool
$c/= :: JSONError -> JSONError -> Bool
== :: JSONError -> JSONError -> Bool
$c== :: JSONError -> JSONError -> Bool
Eq)

data JSONResult = JSONResult
  { JSONResult -> [JSONError]
warnings :: [JSONError]
  , JSONResult -> [JSONError]
errors :: [JSONError]
  } deriving (Int -> JSONResult -> ShowS
[JSONResult] -> ShowS
JSONResult -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JSONResult] -> ShowS
$cshowList :: [JSONResult] -> ShowS
show :: JSONResult -> FilePath
$cshow :: JSONResult -> FilePath
showsPrec :: Int -> JSONResult -> ShowS
$cshowsPrec :: Int -> JSONResult -> ShowS
Show, JSONResult -> JSONResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONResult -> JSONResult -> Bool
$c/= :: JSONResult -> JSONResult -> Bool
== :: JSONResult -> JSONResult -> Bool
$c== :: JSONResult -> JSONResult -> Bool
Eq)

$(A.deriveJSON A.defaultOptions ''ErrorPosition)
$(A.deriveJSON A.defaultOptions ''ErrorSuggestion)
$(A.deriveJSON A.defaultOptions ''JSONError)
$(A.deriveJSON A.defaultOptions ''JSONResult)

toJSONErrors :: Bool -> P.Level -> [(FilePath, Text)] -> P.MultipleErrors -> [JSONError]
toJSONErrors :: Bool
-> Level -> [(FilePath, Text)] -> MultipleErrors -> [JSONError]
toJSONErrors Bool
verbose Level
level [(FilePath, Text)]
files = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Level -> [(FilePath, Text)] -> ErrorMessage -> JSONError
toJSONError Bool
verbose Level
level [(FilePath, Text)]
files) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultipleErrors -> [ErrorMessage]
P.runMultipleErrors

toJSONError :: Bool -> P.Level -> [(FilePath, Text)] -> P.ErrorMessage -> JSONError
toJSONError :: Bool -> Level -> [(FilePath, Text)] -> ErrorMessage -> JSONError
toJSONError Bool
verbose Level
level [(FilePath, Text)]
files ErrorMessage
e =
  Maybe ErrorPosition
-> FilePath
-> Text
-> Text
-> Maybe FilePath
-> Maybe Text
-> Maybe ErrorSuggestion
-> [SourceSpan]
-> JSONError
JSONError (SourceSpan -> ErrorPosition
toErrorPosition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NonEmpty a -> a
NEL.head Maybe (NonEmpty SourceSpan)
spans)
            (Box -> FilePath
P.renderBox (PPEOptions -> ErrorMessage -> Box
P.prettyPrintSingleError (Maybe (ColorIntensity, Color)
-> Bool
-> Level
-> Bool
-> FilePath
-> [(FilePath, Text)]
-> PPEOptions
P.PPEOptions forall a. Maybe a
Nothing Bool
verbose Level
level Bool
False forall a. Monoid a => a
mempty [(FilePath, Text)]
files) (ErrorMessage -> ErrorMessage
P.stripModuleAndSpan ErrorMessage
e)))
            (ErrorMessage -> Text
P.errorCode ErrorMessage
e)
            (ErrorMessage -> Text
P.errorDocUri ErrorMessage
e)
            (SourceSpan -> FilePath
P.spanName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NonEmpty a -> a
NEL.head Maybe (NonEmpty SourceSpan)
spans)
            (ModuleName -> Text
P.runModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorMessage -> Maybe ModuleName
P.errorModule ErrorMessage
e)
            (ErrorMessage -> Maybe ErrorSuggestion
toSuggestion ErrorMessage
e)
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. NonEmpty a -> [a]
NEL.toList Maybe (NonEmpty SourceSpan)
spans)
  where
  spans :: Maybe (NEL.NonEmpty P.SourceSpan)
  spans :: Maybe (NonEmpty SourceSpan)
spans = ErrorMessage -> Maybe (NonEmpty SourceSpan)
P.errorSpan ErrorMessage
e

  toErrorPosition :: P.SourceSpan -> ErrorPosition
  toErrorPosition :: SourceSpan -> ErrorPosition
toErrorPosition SourceSpan
ss =
    Int -> Int -> Int -> Int -> ErrorPosition
ErrorPosition (SourcePos -> Int
P.sourcePosLine   (SourceSpan -> SourcePos
P.spanStart SourceSpan
ss))
                  (SourcePos -> Int
P.sourcePosColumn (SourceSpan -> SourcePos
P.spanStart SourceSpan
ss))
                  (SourcePos -> Int
P.sourcePosLine   (SourceSpan -> SourcePos
P.spanEnd   SourceSpan
ss))
                  (SourcePos -> Int
P.sourcePosColumn (SourceSpan -> SourcePos
P.spanEnd   SourceSpan
ss))
  toSuggestion :: P.ErrorMessage -> Maybe ErrorSuggestion
  toSuggestion :: ErrorMessage -> Maybe ErrorSuggestion
toSuggestion ErrorMessage
em =
    case SimpleErrorMessage -> Maybe ErrorSuggestion
P.errorSuggestion forall a b. (a -> b) -> a -> b
$ ErrorMessage -> SimpleErrorMessage
P.unwrapErrorMessage ErrorMessage
em of
      Maybe ErrorSuggestion
Nothing -> forall a. Maybe a
Nothing
      Just ErrorSuggestion
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Maybe ErrorPosition -> ErrorSuggestion
ErrorSuggestion (ErrorSuggestion -> Text
suggestionText ErrorSuggestion
s) (SourceSpan -> ErrorPosition
toErrorPosition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorMessage -> Maybe SourceSpan
P.suggestionSpan ErrorMessage
em)

  suggestionText :: ErrorSuggestion -> Text
suggestionText (P.ErrorSuggestion Text
s) = Text
s