{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

{- |
Module      : Errata.Types
Copyright   : (c) 2020- comp
License     : MIT
Maintainer  : onecomputer00@gmail.com
Stability   : stable
Portability : portable

Type definitions. Most of these are re-exported in "Errata", so you should not need to import this module, unless you
need some of the helper functions for making new functionality on top of Errata.
-}
module Errata.Types
    ( -- * Type synonyms
      Line
    , Column
    , Header
    , Body
    , Label
      -- * Error format data
    , Errata (..)
      -- * Blocks and pointers
    , Block (..)
    , Pointer (..)
    , pointerColumns
    , pointerData
      -- * Styling options
    , Style (..)
    , PointerStyle (..)
    ) where

import qualified Data.Text as T

-- | Line number, starts at 1, increments every new line character.
type Line = Int

-- | Column number, starts at 1, increments every 'Char'.
type Column = Int

-- | Header text. Generally goes above things.
type Header = T.Text

-- | Body text. Generally goes below things.
type Body = T.Text

-- | Label text. Generally goes inline with things.
type Label = T.Text

-- | A collection of information for pretty printing an error.
data Errata = Errata
    { Errata -> Maybe Header
errataHeader :: Maybe Header
      -- ^ The message that appears above all the blocks.
    , Errata -> [Block]
errataBlocks :: [Block]
      -- ^ Blocks in the source code to display.
    , Errata -> Maybe Header
errataBody :: Maybe Body
      -- ^ The message that appears below all the blocks.
    }
    deriving (Int -> Errata -> ShowS
[Errata] -> ShowS
Errata -> String
(Int -> Errata -> ShowS)
-> (Errata -> String) -> ([Errata] -> ShowS) -> Show Errata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Errata] -> ShowS
$cshowList :: [Errata] -> ShowS
show :: Errata -> String
$cshow :: Errata -> String
showsPrec :: Int -> Errata -> ShowS
$cshowsPrec :: Int -> Errata -> ShowS
Show)

{- | Information about a block in the source code, such as pointers and messages.

Each block has a style associated with it.
-}
data Block = Block
    { Block -> Style
blockStyle :: Style
      -- ^ The style of the block.
    , Block -> (String, Int, Int)
blockLocation :: (FilePath, Line, Column)
      {- ^ The filepath, line, and column of the block. These start at 1.

      This is used to create the text that details the location.
      -}
    , Block -> Maybe Header
blockHeader :: Maybe Header
      {- ^ The header message for the block.

      This will appear below the location and above the source lines.
      -}
    , Block -> [Pointer]
blockPointers :: [Pointer]
      {- ^ The block's pointers. These are used to "point out" parts of the source code in this block.

      The locations of each of these pointers must be non-overlapping. If the pointers are touching at a boundary
      however, that is allowed.
      -}
    , Block -> Maybe Header
blockBody :: Maybe Body
      {- ^ The body message for the block.

      This will appear below the source lines.
      -}
    }
    deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)

{- | A pointer is the span of the source code at a line, from one column to another. Each of the positions start at 1.

A pointer may also have a label that will display inline.

A pointer may also be connected to all the other pointers within the same block.
-}
data Pointer = Pointer
    { Pointer -> Int
pointerLine :: Line
      -- ^ The line of the pointer.
    , Pointer -> Int
pointerColStart :: Column
      -- ^ The starting column of the pointer.
    , Pointer -> Int
pointerColEnd :: Column
      -- ^ The ending column of the pointer.
    , Pointer -> Bool
pointerConnect :: Bool
      -- ^ Whether this pointer connects with other pointers.
    , Pointer -> Maybe Header
pointerLabel :: Maybe Label
      -- ^ An optional label for the pointer.
    , Pointer -> PointerStyle
pointerStyle :: PointerStyle
      -- ^ A style for this pointer.
    }
    deriving (Int -> Pointer -> ShowS
[Pointer] -> ShowS
Pointer -> String
(Int -> Pointer -> ShowS)
-> (Pointer -> String) -> ([Pointer] -> ShowS) -> Show Pointer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pointer] -> ShowS
$cshowList :: [Pointer] -> ShowS
show :: Pointer -> String
$cshow :: Pointer -> String
showsPrec :: Int -> Pointer -> ShowS
$cshowsPrec :: Int -> Pointer -> ShowS
Show)

