{- |
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
      -- * Styling options
    , Style (..)
    , highlight
    ) where

import qualified Data.Text as T

-- | Line number, starts at 1.
type Line = Int

-- | Column number, starts at 1.
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.
    }

{- | 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 -> (FilePath, Line, Line)
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.
      -}
    }

{- | 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 -> Line
pointerLine :: Line
      -- ^ The line of the pointer.
    , Pointer -> Line
pointerColStart :: Column
      -- ^ The starting column of the pointer.
    , Pointer -> Line
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.
    }
    deriving (Line -> Pointer -> ShowS
[Pointer] -> ShowS
Pointer -> FilePath
(Line -> Pointer -> ShowS)
-> (Pointer -> FilePath) -> ([Pointer] -> ShowS) -> Show Pointer
forall a.
(Line -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Pointer] -> ShowS
$cshowList :: [Pointer] -> ShowS
show :: Pointer -> FilePath
$cshow :: Pointer -> FilePath
showsPrec :: Line -> Pointer -> ShowS
$cshowsPrec :: Line -> Pointer -> ShowS
Show, Pointer -> Pointer -> Bool
(Pointer -> Pointer -> Bool)
-> (Pointer -> Pointer -> Bool) -> Eq Pointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pointer -> Pointer -> Bool
$c/= :: Pointer -> Pointer -> Bool
== :: Pointer -> Pointer -> Bool
$c== :: Pointer -> Pointer -> Bool
Eq)

-- | Gets the column span for a 'Pointer'.
pointerColumns :: Pointer -> (Column, Column)
pointerColumns :: Pointer -> (Line, Line)
pointerColumns Pointer
p = (Pointer -> Line
pointerColStart Pointer
p, Pointer -> Line
pointerColEnd Pointer
p)

-- | Stylization options for a block, e.g. characters to use.
data Style = Style
    { Style -> (FilePath, Line, Line) -> 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 -> Line -> 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 -> [(Line, Line)] -> Header -> Header
styleLine :: [(Column, Column)] -> T.Text -> T.Text
      {- ^ Stylize a source line.

      Column pointers of the text that are being underlined are given for highlighting purposes. 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
styleUnderline :: T.Text
      {- ^ The text to underline a character in a pointer.

      This should visually be one character.
      -}
    , 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.
      -}
    }

-- | Adds highlighting to spans of text by enclosing it with some text e.g ANSI escape codes.
highlight
    :: T.Text             -- ^ Text to add before.
    -> T.Text             -- ^ Text to add after.
    -> [(Column, Column)] -- ^ Indices to enclose. These are column spans, starting at 1. They must not overlap.
    -> T.Text             -- ^ Text to highlight.
    -> T.Text
highlight :: Header -> Header -> [(Line, Line)] -> Header -> Header
highlight Header
open Header
close = Bool -> [Line] -> Header -> Header
go Bool
False ([Line] -> Header -> Header)
-> ([(Line, Line)] -> [Line]) -> [(Line, Line)] -> Header -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Line, Line) -> [Line]) -> [(Line, Line)] -> [Line]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Line
a, Line
b) -> [Line
a, Line
b])
    where
        go :: Bool -> [Line] -> Header -> Header
go Bool
_ [] Header
xs = Header
xs
        go Bool
False (Line
i:[Line]
is) Header
xs =
            let (Header
a, Header
ys) = Line -> Header -> (Header, Header)
T.splitAt (Line
i Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1) Header
xs
            in Header
a Header -> Header -> Header
forall a. Semigroup a => a -> a -> a
<> Header
open Header -> Header -> Header
forall a. Semigroup a => a -> a -> a
<> Bool -> [Line] -> Header -> Header
go Bool
True ((Line -> Line) -> [Line] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map (\Line
x -> Line
x Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
i Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1) [Line]
is) Header
ys
        go Bool
True (Line
i:[Line]
is) Header
xs =
            let (Header
a, Header
ys) = Line -> Header -> (Header, Header)
T.splitAt (Line
i Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1) Header
xs
            in Header
a Header -> Header -> Header
forall a. Semigroup a => a -> a -> a
<> Header
close Header -> Header -> Header
forall a. Semigroup a => a -> a -> a
<> Bool -> [Line] -> Header -> Header
go Bool
False ((Line -> Line) -> [Line] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map (\Line
x -> Line
x Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
i Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1) [Line]
is) Header
ys