module Chapelure.Types where

import Chapelure.Style (DocText)
import Data.Text (Text)
import Data.Text.Display (Display (displayBuilder), ShowInstance (..))
import Data.Vector (Vector)
import Data.Vector.NonEmpty (NonEmptyVector)
import GHC.Generics (Generic)
import Prettyprinter (Pretty)

data Diagnostic = Diagnostic
  { -- | Unique diagnostic code that be used to look up more information.
    -- Should be globally unique, and documented for easy searching.
    Diagnostic -> Maybe Text
code :: Maybe Text,
    -- | Diagnostic severity, this may be used by the Report Handler
    -- to adapt the formatting of the diagnostic.
    Diagnostic -> Severity
severity :: Severity,
    -- | A short description of the diagnostic. Rendered at the top.
    Diagnostic -> Maybe DocText
message :: Maybe DocText,
    -- | Additional free-form text for the poor bastard at the end of it all. Rendered at the bottom
    Diagnostic -> Maybe DocText
help :: Maybe DocText,
    -- | Link to visit for a more detailed explanation.
    -- Can make use of the 'code' component.
    Diagnostic -> Maybe Text
link :: Maybe Text,
    -- | Contextual snippet to provide relevant source data.
    Diagnostic -> Maybe (NonEmptyVector Snippet)
snippets :: Maybe (NonEmptyVector Snippet)
  }
  deriving stock (Int -> Diagnostic -> ShowS
[Diagnostic] -> ShowS
Diagnostic -> String
(Int -> Diagnostic -> ShowS)
-> (Diagnostic -> String)
-> ([Diagnostic] -> ShowS)
-> Show Diagnostic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diagnostic] -> ShowS
$cshowList :: [Diagnostic] -> ShowS
show :: Diagnostic -> String
$cshow :: Diagnostic -> String
showsPrec :: Int -> Diagnostic -> ShowS
$cshowsPrec :: Int -> Diagnostic -> ShowS
Show, (forall x. Diagnostic -> Rep Diagnostic x)
-> (forall x. Rep Diagnostic x -> Diagnostic) -> Generic Diagnostic
forall x. Rep Diagnostic x -> Diagnostic
forall x. Diagnostic -> Rep Diagnostic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Diagnostic x -> Diagnostic
$cfrom :: forall x. Diagnostic -> Rep Diagnostic x
Generic)

-- | Enum used to indicate the severity of a diagnostic.
-- The Report Handlers will use this to adapt the formatting of the diagnostic.
data Severity
  = Info
  | Warning
  | Error
  deriving stock (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum, Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded)
  deriving
    (Int -> Severity -> Builder
[Severity] -> Builder
Severity -> Builder
(Severity -> Builder)
-> ([Severity] -> Builder)
-> (Int -> Severity -> Builder)
-> Display Severity
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
displayPrec :: Int -> Severity -> Builder
$cdisplayPrec :: Int -> Severity -> Builder
displayList :: [Severity] -> Builder
$cdisplayList :: [Severity] -> Builder
displayBuilder :: Severity -> Builder
$cdisplayBuilder :: Severity -> Builder
Display)
    via (ShowInstance Severity)

-- | Wrapper to mark an offset from the beginning of a 'Highlight'.
newtype Offset = Offset Word
  deriving stock (Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
Eq, Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> String
$cshow :: Offset -> String
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
Show, (forall x. Offset -> Rep Offset x)
-> (forall x. Rep Offset x -> Offset) -> Generic Offset
forall x. Rep Offset x -> Offset
forall x. Offset -> Rep Offset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Offset x -> Offset
$cfrom :: forall x. Offset -> Rep Offset x
Generic)
  deriving newtype (Eq Offset
Eq Offset
-> (Offset -> Offset -> Ordering)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> Ord Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
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 :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmax :: Offset -> Offset -> Offset
>= :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c< :: Offset -> Offset -> Bool
compare :: Offset -> Offset -> Ordering
$ccompare :: Offset -> Offset -> Ordering
$cp1Ord :: Eq Offset
Ord, Int -> Offset
Offset -> Int
Offset -> [Offset]
Offset -> Offset
Offset -> Offset -> [Offset]
Offset -> Offset -> Offset -> [Offset]
(Offset -> Offset)
-> (Offset -> Offset)
-> (Int -> Offset)
-> (Offset -> Int)
-> (Offset -> [Offset])
-> (Offset -> Offset -> [Offset])
-> (Offset -> Offset -> [Offset])
-> (Offset -> Offset -> Offset -> [Offset])
-> Enum Offset
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
$cenumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
enumFromTo :: Offset -> Offset -> [Offset]
$cenumFromTo :: Offset -> Offset -> [Offset]
enumFromThen :: Offset -> Offset -> [Offset]
$cenumFromThen :: Offset -> Offset -> [Offset]
enumFrom :: Offset -> [Offset]
$cenumFrom :: Offset -> [Offset]
fromEnum :: Offset -> Int
$cfromEnum :: Offset -> Int
toEnum :: Int -> Offset
$ctoEnum :: Int -> Offset
pred :: Offset -> Offset
$cpred :: Offset -> Offset
succ :: Offset -> Offset
$csucc :: Offset -> Offset
Enum, [Offset] -> Doc ann
Offset -> Doc ann
(forall ann. Offset -> Doc ann)
-> (forall ann. [Offset] -> Doc ann) -> Pretty Offset
forall ann. [Offset] -> Doc ann
forall ann. Offset -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Offset] -> Doc ann
$cprettyList :: forall ann. [Offset] -> Doc ann
pretty :: Offset -> Doc ann
$cpretty :: forall ann. Offset -> Doc ann
Pretty)