-- | Gets the column span for a 'Pointer'.
pointerColumns :: Pointer -> (Column, Column)
pointerColumns :: Pointer -> (Int, Int)
pointerColumns (Pointer {Bool
Int
Maybe Header
PointerStyle
pointerStyle :: PointerStyle
pointerLabel :: Maybe Header
pointerConnect :: Bool
pointerColEnd :: Int
pointerColStart :: Int
pointerLine :: Int
pointerStyle :: Pointer -> PointerStyle
pointerLabel :: Pointer -> Maybe Header
pointerConnect :: Pointer -> Bool
pointerColEnd :: Pointer -> Int
pointerColStart :: Pointer -> Int
pointerLine :: Pointer -> Int
..}) = (Int
pointerColStart, Int
pointerColEnd)

-- | Gets physical information about a pointer.
pointerData :: Pointer -> (Line, Column, Column, Bool, Maybe Label)
pointerData :: Pointer -> (Int, Int, Int, Bool, Maybe Header)
pointerData (Pointer {Bool
Int
Maybe Header
PointerStyle
pointerStyle :: PointerStyle
pointerLabel :: Maybe Header
pointerConnect :: Bool
pointerColEnd :: Int
pointerColStart :: Int
pointerLine :: Int
pointerStyle :: Pointer -> PointerStyle
pointerLabel :: Pointer -> Maybe Header
pointerConnect :: Pointer -> Bool
pointerColEnd :: Pointer -> Int
pointerColStart :: Pointer -> Int
pointerLine :: Pointer -> Int
..}) = (Int
pointerLine, Int
pointerColStart, Int
pointerColEnd, Bool
pointerConnect, Maybe Header
pointerLabel)

-- | Stylization options for a block, e.g. characters to use.
data Style = Style
    { Style -> (String, Int, Int) -> Header
styleLocation :: (FilePath, Line, Column) -> T.Text
      {- ^ Shows the location of a block at a file, line, and column.

      This is put on its own line just above the source lines.
      -}
    , Style -> Int -> Header
styleNumber :: Line -> T.Text
      {- ^ Shows the line number /n/ for a source line.

      The result should visually be the same length as just @show n@.
      -}
    , Style -> [(PointerStyle, (Int, Int))] -> Header -> Header
styleLine :: [(PointerStyle, (Column, Column))] -> T.Text -> T.Text
      {- ^ Stylize a source line.

      The style and the column span (sorted, starting at 1) of the text that is being underlined are given for
      highlighting purposes (see 'Errata.Styles.highlight').
      They can be ignored for source code highlighting instead, for example.
      The result of this should visually take up the same space as the original line.
      -}
    , Style -> Header
styleEllipsis :: T.Text
      {- ^ The text to use as an ellipsis in the position of line numbers for when lines are omitted.

      This should visually be one character.
      -}
    , Style -> Header
styleLinePrefix :: T.Text
      {- ^ The prefix before the source lines.

      Before it may be the line number, and after it the source line.
      -}
    , Style -> Header
styleVertical :: T.Text
      {- ^ The text to use as a vertical bar when connecting pointers.

      This should visually be one character.
      -}
    , Style -> Header
styleHorizontal :: T.Text
      {- ^ The text to use as a horizontal bar when connecting pointers.

      This should visually be one character.
      -}
    , Style -> Header
styleDownRight :: T.Text
      {- ^ The text to use as a connector downwards and rightwards when connecting pointers.

      This should visually be one character.
      -}
    , Style -> Header
styleUpRight :: T.Text
      {- ^ The text to use as a connector upwards and rightwards when connecting pointers.

      This should visually be one character.
      -}
    , Style -> Header
styleUpDownRight :: T.Text
      {- ^ The text to use as a connector upwards, downwards, and rightwards when connecting pointers.

      This should visually be one character.
      -}
    , Style -> Int
styleTabWidth :: Int
      {- ^ The number of spaces a tab character is equivalent to.

      Your source will have tabs replaced with this many spaces.
      -}
    , Style -> Int
styleExtraLinesAfter :: Int
      -- ^ Maximum number of extra lines that can be added after the first line when skipping lines between two lines.
    , Style -> Int
styleExtraLinesBefore :: Int
      -- ^ Maximum number of extra lines that can be added before the second line when skipping lines between two lines.
    , Style -> Bool
stylePaddingTop :: Bool
      -- ^ Whether to add a padding line before the first source line.
    , Style -> Bool
stylePaddingBottom :: Bool
      -- ^ Whether to add a padding line after the last source line.
    , Style -> Bool
styleEnableDecorations :: Bool
      {- ^ Whether to enable decorations at all in this block.

      This includes the pointer connectors (as in 'Style') and the underlines, connectors, and labels
      (as in 'PointerStyle'). However, highlighting will still be applied.
      -}
    , Style -> Bool
styleEnableLinePrefix :: Bool
      -- ^ Whether to enable the line prefix.
    }

instance Show Style where
  show :: Style -> String
show (Style {Bool
Int
Header
Int -> Header
[(PointerStyle, (Int, Int))] -> Header -> Header
(String, Int, Int) -> Header
styleEnableLinePrefix :: Bool
styleEnableDecorations :: Bool
stylePaddingBottom :: Bool
stylePaddingTop :: Bool
styleExtraLinesBefore :: Int
styleExtraLinesAfter :: Int
styleTabWidth :: Int
styleUpDownRight :: Header
styleUpRight :: Header
styleDownRight :: Header
styleHorizontal :: Header
styleVertical :: Header
styleLinePrefix :: Header
styleEllipsis :: Header
styleLine :: [(PointerStyle, (Int, Int))] -> Header -> Header
styleNumber :: Int -> Header
styleLocation :: (String, Int, Int) -> Header
styleEnableLinePrefix :: Style -> Bool
styleEnableDecorations :: Style -> Bool
stylePaddingBottom :: Style -> Bool
stylePaddingTop :: Style -> Bool
styleExtraLinesBefore :: Style -> Int
styleExtraLinesAfter :: Style -> Int
styleTabWidth :: Style -> Int
styleUpDownRight :: Style -> Header
styleUpRight :: Style -> Header
styleDownRight :: Style -> Header
styleHorizontal :: Style -> Header
styleVertical :: Style -> Header
styleLinePrefix :: Style -> Header
styleEllipsis :: Style -> Header
styleLine :: Style -> [(PointerStyle, (Int, Int))] -> Header -> Header
styleNumber :: Style -> Int -> Header
styleLocation :: Style -> (String, Int, Int) -> Header
..}) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Style {"
    , String
"styleLocation = ", Header -> String
forall a. Show a => a -> String
show (Header -> String) -> Header -> String
forall a b. (a -> b) -> a -> b
$ (String, Int, Int) -> Header
styleLocation (String
"file", Int
1, Int
1)
    , String
", styleNumber = ", Header -> String
forall a. Show a => a -> String
show (Header -> String) -> Header -> String
forall a b. (a -> b) -> a -> b
$ Int -> Header
styleNumber Int
3
    , String
", styleLine = ", Header -> String
forall a. Show a => a -> String
show (Header -> String) -> Header -> String
forall a b. (a -> b) -> a -> b
$ [(PointerStyle, (Int, Int))] -> Header -> Header
styleLine [(PointerStyle
basicPointer, (Int
1, Int
5))] Header
"text"
    , String
", styleEllipsis = ", Header -> String
forall a. Show a => a -> String
show Header
styleEllipsis
    , String
", styleLinePrefix = ", Header -> String
forall a. Show a => a -> String
show Header
styleLinePrefix
    , String
", styleVertical = ", Header -> String
forall a. Show a => a -> String
show Header
styleVertical
    , String
", styleHorizontal = ", Header -> String
forall a. Show a => a -> String
show Header
styleHorizontal
    , String
", styleDownRight = ", Header -> String
forall a. Show a => a -> String
show Header
styleDownRight
    , String
", styleUpRight = ", Header -> String
forall a. Show a => a -> String
show Header
styleUpRight
    , String
", styleUpDownRight = ", Header -> String
forall a. Show a => a -> String
show Header
styleUpDownRight
    , String
", styleTabWidth = ", Int -> String
forall a. Show a => a -> String
show Int
styleTabWidth
    , String
", styleExtraLinesAfter = ", Int -> String
forall a. Show a => a -> String
show Int
styleExtraLinesAfter
    , String
", styleExtraLinesBefore = ", Int -> String
forall a. Show a => a -> String
show Int
styleExtraLinesBefore
    , String
", stylePaddingTop = ", Bool -> String
forall a. Show a => a -> String
show Bool
stylePaddingTop
    , String
", stylePaddingBottom = ", Bool -> String
forall a. Show a => a -> String
show Bool
stylePaddingBottom
    , String
", styleEnableDecorations = ", Bool -> String
forall a. Show a => a -> String
show Bool
styleEnableDecorations
    , String
", styleEnableLinePrefix = ", Bool -> String
forall a. Show a => a -> String
show Bool
styleEnableLinePrefix
    , String
"}"
    ]
    where
      basicPointer :: PointerStyle