-- | Wrapper that represents a line in a Diagnostic report
newtype Line = Line Word
  deriving stock (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show, (forall x. Line -> Rep Line x)
-> (forall x. Rep Line x -> Line) -> Generic Line
forall x. Rep Line x -> Line
forall x. Line -> Rep Line x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Line x -> Line
$cfrom :: forall x. Line -> Rep Line x
Generic)
  deriving newtype (Eq Line
Eq Line
-> (Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
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 :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmax :: Line -> Line -> Line
>= :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c< :: Line -> Line -> Bool
compare :: Line -> Line -> Ordering
$ccompare :: Line -> Line -> Ordering
$cp1Ord :: Eq Line
Ord, Int -> Line
Line -> Int
Line -> [Line]
Line -> Line
Line -> Line -> [Line]
Line -> Line -> Line -> [Line]
(Line -> Line)
-> (Line -> Line)
-> (Int -> Line)
-> (Line -> Int)
-> (Line -> [Line])
-> (Line -> Line -> [Line])
-> (Line -> Line -> [Line])
-> (Line -> Line -> Line -> [Line])
-> Enum Line
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Line -> Line -> Line -> [Line]
$cenumFromThenTo :: Line -> Line -> Line -> [Line]
enumFromTo :: Line -> Line -> [Line]
$cenumFromTo :: Line -> Line -> [Line]
enumFromThen :: Line -> Line -> [Line]
$cenumFromThen :: Line -> Line -> [Line]
enumFrom :: Line -> [Line]
$cenumFrom :: Line -> [Line]
fromEnum :: Line -> Int
$cfromEnum :: Line -> Int
toEnum :: Int -> Line
$ctoEnum :: Int -> Line
pred :: Line -> Line
$cpred :: Line -> Line
succ :: Line -> Line
$csucc :: Line -> Line
Enum, [Line] -> Doc ann
Line -> Doc ann
(forall ann. Line -> Doc ann)
-> (forall ann. [Line] -> Doc ann) -> Pretty Line
forall ann. [Line] -> Doc ann
forall ann. Line -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Line] -> Doc ann
$cprettyList :: forall ann. [Line] -> Doc ann
pretty :: Line -> Doc ann
$cpretty :: forall ann. Line -> Doc ann
Pretty)

instance Display Line where
  displayBuilder :: Line -> Builder
displayBuilder (Line Word
line) = Word -> Builder
forall a. Display a => a -> Builder
displayBuilder Word
line

incrementLine :: Line -> Line
incrementLine :: Line -> Line
incrementLine (Line Word
i) = Word -> Line
Line (Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)