basicPointer = PointerStyle
        { styleHighlight :: Header -> Header
styleHighlight = Header -> Header
forall a. a -> a
id
        , styleUnderline :: Header
styleUnderline = Header
"^"
        , styleHook :: Header
styleHook = Header
"|"
        , styleConnector :: Header
styleConnector = Header
"|"
        , styleEnableHook :: Bool
styleEnableHook = Bool
True
        }

-- | Stylization options for an individual pointer, e.g. characters to use.
data PointerStyle = PointerStyle
  { PointerStyle -> Header -> Header
styleHighlight :: T.Text -> T.Text
    {- ^ Stylize the text that this pointer is underlining.

    This is only used if 'styleLine' uses the given pointer styles, for example with 'Errata.Styles.highlight'.
    The result of this should visually take up the same space as the original text.
    -}
  , PointerStyle -> Header
styleUnderline :: T.Text
    {- ^ The text to underline a character in a pointer.

    This should visually be one character.
    -}
  , PointerStyle -> Header
styleHook :: T.Text
    {- ^ The text to use as a connector upwards and hooking to the right for the label of a pointer that drops down.

    This probably looks best as one character.
    -}
  , PointerStyle -> Header
styleConnector :: T.Text
    {- ^ The text to use as a vertical bar when connecting a pointer that drops down to its label.

    This should visually be one character.
    -}
  , PointerStyle -> Bool
styleEnableHook :: Bool
    -- ^ Whether to use the hook for labels that drop down, or simply start the label directly under the connector.
  }

instance Show PointerStyle where
  show :: PointerStyle -> String
show (PointerStyle {Bool
Header
Header -> Header
styleEnableHook :: Bool
styleConnector :: Header
styleHook :: Header
styleUnderline :: Header
styleHighlight :: Header -> Header
styleEnableHook :: PointerStyle -> Bool
styleConnector :: PointerStyle -> Header
styleHook :: PointerStyle -> Header
styleUnderline :: PointerStyle -> Header
styleHighlight :: PointerStyle -> Header -> Header
..}) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"PointerStyle {"
    , String
"styleHighlight = ", Header -> String
forall a. Show a => a -> String
show (Header -> String) -> Header -> String
forall a b. (a -> b) -> a -> b
$ Header -> Header
styleHighlight Header
"text"
    , String
", styleUnderline = ", Header -> String
forall a. Show a => a -> String
show Header
styleUnderline
    , String
", styleHook = ", Header -> String
forall a. Show a => a -> String
show Header
styleHook
    , String
", styleConnector = ", Header -> String
forall a. Show a => a -> String
show Header
styleConnector
    , String
", styleEnableHook = ", Bool -> String
forall a. Show a => a -> String
show Bool
styleEnableHook
    , String
"}"
    ]