-- | Wrapper that represents a column in a Diagnostic report
newtype Column = Column Word
  deriving stock (Column -> Column -> Bool
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show, (forall x. Column -> Rep Column x)
-> (forall x. Rep Column x -> Column) -> Generic Column
forall x. Rep Column x -> Column
forall x. Column -> Rep Column x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Column x -> Column
$cfrom :: forall x. Column -> Rep Column x
Generic)
  deriving newtype (Eq Column
Eq Column
-> (Column -> Column -> Ordering)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> Ord Column
Column -> Column -> Bool
Column -> Column -> Ordering
Column -> Column -> Column
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 :: Column -> Column -> Column
$cmin :: Column -> Column -> Column
max :: Column -> Column -> Column
$cmax :: Column -> Column -> Column
>= :: Column -> Column -> Bool
$c>= :: Column -> Column -> Bool
> :: Column -> Column -> Bool
$c> :: Column -> Column -> Bool
<= :: Column -> Column -> Bool
$c<= :: Column -> Column -> Bool
< :: Column -> Column -> Bool
$c< :: Column -> Column -> Bool
compare :: Column -> Column -> Ordering
$ccompare :: Column -> Column -> Ordering
$cp1Ord :: Eq Column
Ord, Int -> Column
Column -> Int
Column -> [Column]
Column -> Column
Column -> Column -> [Column]
Column -> Column -> Column -> [Column]
(Column -> Column)
-> (Column -> Column)
-> (Int -> Column)
-> (Column -> Int)
-> (Column -> [Column])
-> (Column -> Column -> [Column])
-> (Column -> Column -> [Column])
-> (Column -> Column -> Column -> [Column])
-> Enum Column
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Column -> Column -> Column -> [Column]
$cenumFromThenTo :: Column -> Column -> Column -> [Column]
enumFromTo :: Column -> Column -> [Column]
$cenumFromTo :: Column -> Column -> [Column]
enumFromThen :: Column -> Column -> [Column]
$cenumFromThen :: Column -> Column -> [Column]
enumFrom :: Column -> [Column]
$cenumFrom :: Column -> [Column]
fromEnum :: Column -> Int
$cfromEnum :: Column -> Int
toEnum :: Int -> Column
$ctoEnum :: Int -> Column
pred :: Column -> Column
$cpred :: Column -> Column
succ :: Column -> Column
$csucc :: Column -> Column
Enum, [Column] -> Doc ann
Column -> Doc ann
(forall ann. Column -> Doc ann)
-> (forall ann. [Column] -> Doc ann) -> Pretty Column
forall ann. [Column] -> Doc ann
forall ann. Column -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Column] -> Doc ann
$cprettyList :: forall ann. [Column] -> Doc ann
pretty :: Column -> Doc ann
$cpretty :: forall ann. Column -> Doc ann
Pretty)

instance Display Column where
  displayBuilder :: Column -> Builder
displayBuilder (Column Word
column) = Word -> Builder
forall a. Display a => a -> Builder
displayBuilder Word
column

incrementColumn :: Column -> Column
incrementColumn :: Column -> Column
incrementColumn (Column Word
i) = Word -> Column
Column (Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)

-- | A datatype holding a message, some source data and a span to highlight.
data Snippet = Snippet
  { -- | A location name (filename or other), and the line and columns
    -- at which the snippet starts.
    Snippet -> (Maybe Text, Line, Column)
location :: (Maybe Text, Line, Column),
    -- | Highlights of the source that are of interest
    Snippet -> Maybe (NonEmptyVector Highlight)
highlights :: Maybe (NonEmptyVector Highlight),
    -- | Subject that is being reported. Each member is a line.
    Snippet -> Vector DocText
content :: Vector DocText
  }
  deriving stock (Int -> Snippet -> ShowS
[Snippet] -> ShowS
Snippet -> String
(Int -> Snippet -> ShowS)
-> (Snippet -> String) -> ([Snippet] -> ShowS) -> Show Snippet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snippet] -> ShowS
$cshowList :: [Snippet] -> ShowS
show :: Snippet -> String
$cshow :: Snippet -> String
showsPrec :: Int -> Snippet -> ShowS
$cshowsPrec :: Int -> Snippet -> ShowS
Show, (forall x. Snippet -> Rep Snippet x)
-> (forall x. Rep Snippet x -> Snippet) -> Generic Snippet
forall x. Rep Snippet x -> Snippet
forall x. Snippet -> Rep Snippet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Snippet x -> Snippet
$cfrom :: forall x. Snippet -> Rep Snippet x
Generic)

-- | A piece of source data that is shown when reporting an error.
-- Pointers on a source are always on a single line.
data Highlight = Highlight
  { -- | An optional label for the highlight
    Highlight -> Maybe DocText
label :: Maybe DocText,
    -- | Where the highlight is
    Highlight -> NonEmptyVector (Line, Column, Column)
spans :: NonEmptyVector (Line, Column, Column)
  }
  deriving stock (Int -> Highlight -> ShowS
[Highlight] -> ShowS
Highlight -> String
(Int -> Highlight -> ShowS)
-> (Highlight -> String)
-> ([Highlight] -> ShowS)
-> Show Highlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Highlight] -> ShowS
$cshowList :: [Highlight] -> ShowS
show :: Highlight -> String
$cshow :: Highlight -> String
showsPrec :: Int -> Highlight -> ShowS
$cshowsPrec :: Int -> Highlight -> ShowS
Show, (forall x. Highlight -> Rep Highlight x)
-> (forall x. Rep Highlight x -> Highlight) -> Generic Highlight
forall x. Rep Highlight x -> Highlight
forall x. Highlight -> Rep Highlight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Highlight x -> Highlight
$cfrom :: forall x. Highlight -> Rep Highlight x
Generic)