{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS -Wno-name-shadowing #-}
module Error.Diagnose.Report.Internal
( module Error.Diagnose.Report.Internal
, Report(.., Warn, Err)
, WithUnicode(..)
, TabSize(..)
) where
#ifdef USE_AESON
import Data.Aeson (ToJSON(..), object, (.=))
#endif
import Control.Applicative ((<|>))
import qualified Data.Array.IArray as Array
import Data.Array.Unboxed (Array, IArray, Ix, UArray, listArray, (!))
import Data.Bifunctor (bimap, first, second)
import Data.Char.WCWidth (wcwidth)
import Data.Default (def)
import Data.Foldable (fold)
import Data.Function (on)
import Data.Functor ((<&>), void)
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.List as List
import qualified Data.List.Safe as List
import Data.Maybe
import Data.String (IsString (fromString))
import Error.Diagnose.Position
import Error.Diagnose.Style (Annotation (..))
import Prettyprinter (Doc, Pretty (..), align, annotate, colon, hardline, lbracket, rbracket, space, width, (<+>), reAnnotate, SimpleDocStream (..), layoutCompact)
import Prettyprinter.Internal (Doc (..), textSpaces)
import Data.Bool (bool)
type FileMap = HashMap FilePath (Array Int String)
type WidthTable = UArray Int Int
data Report msg
= Report
Bool
(Maybe msg)
msg
[(Position, Marker msg)]
[Note msg]
deriving (forall a b. a -> Report b -> Report a
forall a b. (a -> b) -> Report a -> Report b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Report b -> Report a
$c<$ :: forall a b. a -> Report b -> Report a
fmap :: forall a b. (a -> b) -> Report a -> Report b
$cfmap :: forall a b. (a -> b) -> Report a -> Report b
Functor, forall a. Eq a => a -> Report a -> Bool
forall a. Num a => Report a -> a
forall a. Ord a => Report a -> a
forall m. Monoid m => Report m -> m
forall a. Report a -> Bool
forall a. Report a -> Int
forall a. Report a -> [a]
forall a. (a -> a -> a) -> Report a -> a
forall m a. Monoid m => (a -> m) -> Report a -> m
forall b a. (b -> a -> b) -> b -> Report a -> b
forall a b. (a -> b -> b) -> b -> Report a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Report a -> a
$cproduct :: forall a. Num a => Report a -> a
sum :: forall a. Num a => Report a -> a
$csum :: forall a. Num a => Report a -> a
minimum :: forall a. Ord a => Report a -> a
$cminimum :: forall a. Ord a => Report a -> a
maximum :: forall a. Ord a => Report a -> a
$cmaximum :: forall a. Ord a => Report a -> a
elem :: forall a. Eq a => a -> Report a -> Bool
$celem :: forall a. Eq a => a -> Report a -> Bool
length :: forall a. Report a -> Int
$clength :: forall a. Report a -> Int
null :: forall a. Report a -> Bool
$cnull :: forall a. Report a -> Bool
toList :: forall a. Report a -> [a]
$ctoList :: forall a. Report a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Report a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Report a -> a
foldr1 :: forall a. (a -> a -> a) -> Report a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Report a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Report a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Report a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Report a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Report a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Report a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Report a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Report a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Report a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Report a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Report a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Report a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Report a -> m
fold :: forall m. Monoid m => Report m -> m
$cfold :: forall m. Monoid m => Report m -> m
Foldable, Functor Report
Foldable Report
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
forall (f :: * -> *) a.
Applicative f =>
Report (f a) -> f (Report a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Report a -> m (Report b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Report a -> f (Report b)
sequence :: forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
$csequence :: forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Report a -> m (Report b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Report a -> m (Report b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Report (f a) -> f (Report a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Report (f a) -> f (Report a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Report a -> f (Report b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Report a -> f (Report b)
Traversable)
pattern Warn :: Maybe msg -> msg -> [(Position, Marker msg)] -> [Note msg] -> Report msg
pattern $bWarn :: forall msg.
Maybe msg
-> msg -> [(Position, Marker msg)] -> [Note msg] -> Report msg
$mWarn :: forall {r} {msg}.
Report msg
-> (Maybe msg
-> msg -> [(Position, Marker msg)] -> [Note msg] -> r)
-> ((# #) -> r)
-> r
Warn errCode msg reports notes = Report False errCode msg reports notes
pattern Err :: Maybe msg -> msg -> [(Position, Marker msg)] -> [Note msg] -> Report msg
pattern $bErr :: forall msg.
Maybe msg
-> msg -> [(Position, Marker msg)] -> [Note msg] -> Report msg
$mErr :: forall {r} {msg}.
Report msg
-> (Maybe msg
-> msg -> [(Position, Marker msg)] -> [Note msg] -> r)
-> ((# #) -> r)
-> r
Err errCode msg reports notes = Report True errCode msg reports notes
{-# COMPLETE Warn, Err #-}
instance Semigroup msg => Semigroup (Report msg) where
Report Bool
isError1 Maybe msg
code1 msg
msg1 [(Position, Marker msg)]
pos1 [Note msg]
hints1 <> :: Report msg -> Report msg -> Report msg
<> Report Bool
isError2 Maybe msg
code2 msg
msg2 [(Position, Marker msg)]
pos2 [Note msg]
hints2 =
forall msg.
Bool
-> Maybe msg
-> msg
-> [(Position, Marker msg)]
-> [Note msg]
-> Report msg
Report (Bool
isError1 Bool -> Bool -> Bool
|| Bool
isError2) (Maybe msg
code1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe msg
code2) (msg
msg1 forall a. Semigroup a => a -> a -> a
<> msg
msg2) ([(Position, Marker msg)]
pos1 forall a. Semigroup a => a -> a -> a
<> [(Position, Marker msg)]
pos2) ([Note msg]
hints1 forall a. Semigroup a => a -> a -> a
<> [Note msg]
hints2)
instance Monoid msg => Monoid (Report msg) where
mempty :: Report msg
mempty = forall msg.
Bool
-> Maybe msg
-> msg
-> [(Position, Marker msg)]
-> [Note msg]
-> Report msg
Report Bool
False forall a. Maybe a
Nothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
#ifdef USE_AESON
instance ToJSON msg => ToJSON (Report msg) where
toJSON :: Report msg -> Value
toJSON (Report Bool
isError Maybe msg
code msg
msg [(Position, Marker msg)]
markers [Note msg]
hints) =
[Pair] -> Value
object [ Key
"kind" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (if Bool
isError then String
"error" else String
"warning" :: String)
, Key
"code" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe msg
code
, Key
"message" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= msg
msg
, Key
"markers" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {v} {v}. (ToJSON v, ToJSON v) => (v, Marker v) -> Value
showMarker [(Position, Marker msg)]
markers
, Key
"hints" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Note msg]
hints
]
where
showMarker :: (v, Marker v) -> Value
showMarker (v
pos, Marker v
marker) =
[Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [ Key
"position" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
pos ]
forall a. Semigroup a => a -> a -> a
<> case Marker v
marker of
This v
m -> [ Key
"message" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
m
, Key
"kind" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"this" :: String)
]
Where v
m -> [ Key
"message" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
m
, Key
"kind" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"where" :: String)
]
Maybe v
m -> [ Key
"message" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
m
, Key
"kind" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"maybe" :: String)
]
Marker v
Blank -> [ Key
"kind" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"blank" :: String) ]
#endif
data Marker msg
=
This msg
|
Where msg
|
Maybe msg
|
Blank
deriving (Marker msg -> Marker msg -> Bool
forall msg. Eq msg => Marker msg -> Marker msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marker msg -> Marker msg -> Bool
$c/= :: forall msg. Eq msg => Marker msg -> Marker msg -> Bool
== :: Marker msg -> Marker msg -> Bool
$c== :: forall msg. Eq msg => Marker msg -> Marker msg -> Bool
Eq, Marker msg -> Marker msg -> Ordering
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
forall {msg}. Ord msg => Eq (Marker msg)
forall msg. Ord msg => Marker msg -> Marker msg -> Bool
forall msg. Ord msg => Marker msg -> Marker msg -> Ordering
forall msg. Ord msg => Marker msg -> Marker msg -> Marker msg
min :: Marker msg -> Marker msg -> Marker msg
$cmin :: forall msg. Ord msg => Marker msg -> Marker msg -> Marker msg
max :: Marker msg -> Marker msg -> Marker msg
$cmax :: forall msg. Ord msg => Marker msg -> Marker msg -> Marker msg
>= :: Marker msg -> Marker msg -> Bool
$c>= :: forall msg. Ord msg => Marker msg -> Marker msg -> Bool
> :: Marker msg -> Marker msg -> Bool
$c> :: forall msg. Ord msg => Marker msg -> Marker msg -> Bool
<= :: Marker msg -> Marker msg -> Bool
$c<= :: forall msg. Ord msg => Marker msg -> Marker msg -> Bool
< :: Marker msg -> Marker msg -> Bool
$c< :: forall msg. Ord msg => Marker msg -> Marker msg -> Bool
compare :: Marker msg -> Marker msg -> Ordering
$ccompare :: forall msg. Ord msg => Marker msg -> Marker msg -> Ordering
Ord, forall a b. a -> Marker b -> Marker a
forall a b. (a -> b) -> Marker a -> Marker b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Marker b -> Marker a
$c<$ :: forall a b. a -> Marker b -> Marker a
fmap :: forall a b. (a -> b) -> Marker a -> Marker b
$cfmap :: forall a b. (a -> b) -> Marker a -> Marker b
Functor, forall a. Eq a => a -> Marker a -> Bool
forall a. Num a => Marker a -> a
forall a. Ord a => Marker a -> a
forall m. Monoid m => Marker m -> m
forall a. Marker a -> Bool
forall a. Marker a -> Int
forall a. Marker a -> [a]
forall a. (a -> a -> a) -> Marker a -> a
forall m a. Monoid m => (a -> m) -> Marker a -> m
forall b a. (b -> a -> b) -> b -> Marker a -> b
forall a b. (a -> b -> b) -> b -> Marker a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Marker a -> a
$cproduct :: forall a. Num a => Marker a -> a
sum :: forall a. Num a => Marker a -> a
$csum :: forall a. Num a => Marker a -> a
minimum :: forall a. Ord a => Marker a -> a
$cminimum :: forall a. Ord a => Marker a -> a
maximum :: forall a. Ord a => Marker a -> a
$cmaximum :: forall a. Ord a => Marker a -> a
elem :: forall a. Eq a => a -> Marker a -> Bool
$celem :: forall a. Eq a => a -> Marker a -> Bool
length :: forall a. Marker a -> Int
$clength :: forall a. Marker a -> Int
null :: forall a. Marker a -> Bool
$cnull :: forall a. Marker a -> Bool
toList :: forall a. Marker a -> [a]
$ctoList :: forall a. Marker a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Marker a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Marker a -> a
foldr1 :: forall a. (a -> a -> a) -> Marker a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Marker a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Marker a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Marker a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Marker a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Marker a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Marker a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Marker a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Marker a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Marker a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Marker a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Marker a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Marker a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Marker a -> m
fold :: forall m. Monoid m => Marker m -> m
$cfold :: forall m. Monoid m => Marker m -> m
Foldable, Functor Marker
Foldable Marker
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Marker (m a) -> m (Marker a)
forall (f :: * -> *) a.
Applicative f =>
Marker (f a) -> f (Marker a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Marker a -> m (Marker b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Marker a -> f (Marker b)
sequence :: forall (m :: * -> *) a. Monad m => Marker (m a) -> m (Marker a)
$csequence :: forall (m :: * -> *) a. Monad m => Marker (m a) -> m (Marker a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Marker a -> m (Marker b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Marker a -> m (Marker b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Marker (f a) -> f (Marker a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Marker (f a) -> f (Marker a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Marker a -> f (Marker b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Marker a -> f (Marker b)
Traversable)
isBlank :: Marker msg -> Bool
isBlank :: forall a. Marker a -> Bool
isBlank = \case
Marker msg
Blank -> Bool
True
Marker msg
_ -> Bool
False
data Note msg
=
Note msg
|
Hint msg
deriving (Note msg -> Note msg -> Bool
forall msg. Eq msg => Note msg -> Note msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note msg -> Note msg -> Bool
$c/= :: forall msg. Eq msg => Note msg -> Note msg -> Bool
== :: Note msg -> Note msg -> Bool
$c== :: forall msg. Eq msg => Note msg -> Note msg -> Bool
Eq, Note msg -> Note msg -> Bool
Note msg -> Note msg -> Ordering
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
forall {msg}. Ord msg => Eq (Note msg)
forall msg. Ord msg => Note msg -> Note msg -> Bool
forall msg. Ord msg => Note msg -> Note msg -> Ordering
forall msg. Ord msg => Note msg -> Note msg -> Note msg
min :: Note msg -> Note msg -> Note msg
$cmin :: forall msg. Ord msg => Note msg -> Note msg -> Note msg
max :: Note msg -> Note msg -> Note msg
$cmax :: forall msg. Ord msg => Note msg -> Note msg -> Note msg
>= :: Note msg -> Note msg -> Bool
$c>= :: forall msg. Ord msg => Note msg -> Note msg -> Bool
> :: Note msg -> Note msg -> Bool
$c> :: forall msg. Ord msg => Note msg -> Note msg -> Bool
<= :: Note msg -> Note msg -> Bool
$c<= :: forall msg. Ord msg => Note msg -> Note msg -> Bool
< :: Note msg -> Note msg -> Bool
$c< :: forall msg. Ord msg => Note msg -> Note msg -> Bool
compare :: Note msg -> Note msg -> Ordering
$ccompare :: forall msg. Ord msg => Note msg -> Note msg -> Ordering
Ord, Int -> Note msg -> ShowS
forall msg. Show msg => Int -> Note msg -> ShowS
forall msg. Show msg => [Note msg] -> ShowS
forall msg. Show msg => Note msg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note msg] -> ShowS
$cshowList :: forall msg. Show msg => [Note msg] -> ShowS
show :: Note msg -> String
$cshow :: forall msg. Show msg => Note msg -> String
showsPrec :: Int -> Note msg -> ShowS
$cshowsPrec :: forall msg. Show msg => Int -> Note msg -> ShowS
Show, forall a b. a -> Note b -> Note a
forall a b. (a -> b) -> Note a -> Note b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Note b -> Note a
$c<$ :: forall a b. a -> Note b -> Note a
fmap :: forall a b. (a -> b) -> Note a -> Note b
$cfmap :: forall a b. (a -> b) -> Note a -> Note b
Functor, forall a. Eq a => a -> Note a -> Bool
forall a. Num a => Note a -> a
forall a. Ord a => Note a -> a
forall m. Monoid m => Note m -> m
forall a. Note a -> Bool
forall a. Note a -> Int
forall a. Note a -> [a]
forall a. (a -> a -> a) -> Note a -> a
forall m a. Monoid m => (a -> m) -> Note a -> m
forall b a. (b -> a -> b) -> b -> Note a -> b
forall a b. (a -> b -> b) -> b -> Note a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Note a -> a
$cproduct :: forall a. Num a => Note a -> a
sum :: forall a. Num a => Note a -> a
$csum :: forall a. Num a => Note a -> a
minimum :: forall a. Ord a => Note a -> a
$cminimum :: forall a. Ord a => Note a -> a
maximum :: forall a. Ord a => Note a -> a
$cmaximum :: forall a. Ord a => Note a -> a
elem :: forall a. Eq a => a -> Note a -> Bool
$celem :: forall a. Eq a => a -> Note a -> Bool
length :: forall a. Note a -> Int
$clength :: forall a. Note a -> Int
null :: forall a. Note a -> Bool
$cnull :: forall a. Note a -> Bool
toList :: forall a. Note a -> [a]
$ctoList :: forall a. Note a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Note a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Note a -> a
foldr1 :: forall a. (a -> a -> a) -> Note a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Note a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Note a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Note a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Note a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Note a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Note a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Note a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Note a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Note a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Note a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Note a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Note a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Note a -> m
fold :: forall m. Monoid m => Note m -> m
$cfold :: forall m. Monoid m => Note m -> m
Foldable, Functor Note
Foldable Note
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Note (m a) -> m (Note a)
forall (f :: * -> *) a. Applicative f => Note (f a) -> f (Note a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note a -> m (Note b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note a -> f (Note b)
sequence :: forall (m :: * -> *) a. Monad m => Note (m a) -> m (Note a)
$csequence :: forall (m :: * -> *) a. Monad m => Note (m a) -> m (Note a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note a -> m (Note b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note a -> m (Note b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Note (f a) -> f (Note a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Note (f a) -> f (Note a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note a -> f (Note b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note a -> f (Note b)
Traversable)
#ifdef USE_AESON
instance ToJSON msg => ToJSON (Note msg) where
toJSON :: Note msg -> Value
toJSON (Note msg
msg) = [Pair] -> Value
object [ Key
"note" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= msg
msg ]
toJSON (Hint msg
msg) = [Pair] -> Value
object [ Key
"hint" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= msg
msg ]
#endif
instance IsString msg => IsString (Note msg) where
fromString :: String -> Note msg
fromString = forall msg. msg -> Note msg
Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
warn,
err ::
Maybe msg ->
msg ->
[(Position, Marker msg)] ->
[Note msg] ->
Report msg
warn :: forall msg.
Maybe msg
-> msg -> [(Position, Marker msg)] -> [Note msg] -> Report msg
warn = forall msg.
Bool
-> Maybe msg
-> msg
-> [(Position, Marker msg)]
-> [Note msg]
-> Report msg
Report Bool
False
{-# INLINE warn #-}
{-# DEPRECATED warn "'warn' is deprecated. Use 'Warn' instead." #-}
err :: forall msg.
Maybe msg
-> msg -> [(Position, Marker msg)] -> [Note msg] -> Report msg
err = forall msg.
Bool
-> Maybe msg
-> msg
-> [(Position, Marker msg)]
-> [Note msg]
-> Report msg
Report Bool
True
{-# INLINE err #-}
{-# DEPRECATED err "'err' is deprecated. Use 'Err' instead." #-}
warningToError :: Report msg -> Report msg
warningToError :: forall msg. Report msg -> Report msg
warningToError (Report Bool
False Maybe msg
code msg
msg [(Position, Marker msg)]
markers [Note msg]
notes) = forall msg.
Bool
-> Maybe msg
-> msg
-> [(Position, Marker msg)]
-> [Note msg]
-> Report msg
Report Bool
True Maybe msg
code msg
msg [(Position, Marker msg)]
markers [Note msg]
notes
warningToError r :: Report msg
r@(Report Bool
True Maybe msg
_ msg
_ [(Position, Marker msg)]
_ [Note msg]
_) = Report msg
r
errorToWarning :: Report msg -> Report msg
errorToWarning :: forall msg. Report msg -> Report msg
errorToWarning (Report Bool
True Maybe msg
code msg
msg [(Position, Marker msg)]
markers [Note msg]
notes) = forall msg.
Bool
-> Maybe msg
-> msg
-> [(Position, Marker msg)]
-> [Note msg]
-> Report msg
Report Bool
False Maybe msg
code msg
msg [(Position, Marker msg)]
markers [Note msg]
notes
errorToWarning r :: Report msg
r@(Report Bool
False Maybe msg
_ msg
_ [(Position, Marker msg)]
_ [Note msg]
_) = Report msg
r
data WithUnicode = WithoutUnicode | WithUnicode
newtype TabSize = TabSize Int
prettyReport ::
FileMap ->
WithUnicode ->
TabSize ->
Report (Doc ann) ->
Doc (Annotation ann)
prettyReport :: forall ann.
FileMap
-> WithUnicode
-> TabSize
-> Report (Doc ann)
-> Doc (Annotation ann)
prettyReport FileMap
fileContent WithUnicode
withUnicode TabSize
tabSize (Report Bool
isError Maybe (Doc ann)
code Doc ann
message [(Position, Marker (Doc ann))]
markers [Note (Doc ann)]
hints) =
let sortedMarkers :: [(Position, Marker (Doc ann))]
sortedMarkers = forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Position, Marker (Doc ann))]
markers
groupedMarkers :: [(Bool, [(Position, Marker (Doc ann))])]
groupedMarkers = forall msg.
[(Position, Marker msg)] -> [(Bool, [(Position, Marker msg)])]
groupMarkersPerFile [(Position, Marker (Doc ann))]
sortedMarkers
maxLineNumberLength :: Int
maxLineNumberLength = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
3 (forall a. Ord a => a -> a -> a
max Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
end forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
List.safeLast [(Position, Marker (Doc ann))]
markers
header :: Doc (Annotation ann)
header =
forall ann. ann -> Doc ann -> Doc ann
annotate
(forall a. Bool -> Annotation a
KindColor Bool
isError)
( forall ann. Doc ann
lbracket
forall a. Semigroup a => a -> a -> a
<> ( if Bool
isError
then Doc (Annotation ann)
"error"
else Doc (Annotation ann)
"warning"
)
forall a. Semigroup a => a -> a -> a
<> case Maybe (Doc ann)
code of
Maybe (Doc ann)
Nothing -> forall ann. Doc ann
rbracket
Just Doc ann
code -> forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc (Annotation ann)
annotated Doc ann
code forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbracket
)
in
Doc (Annotation ann)
header forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc (Annotation ann)
annotated Doc ann
message)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall ann.
FileMap
-> WithUnicode
-> Bool
-> TabSize
-> Int
-> Bool
-> [(Position, Marker (Doc ann))]
-> Doc (Annotation ann)
prettySubReport FileMap
fileContent WithUnicode
withUnicode Bool
isError TabSize
tabSize Int
maxLineNumberLength) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, [(Position, Marker (Doc ann))])]
groupedMarkers)
forall a. Semigroup a => a -> a -> a
<> ( if
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note (Doc ann)]
hints Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Position, Marker (Doc ann))]
markers -> forall a. Monoid a => a
mempty
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note (Doc ann)]
hints -> forall a. Monoid a => a
mempty
| Bool
otherwise -> forall ann. Doc ann
hardline forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
maxLineNumberLength WithUnicode
withUnicode
)
forall a. Semigroup a => a -> a -> a
<> forall ann.
[Note (Doc ann)] -> Int -> WithUnicode -> Doc (Annotation ann)
prettyAllHints [Note (Doc ann)]
hints Int
maxLineNumberLength WithUnicode
withUnicode
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Position, Marker (Doc ann))]
markers Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note (Doc ann)]
hints
then forall a. Monoid a => a
mempty
else
forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall ann. Int -> Char -> Doc ann -> Doc ann
pad (Int
maxLineNumberLength forall a. Num a => a -> a -> a
+ Int
2) (forall a. a -> a -> WithUnicode -> a
unicode Char
'-' Char
'─' WithUnicode
withUnicode) forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"+" Doc (Annotation ann)
"╯" WithUnicode
withUnicode)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
)
pad :: Int -> Char -> Doc ann -> Doc ann
pad :: forall ann. Int -> Char -> Doc ann -> Doc ann
pad Int
n Char
c Doc ann
d = forall ann. Doc ann -> (Int -> Doc ann) -> Doc ann
width Doc ann
d \Int
w -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- Int
w) Char
c
dotPrefix ::
Int ->
WithUnicode ->
Doc (Annotation ann)
dotPrefix :: forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
leftLen WithUnicode
withUnicode =
forall ann. Int -> Char -> Doc ann -> Doc ann
pad Int
leftLen Char
' ' forall a. Monoid a => a
mempty
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
":" Doc (Annotation ann)
"•" WithUnicode
withUnicode)
{-# INLINE dotPrefix #-}
pipePrefix ::
Int ->
WithUnicode ->
Doc (Annotation ann)
pipePrefix :: forall ann. Int -> WithUnicode -> Doc (Annotation ann)
pipePrefix Int
leftLen WithUnicode
withUnicode = forall ann. Int -> Char -> Doc ann -> Doc ann
pad Int
leftLen Char
' ' forall a. Monoid a => a
mempty forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"|" Doc (Annotation ann)
"│" WithUnicode
withUnicode)
{-# INLINE pipePrefix #-}
linePrefix ::
Int ->
Int ->
WithUnicode ->
Doc (Annotation ann)
linePrefix :: forall ann. Int -> Int -> WithUnicode -> Doc (Annotation ann)
linePrefix Int
leftLen Int
lineNo WithUnicode
withUnicode =
let lineNoLen :: Int
lineNoLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Show a => a -> String
show Int
lineNo)
in forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Int -> Char -> Doc ann -> Doc ann
pad (Int
leftLen forall a. Num a => a -> a -> a
- Int
lineNoLen) Char
' ' forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
lineNo forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"|" Doc (Annotation ann)
"│" WithUnicode
withUnicode
{-# INLINE linePrefix #-}
ellipsisPrefix ::
Int ->
WithUnicode ->
Doc (Annotation ann)
ellipsisPrefix :: forall ann. Int -> WithUnicode -> Doc (Annotation ann)
ellipsisPrefix Int
leftLen WithUnicode
withUnicode = forall ann. Int -> Char -> Doc ann -> Doc ann
pad Int
leftLen Char
' ' forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"..." (forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> Doc (Annotation ann)
"⋮") WithUnicode
withUnicode)
groupMarkersPerFile ::
[(Position, Marker msg)] ->
[(Bool, [(Position, Marker msg)])]
groupMarkersPerFile :: forall msg.
[(Position, Marker msg)] -> [(Bool, [(Position, Marker msg)])]
groupMarkersPerFile [] = []
groupMarkersPerFile [(Position, Marker msg)]
markers =
let markersPerFile :: HashMap String [(Position, Marker msg)]
markersPerFile = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith forall a. Semigroup a => a -> a -> a
(<>)) forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ [(Position, Marker msg)]
markers forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \tup :: (Position, Marker msg)
tup@(Position
p, Marker msg
_) -> forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (Position -> String
file Position
p) [(Position, Marker msg)
tup]
in
forall {b}. [b] -> [(Bool, b)]
onlyFirstToTrue forall a b. (a -> b) -> a -> b
$ forall {a} {msg}. [[(a, Marker msg)]] -> [[(a, Marker msg)]]
putThisMarkersAtTop forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
HashMap.elems HashMap String [(Position, Marker msg)]
markersPerFile
where
onlyFirstToTrue :: [b] -> [(Bool, b)]
onlyFirstToTrue = forall {b}. Bool -> [(Bool, b)] -> [b] -> [(Bool, b)]
go Bool
True []
go :: Bool -> [(Bool, b)] -> [b] -> [(Bool, b)]
go Bool
_ [(Bool, b)]
acc [] = forall a. [a] -> [a]
reverse [(Bool, b)]
acc
go Bool
t [(Bool, b)]
acc (b
x : [b]
xs) = Bool -> [(Bool, b)] -> [b] -> [(Bool, b)]
go Bool
False ((Bool
t, b
x) forall a. a -> [a] -> [a]
: [(Bool, b)]
acc) [b]
xs
putThisMarkersAtTop :: [[(a, Marker msg)]] -> [[(a, Marker msg)]]
putThisMarkersAtTop = forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy \[(a, Marker msg)]
ms1 [(a, Marker msg)]
ms2 ->
if
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Marker a -> Bool
isThisMarker (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Marker msg)]
ms1) -> Ordering
LT
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Marker a -> Bool
isThisMarker (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Marker msg)]
ms2) -> Ordering
GT
| Bool
otherwise -> Ordering
EQ
prettySubReport ::
FileMap ->
WithUnicode ->
Bool ->
TabSize ->
Int ->
Bool ->
[(Position, Marker (Doc ann))] ->
Doc (Annotation ann)
prettySubReport :: forall ann.
FileMap
-> WithUnicode
-> Bool
-> TabSize
-> Int
-> Bool
-> [(Position, Marker (Doc ann))]
-> Doc (Annotation ann)
prettySubReport FileMap
fileContent WithUnicode
withUnicode Bool
isError TabSize
tabSize Int
maxLineNumberLength Bool
isFirst [(Position, Marker (Doc ann))]
markers =
let (HashMap Int [(Position, Marker (Doc ann))]
markersPerLine, [(Position, Marker (Doc ann))]
multilineMarkers) = forall msg.
[(Position, Marker msg)]
-> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)])
splitMarkersPerLine [(Position, Marker (Doc ann))]
markers
sortedMarkersPerLine :: [(Int, [(Position, Marker (Doc ann))])]
sortedMarkersPerLine = forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Int [(Position, Marker (Doc ann))]
markersPerLine)
reportFile :: Doc ann
reportFile = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a ann. Pretty a => a -> Doc ann
pretty @Position forall a. Default a => a
def) (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
List.safeHead (forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Position, Marker (Doc ann))]
markers)
allLineNumbers :: [Int]
allLineNumbers = forall a. Ord a => [a] -> [a]
List.sort forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
List.nub forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, [(Position, Marker (Doc ann))])]
sortedMarkersPerLine) forall a. Semigroup a => a -> a -> a
<> ([(Position, Marker (Doc ann))]
multilineMarkers forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Position (Int
bl, Int
_) (Int
el, Int
_) String
_, Marker (Doc ann)
_) -> [Int
bl .. Int
el])
fileMarker :: Doc (Annotation a)
fileMarker =
( if Bool
isFirst
then
forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Char -> Doc ann -> Doc ann
pad Int
maxLineNumberLength Char
' ' forall a. Monoid a => a
mempty
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation a)
"+-->" Doc (Annotation a)
"╭──▶" WithUnicode
withUnicode)
else
forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
maxLineNumberLength WithUnicode
withUnicode forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall ann. Int -> Char -> Doc ann -> Doc ann
pad (Int
maxLineNumberLength forall a. Num a => a -> a -> a
+ Int
2) (forall a. a -> a -> WithUnicode -> a
unicode Char
'-' Char
'─' WithUnicode
withUnicode) forall a. Monoid a => a
mempty)
forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
RuleColor (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation a)
"+-->" Doc (Annotation a)
"┼──▶" WithUnicode
withUnicode)
)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
FileColor forall ann. Doc ann
reportFile
in forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall {a}. Doc (Annotation a)
fileMarker
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
pipePrefix Int
maxLineNumberLength WithUnicode
withUnicode
forall a. Semigroup a => a -> a -> a
<> forall ann.
FileMap
-> WithUnicode
-> Bool
-> TabSize
-> Int
-> [(Int, [(Position, Marker (Doc ann))])]
-> [(Position, Marker (Doc ann))]
-> [Int]
-> Doc (Annotation ann)
prettyAllLines FileMap
fileContent WithUnicode
withUnicode Bool
isError TabSize
tabSize Int
maxLineNumberLength [(Int, [(Position, Marker (Doc ann))])]
sortedMarkersPerLine [(Position, Marker (Doc ann))]
multilineMarkers [Int]
allLineNumbers
isThisMarker :: Marker msg -> Bool
isThisMarker :: forall a. Marker a -> Bool
isThisMarker (This msg
_) = Bool
True
isThisMarker Marker msg
_ = Bool
False
splitMarkersPerLine :: [(Position, Marker msg)] -> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)])
splitMarkersPerLine :: forall msg.
[(Position, Marker msg)]
-> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)])
splitMarkersPerLine [] = (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
splitMarkersPerLine (m :: (Position, Marker msg)
m@(Position {String
(Int, Int)
file :: String
end :: (Int, Int)
begin :: (Int, Int)
file :: Position -> String
end :: Position -> (Int, Int)
begin :: Position -> (Int, Int)
..}, Marker msg
_) : [(Position, Marker msg)]
ms) =
let (Int
bl, Int
_) = (Int, Int)
begin
(Int
el, Int
_) = (Int, Int)
end
in (if Int
bl forall a. Eq a => a -> a -> Bool
== Int
el then forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith forall a. Semigroup a => a -> a -> a
(<>) Int
bl [(Position, Marker msg)
m]) else forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Position, Marker msg)
m forall a. a -> [a] -> [a]
:))
(forall msg.
[(Position, Marker msg)]
-> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)])
splitMarkersPerLine [(Position, Marker msg)]
ms)
prettyAllLines ::
FileMap ->
WithUnicode ->
Bool ->
TabSize ->
Int ->
[(Int, [(Position, Marker (Doc ann))])] ->
[(Position, Marker (Doc ann))] ->
[Int] ->
Doc (Annotation ann)
prettyAllLines :: forall ann.
FileMap
-> WithUnicode
-> Bool
-> TabSize
-> Int
-> [(Int, [(Position, Marker (Doc ann))])]
-> [(Position, Marker (Doc ann))]
-> [Int]
-> Doc (Annotation ann)
prettyAllLines FileMap
files WithUnicode
withUnicode Bool
isError TabSize
tabSize Int
leftLen [(Int, [(Position, Marker (Doc ann))])]
inline [(Position, Marker (Doc ann))]
multiline [Int]
lineNumbers =
case [Int]
lineNumbers of
[] ->
forall {a} {ann}.
Bool -> [(a, Marker (Doc ann))] -> Doc (Annotation ann)
showMultiline Bool
True [(Position, Marker (Doc ann))]
multiline
[Int
l] ->
let ([(Position, Marker (Doc ann))]
ms, Doc (Annotation ann)
doc) = Bool
-> Int -> ([(Position, Marker (Doc ann))], Doc (Annotation ann))
showForLine Bool
True Int
l
in Doc (Annotation ann)
doc
forall a. Semigroup a => a -> a -> a
<> forall ann.
FileMap
-> WithUnicode
-> Bool
-> TabSize
-> Int
-> [(Int, [(Position, Marker (Doc ann))])]
-> [(Position, Marker (Doc ann))]
-> [Int]
-> Doc (Annotation ann)
prettyAllLines FileMap
files WithUnicode
withUnicode Bool
isError TabSize
tabSize Int
leftLen [(Int, [(Position, Marker (Doc ann))])]
inline [(Position, Marker (Doc ann))]
ms []
Int
l1 : Int
l2 : [Int]
ls ->
let ([(Position, Marker (Doc ann))]
ms, Doc (Annotation ann)
doc) = Bool
-> Int -> ([(Position, Marker (Doc ann))], Doc (Annotation ann))
showForLine Bool
False Int
l1
in Doc (Annotation ann)
doc
forall a. Semigroup a => a -> a -> a
<> (if Int
l2 forall a. Eq a => a -> a -> Bool
/= Int
l1 forall a. Num a => a -> a -> a
+ Int
1 then forall ann. Doc ann
hardline forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
leftLen WithUnicode
withUnicode else forall a. Monoid a => a
mempty)
forall a. Semigroup a => a -> a -> a
<> forall ann.
FileMap
-> WithUnicode
-> Bool
-> TabSize
-> Int
-> [(Int, [(Position, Marker (Doc ann))])]
-> [(Position, Marker (Doc ann))]
-> [Int]
-> Doc (Annotation ann)
prettyAllLines FileMap
files WithUnicode
withUnicode Bool
isError TabSize
tabSize Int
leftLen [(Int, [(Position, Marker (Doc ann))])]
inline [(Position, Marker (Doc ann))]
ms (Int
l2 forall a. a -> [a] -> [a]
: [Int]
ls)
where
showForLine :: Bool
-> Int -> ([(Position, Marker (Doc ann))], Doc (Annotation ann))
showForLine Bool
isLastLine Int
line =
let allInlineMarkersInLine :: [(Position, Marker (Doc ann))]
allInlineMarkersInLine = forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) Int
line forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Int, [(Position, Marker (Doc ann))])]
inline
allMultilineMarkersInLine :: [(Position, Marker (Doc ann))]
allMultilineMarkersInLine = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> [a] -> [a]
filter [(Position, Marker (Doc ann))]
multiline \(Position (Int
bl, Int
_) (Int
el, Int
_) String
_, Marker (Doc ann)
_) -> Int
bl forall a. Eq a => a -> a -> Bool
== Int
line Bool -> Bool -> Bool
|| Int
el forall a. Eq a => a -> a -> Bool
== Int
line
allMultilineMarkersSpanningLine :: [(Position, Marker (Doc ann))]
allMultilineMarkersSpanningLine = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> [a] -> [a]
filter [(Position, Marker (Doc ann))]
multiline \(Position (Int
bl, Int
_) (Int
el, Int
_) String
_, Marker (Doc ann)
_) -> Int
bl forall a. Ord a => a -> a -> Bool
< Int
line Bool -> Bool -> Bool
&& Int
el forall a. Ord a => a -> a -> Bool
> Int
line
inSpanOfMultiline :: Bool
inSpanOfMultiline = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [(Position, Marker (Doc ann))]
multiline \(Position (Int
bl, Int
_) (Int
el, Int
_) String
_, Marker (Doc ann)
_) -> Int
bl forall a. Ord a => a -> a -> Bool
<= Int
line Bool -> Bool -> Bool
&& Int
el forall a. Ord a => a -> a -> Bool
>= Int
line
colorOfFirstMultilineMarker :: Doc (Annotation ann) -> Doc (Annotation ann)
colorOfFirstMultilineMarker = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall ann. ann -> Doc ann -> Doc ann
annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. [a] -> Maybe a
List.safeHead forall a b. (a -> b) -> a -> b
$ [(Position, Marker (Doc ann))]
allMultilineMarkersInLine forall a. Semigroup a => a -> a -> a
<> [(Position, Marker (Doc ann))]
allMultilineMarkersSpanningLine)
([(Position, Marker (Doc ann))]
multilineEndingOnLine, [(Position, Marker (Doc ann))]
otherMultilines) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition [(Position, Marker (Doc ann))]
multiline \(Position (Int, Int)
_ (Int
el, Int
_) String
_, Marker (Doc ann)
_) -> Int
el forall a. Eq a => a -> a -> Bool
== Int
line
shouldShowMultiLine :: Bool
shouldShowMultiLine = Bool
isLastLine
Bool -> Bool -> Bool
|| (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Functor f => f a -> f ()
void)) (forall a. [a] -> Maybe a
List.safeLast [(Position, Marker (Doc ann))]
multilineEndingOnLine) (forall a. [a] -> Maybe a
List.safeLast [(Position, Marker (Doc ann))]
multiline)
!additionalPrefix :: Doc (Annotation ann)
additionalPrefix = case [(Position, Marker (Doc ann))]
allMultilineMarkersInLine of
[] ->
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Position, Marker (Doc ann))]
multiline
then
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Position, Marker (Doc ann))]
allMultilineMarkersSpanningLine
then forall {ann}. Doc (Annotation ann) -> Doc (Annotation ann)
colorOfFirstMultilineMarker (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"| " Doc (Annotation ann)
"│ " WithUnicode
withUnicode)
else Doc (Annotation ann)
" "
else forall a. Monoid a => a
mempty
(p :: Position
p@(Position (Int, Int)
_ (Int
el, Int
_) String
_), Marker (Doc ann)
marker) : [(Position, Marker (Doc ann))]
_ ->
let hasPredecessor :: Bool
hasPredecessor = Int
el forall a. Eq a => a -> a -> Bool
== Int
line Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
(/=) Position
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. [a] -> Maybe (a, [a])
List.safeUncons [(Position, Marker (Doc ann))]
multiline)
in forall {ann}. Doc (Annotation ann) -> Doc (Annotation ann)
colorOfFirstMultilineMarker
(forall a. a -> a -> WithUnicode -> a
unicode (forall a. a -> a -> Bool -> a
bool Doc (Annotation ann)
"+" Doc (Annotation ann)
"|" Bool
hasPredecessor ) (forall a. a -> a -> Bool -> a
bool Doc (Annotation ann)
"╭" Doc (Annotation ann)
"├" Bool
hasPredecessor) WithUnicode
withUnicode)
forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate (forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
marker) (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
">" Doc (Annotation ann)
"┤" WithUnicode
withUnicode)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space
allInlineMarkersInLine' :: [(Position, Marker (Doc ann))]
allInlineMarkersInLine' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Marker a -> Bool
isBlank forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Position, Marker (Doc ann))]
allInlineMarkersInLine
allMultilineMarkersSpanningLine' :: [(Position, Marker (Doc ann))]
allMultilineMarkersSpanningLine' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Marker a -> Bool
isBlank forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Position, Marker (Doc ann))]
allMultilineMarkersSpanningLine
(WidthTable
widths, Doc (Annotation ann)
renderedCode) = forall msg ann.
FileMap
-> [(Position, Marker msg)]
-> Int
-> TabSize
-> Bool
-> (WidthTable, Doc (Annotation ann))
getLine_ FileMap
files ([(Position, Marker (Doc ann))]
allInlineMarkersInLine forall a. Semigroup a => a -> a -> a
<> [(Position, Marker (Doc ann))]
allMultilineMarkersInLine forall a. Semigroup a => a -> a -> a
<> [(Position, Marker (Doc ann))]
allMultilineMarkersSpanningLine') Int
line TabSize
tabSize Bool
isError
in ( [(Position, Marker (Doc ann))]
otherMultilines,
forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Int -> WithUnicode -> Doc (Annotation ann)
linePrefix Int
leftLen Int
line WithUnicode
withUnicode forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {a}. Doc (Annotation a)
additionalPrefix
forall a. Semigroup a => a -> a -> a
<> forall {a}. Doc (Annotation a)
renderedCode
forall a. Semigroup a => a -> a -> a
<> forall ann.
Bool
-> Bool
-> (Doc (Annotation ann) -> Doc (Annotation ann))
-> WithUnicode
-> Bool
-> Int
-> WidthTable
-> [(Position, Marker (Doc ann))]
-> Doc (Annotation ann)
showAllMarkersInLine (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Position, Marker (Doc ann))]
multiline) Bool
inSpanOfMultiline forall {ann}. Doc (Annotation ann) -> Doc (Annotation ann)
colorOfFirstMultilineMarker WithUnicode
withUnicode Bool
isError Int
leftLen WidthTable
widths [(Position, Marker (Doc ann))]
allInlineMarkersInLine'
forall a. Semigroup a => a -> a -> a
<> forall {a} {ann}.
Bool -> [(a, Marker (Doc ann))] -> Doc (Annotation ann)
showMultiline Bool
shouldShowMultiLine [(Position, Marker (Doc ann))]
multilineEndingOnLine
)
showMultiline :: Bool -> [(a, Marker (Doc ann))] -> Doc (Annotation ann)
showMultiline Bool
_ [] = forall a. Monoid a => a
mempty
showMultiline Bool
isLastMultiline [(a, Marker (Doc ann))]
multiline =
let colorOfFirstMultilineMarker :: Maybe (Annotation ann)
colorOfFirstMultilineMarker = forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
List.safeHead [(a, Marker (Doc ann))]
multiline
prefix :: Doc (Annotation ann)
prefix = forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
leftLen WithUnicode
withUnicode forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space
prefixWithBar :: Maybe (Annotation ann) -> Doc (Annotation ann)
prefixWithBar Maybe (Annotation ann)
color = forall {a}. Doc (Annotation a)
prefix forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall ann. ann -> Doc ann -> Doc ann
annotate Maybe (Annotation ann)
color (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"| " Doc (Annotation ann)
"│ " WithUnicode
withUnicode)
showMultilineMarkerMessage :: (a, Marker (Doc ann)) -> Bool -> Doc (Annotation ann)
showMultilineMarkerMessage (a
_, Marker (Doc ann)
Blank) Bool
_ = forall a. Monoid a => a
mempty
showMultilineMarkerMessage (a
_, Marker (Doc ann)
marker) Bool
isLast =
forall ann. ann -> Doc ann -> Doc ann
annotate (forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
marker) forall a b. (a -> b) -> a -> b
$
( if Bool
isLast Bool -> Bool -> Bool
&& Bool
isLastMultiline
then forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"`- " Doc (Annotation ann)
"╰╸ " WithUnicode
withUnicode
else forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"|- " Doc (Annotation ann)
"├╸ " WithUnicode
withUnicode
)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Int -> Doc ann -> Doc ann
replaceLinesWith (if Bool
isLast then forall {a}. Doc (Annotation a)
prefix forall a. Semigroup a => a -> a -> a
<> Doc (Annotation ann)
" " else forall {ann}. Maybe (Annotation ann) -> Doc (Annotation ann)
prefixWithBar (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
marker) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space) Int
0 (forall ann. Doc ann -> Doc (Annotation ann)
annotated forall a b. (a -> b) -> a -> b
$ forall msg. Marker msg -> msg
markerMessage Marker (Doc ann)
marker)
showMultilineMarkerMessages :: [(a, Marker (Doc ann))] -> [Doc (Annotation ann)]
showMultilineMarkerMessages [] = []
showMultilineMarkerMessages [(a, Marker (Doc ann))
m] = [forall {a} {ann}.
(a, Marker (Doc ann)) -> Bool -> Doc (Annotation ann)
showMultilineMarkerMessage (a, Marker (Doc ann))
m Bool
True]
showMultilineMarkerMessages ((a, Marker (Doc ann))
m : [(a, Marker (Doc ann))]
ms) = forall {a} {ann}.
(a, Marker (Doc ann)) -> Bool -> Doc (Annotation ann)
showMultilineMarkerMessage (a, Marker (Doc ann))
m Bool
False forall a. a -> [a] -> [a]
: [(a, Marker (Doc ann))] -> [Doc (Annotation ann)]
showMultilineMarkerMessages [(a, Marker (Doc ann))]
ms
in forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall {ann}. Maybe (Annotation ann) -> Doc (Annotation ann)
prefixWithBar forall {ann}. Maybe (Annotation ann)
colorOfFirstMultilineMarker forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall {a}. Doc (Annotation a)
prefix forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. a -> [a] -> [a]
List.intersperse (forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall {a}. Doc (Annotation a)
prefix) forall a b. (a -> b) -> a -> b
$ forall {a} {ann}. [(a, Marker (Doc ann))] -> [Doc (Annotation ann)]
showMultilineMarkerMessages [(a, Marker (Doc ann))]
multiline)
getLine_ ::
FileMap ->
[(Position, Marker msg)] ->
Int ->
TabSize ->
Bool ->
(WidthTable, Doc (Annotation ann))
getLine_ :: forall msg ann.
FileMap
-> [(Position, Marker msg)]
-> Int
-> TabSize
-> Bool
-> (WidthTable, Doc (Annotation ann))
getLine_ FileMap
files [(Position, Marker msg)]
markers Int
line (TabSize Int
tabSize) Bool
isError =
case forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
i -> a i e -> Maybe e
safeArrayIndex (Int
line forall a. Num a => a -> a -> a
- Int
1) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
(HashMap.!?) FileMap
files forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> String
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> Maybe a
List.safeHead [(Position, Marker msg)]
markers of
Maybe String
Nothing ->
( String -> WidthTable
mkWidthTable String
"",
forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
NoLineColor Doc (Annotation ann)
"<no line>"
)
Just String
code ->
( String -> WidthTable
mkWidthTable String
code,
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] String
code) \(Int
n, Char
c) ->
let cdoc :: Doc ann
cdoc = forall a. a -> (Char -> a) -> Char -> a
ifTab (forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Int -> a -> [a]
replicate Int
tabSize Char
' ')) forall a ann. Pretty a => a -> Doc ann
pretty Char
c
colorizingMarkers :: [(Position, Marker msg)]
colorizingMarkers = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> [a] -> [a]
filter [(Position, Marker msg)]
markers \case
(Position (Int
bl, Int
bc) (Int
el, Int
ec) String
_, Marker msg
_)
| Int
bl forall a. Eq a => a -> a -> Bool
== Int
el ->
Int
n forall a. Ord a => a -> a -> Bool
>= Int
bc Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
< Int
ec
| Bool
otherwise ->
(Int
bl forall a. Eq a => a -> a -> Bool
== Int
line Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
bc)
Bool -> Bool -> Bool
|| (Int
el forall a. Eq a => a -> a -> Bool
== Int
line Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
< Int
ec)
Bool -> Bool -> Bool
|| (Int
bl forall a. Ord a => a -> a -> Bool
< Int
line Bool -> Bool -> Bool
&& Int
el forall a. Ord a => a -> a -> Bool
> Int
line)
in forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
CodeStyle)
((\Marker msg
m -> forall ann. ann -> Doc ann -> Doc ann
annotate (forall a. Annotation a -> Annotation a
MarkerStyle forall a b. (a -> b) -> a -> b
$ forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker msg
m)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
(forall a. [a] -> Maybe a
List.safeHead [(Position, Marker msg)]
colorizingMarkers)
forall ann. Doc ann
cdoc
)
where
ifTab :: a -> (Char -> a) -> Char -> a
ifTab :: forall a. a -> (Char -> a) -> Char -> a
ifTab a
a Char -> a
_ Char
'\t' = a
a
ifTab a
_ Char -> a
f Char
c = Char -> a
f Char
c
mkWidthTable :: String -> WidthTable
mkWidthTable :: String -> WidthTable
mkWidthTable String
s = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1, forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (forall a. a -> (Char -> a) -> Char -> a
ifTab Int
tabSize Char -> Int
wcwidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s)
showAllMarkersInLine :: Bool -> Bool -> (Doc (Annotation ann) -> Doc (Annotation ann)) -> WithUnicode -> Bool -> Int -> WidthTable -> [(Position, Marker (Doc ann))] -> Doc (Annotation ann)
showAllMarkersInLine :: forall ann.
Bool
-> Bool
-> (Doc (Annotation ann) -> Doc (Annotation ann))
-> WithUnicode
-> Bool
-> Int
-> WidthTable
-> [(Position, Marker (Doc ann))]
-> Doc (Annotation ann)
showAllMarkersInLine Bool
_ Bool
_ Doc (Annotation ann) -> Doc (Annotation ann)
_ WithUnicode
_ Bool
_ Int
_ WidthTable
_ [] = forall a. Monoid a => a
mempty
showAllMarkersInLine Bool
hasMultilines Bool
inSpanOfMultiline Doc (Annotation ann) -> Doc (Annotation ann)
colorMultilinePrefix WithUnicode
withUnicode Bool
isError Int
leftLen WidthTable
widths [(Position, Marker (Doc ann))]
ms =
let maxMarkerColumn :: Int
maxMarkerColumn = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Position -> (Int, Int)
end forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
List.last forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
end forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Position, Marker (Doc ann))]
ms
specialPrefix :: Doc (Annotation ann)
specialPrefix
| Bool
inSpanOfMultiline = Doc (Annotation ann) -> Doc (Annotation ann)
colorMultilinePrefix (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"| " Doc (Annotation ann)
"│ " WithUnicode
withUnicode) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space
| Bool
hasMultilines = Doc (Annotation ann) -> Doc (Annotation ann)
colorMultilinePrefix Doc (Annotation ann)
" " forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space
| Bool
otherwise = forall a. Monoid a => a
mempty
in
forall ann. Doc ann
hardline forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
leftLen WithUnicode
withUnicode forall ann. Doc ann -> Doc ann -> Doc ann
<+> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Position, Marker (Doc ann))]
ms then forall a. Monoid a => a
mempty else Doc (Annotation ann)
specialPrefix forall a. Semigroup a => a -> a -> a
<> forall {ann}. Int -> Int -> Doc (Annotation ann)
showMarkers Int
1 Int
maxMarkerColumn forall a. Semigroup a => a -> a -> a
<> forall {ann} {t}.
Doc (Annotation ann)
-> [(Position, Marker (Doc ann))] -> t -> Doc (Annotation ann)
showMessages Doc (Annotation ann)
specialPrefix [(Position, Marker (Doc ann))]
ms Int
maxMarkerColumn)
where
widthAt :: Int -> Int
widthAt Int
i = Int
0 forall a. a -> Maybe a -> a
`fromMaybe` forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
i -> a i e -> Maybe e
safeArrayIndex Int
i WidthTable
widths
widthsBetween :: Int -> Int -> Int
widthsBetween Int
start Int
end =
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
end forall a. Num a => a -> a -> a
- Int
start) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
start forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems WidthTable
widths
showMarkers :: Int -> Int -> Doc (Annotation ann)
showMarkers Int
n Int
lineLen
| Int
n forall a. Ord a => a -> a -> Bool
> Int
lineLen = forall a. Monoid a => a
mempty
| Bool
otherwise =
let allMarkers :: [(Position, Marker (Doc ann))]
allMarkers = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> [a] -> [a]
filter [(Position, Marker (Doc ann))]
ms \(Position (Int
_, Int
bc) (Int
_, Int
ec) String
_, Marker (Doc ann)
mark) -> Bool -> Bool
not (forall a. Marker a -> Bool
isBlank Marker (Doc ann)
mark) Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
bc Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
< Int
ec
in
case [(Position, Marker (Doc ann))]
allMarkers of
[] -> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. Int -> a -> [a]
replicate (Int -> Int
widthAt Int
n) forall ann. Doc ann
space) forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Doc (Annotation ann)
showMarkers (Int
n forall a. Num a => a -> a -> a
+ Int
1) Int
lineLen
(Position {String
(Int, Int)
file :: String
end :: (Int, Int)
begin :: (Int, Int)
file :: Position -> String
end :: Position -> (Int, Int)
begin :: Position -> (Int, Int)
..}, Marker (Doc ann)
marker) : [(Position, Marker (Doc ann))]
_ ->
forall ann. ann -> Doc ann -> Doc ann
annotate
(forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
marker)
( if forall a b. (a, b) -> b
snd (Int, Int)
begin forall a. Eq a => a -> a -> Bool
== Int
n
then forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"^" Doc (Annotation ann)
"┬" WithUnicode
withUnicode forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. Int -> a -> [a]
replicate (Int -> Int
widthAt Int
n forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"-" Doc (Annotation ann)
"─" WithUnicode
withUnicode))
else forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. Int -> a -> [a]
replicate (Int -> Int
widthAt Int
n) (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"-" Doc (Annotation ann)
"─" WithUnicode
withUnicode))
)
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Doc (Annotation ann)
showMarkers (Int
n forall a. Num a => a -> a -> a
+ Int
1) Int
lineLen
showMessages :: Doc (Annotation ann)
-> [(Position, Marker (Doc ann))] -> t -> Doc (Annotation ann)
showMessages Doc (Annotation ann)
specialPrefix [(Position, Marker (Doc ann))]
ms t
lineLen = case forall a. [a] -> Maybe (a, [a])
List.safeUncons [(Position, Marker (Doc ann))]
ms of
Maybe
((Position, Marker (Doc ann)), [(Position, Marker (Doc ann))])
Nothing -> forall a. Monoid a => a
mempty
Just ((Position b :: (Int, Int)
b@(Int
_, Int
bc) (Int, Int)
_ String
_, Marker (Doc ann)
msg), [(Position, Marker (Doc ann))]
pipes) ->
let filteredPipes :: [(Position, Marker (Doc ann))]
filteredPipes = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((forall a. Eq a => a -> a -> Bool
/= (Int, Int)
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin) (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Marker a -> Bool
isBlank)) [(Position, Marker (Doc ann))]
pipes
nubbedPipes :: [(Position, Marker (Doc ann))]
nubbedPipes = forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) [(Position, Marker (Doc ann))]
filteredPipes
allColumns :: Int -> [(Position, Doc ann)] -> (a, [Doc ann])
allColumns Int
_ [] = (a
1, [])
allColumns Int
n ms :: [(Position, Doc ann)]
ms@((Position (Int
_, Int
bc) (Int, Int)
_ String
_, Doc ann
col) : [(Position, Doc ann)]
ms')
| Int
n forall a. Eq a => a -> a -> Bool
== Int
bc = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. Num a => a -> a -> a
+ a
1) (Doc ann
col forall a. a -> [a] -> [a]
:) (Int -> [(Position, Doc ann)] -> (a, [Doc ann])
allColumns (Int
n forall a. Num a => a -> a -> a
+ Int
1) [(Position, Doc ann)]
ms')
| Int
n forall a. Ord a => a -> a -> Bool
< Int
bc = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. Num a => a -> a -> a
+ a
1) (forall a. Int -> a -> [a]
replicate (Int -> Int
widthAt Int
n) forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<>) (Int -> [(Position, Doc ann)] -> (a, [Doc ann])
allColumns (Int
n forall a. Num a => a -> a -> a
+ Int
1) [(Position, Doc ann)]
ms)
| Bool
otherwise = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. Num a => a -> a -> a
+ a
1) (forall a. Int -> a -> [a]
replicate (Int -> Int
widthAt Int
n) forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<>) (Int -> [(Position, Doc ann)] -> (a, [Doc ann])
allColumns (Int
n forall a. Num a => a -> a -> a
+ Int
1) [(Position, Doc ann)]
ms')
hasSuccessor :: Bool
hasSuccessor = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Position, Marker (Doc ann))]
filteredPipes forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Position, Marker (Doc ann))]
pipes
lineStart :: [(Position, Doc (Annotation ann))] -> Doc (Annotation ann)
lineStart [(Position, Doc (Annotation ann))]
pipes =
let (Int
n, [Doc (Annotation ann)]
docs) = forall {a} {ann}.
Num a =>
Int -> [(Position, Doc ann)] -> (a, [Doc ann])
allColumns Int
1 forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Position, Doc (Annotation ann))]
pipes
numberOfSpaces :: Int
numberOfSpaces = Int -> Int -> Int
widthsBetween Int
n Int
bc
in forall ann. Int -> WithUnicode -> Doc (Annotation ann)
dotPrefix Int
leftLen WithUnicode
withUnicode forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc (Annotation ann)
specialPrefix forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Doc (Annotation ann)]
docs forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Int -> a -> [a]
replicate Int
numberOfSpaces Char
' ')
prefix :: Doc (Annotation ann)
prefix =
let ([(Position, Marker (Doc ann))]
pipesBefore, [(Position, Marker (Doc ann))]
pipesAfter) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ((forall a. Ord a => a -> a -> Bool
< Int
bc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Position, Marker (Doc ann))]
nubbedPipes
pipesBeforeRendered :: [(Position, Doc (Annotation ann))]
pipesBeforeRendered = [(Position, Marker (Doc ann))]
pipesBefore forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second \Marker (Doc ann)
marker -> forall ann. ann -> Doc ann -> Doc ann
annotate (forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
marker) (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"|" Doc (Annotation ann)
"│" WithUnicode
withUnicode)
lastBeginPosition :: Maybe Int
lastBeginPosition = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
List.safeLast (forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Position, Marker (Doc ann))]
pipesAfter)
lineLen :: Int
lineLen = case Maybe Int
lastBeginPosition of
Maybe Int
Nothing -> Int
0
Just Int
col -> Int -> Int -> Int
widthsBetween Int
bc Int
col
currentPipe :: Doc (Annotation ann)
currentPipe = forall a. a -> a -> WithUnicode -> a
unicode (forall a. a -> a -> Bool -> a
bool Doc (Annotation ann)
"`" Doc (Annotation ann)
"|" Bool
hasSuccessor) (forall a. a -> a -> Bool -> a
bool Doc (Annotation ann)
"╰" Doc (Annotation ann)
"├" Bool
hasSuccessor) WithUnicode
withUnicode
lineChar :: Char
lineChar = forall a. a -> a -> WithUnicode -> a
unicode Char
'-' Char
'─' WithUnicode
withUnicode
pointChar :: Doc (Annotation ann)
pointChar = forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"-" Doc (Annotation ann)
"╸" WithUnicode
withUnicode
bc' :: Int
bc' = Int
bc forall a. Num a => a -> a -> a
+ Int
lineLen forall a. Num a => a -> a -> a
+ Int
2
pipesBeforeMessageStart :: [(Position, Marker (Doc ann))]
pipesBeforeMessageStart = forall a. (a -> Bool) -> [a] -> [a]
List.filter ((forall a. Ord a => a -> a -> Bool
< Int
bc') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (Int, Int)
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Position, Marker (Doc ann))]
pipesAfter
pipesBeforeMessageRendered :: [(Position, Doc (Annotation ann))]
pipesBeforeMessageRendered = ([(Position, Marker (Doc ann))]
pipesBefore forall a. Semigroup a => a -> a -> a
<> [(Position, Marker (Doc ann))]
pipesBeforeMessageStart) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second \Marker (Doc ann)
marker -> forall ann. ann -> Doc ann -> Doc ann
annotate (forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
marker) (forall a. a -> a -> WithUnicode -> a
unicode Doc (Annotation ann)
"|" Doc (Annotation ann)
"│" WithUnicode
withUnicode)
in
[(Position, Doc (Annotation ann))] -> Doc (Annotation ann)
lineStart forall {ann}. [(Position, Doc (Annotation ann))]
pipesBeforeRendered
forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate (forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
msg) (Doc (Annotation ann)
currentPipe forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Int -> a -> [a]
replicate Int
lineLen Char
lineChar) forall a. Semigroup a => a -> a -> a
<> Doc (Annotation ann)
pointChar)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate (forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError Marker (Doc ann)
msg) (forall ann. Doc ann -> Int -> Doc ann -> Doc ann
replaceLinesWith (forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> [(Position, Doc (Annotation ann))] -> Doc (Annotation ann)
lineStart forall {ann}. [(Position, Doc (Annotation ann))]
pipesBeforeMessageRendered forall ann. Doc ann -> Doc ann -> Doc ann
<+> if forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Position, Marker (Doc ann))]
pipesBeforeMessageStart then Doc (Annotation ann)
" " else Doc (Annotation ann)
" ") Int
0 forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc (Annotation ann)
annotated forall a b. (a -> b) -> a -> b
$ forall msg. Marker msg -> msg
markerMessage Marker (Doc ann)
msg)
in forall ann. Doc ann
hardline forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc (Annotation ann)
prefix forall a. Semigroup a => a -> a -> a
<> Doc (Annotation ann)
-> [(Position, Marker (Doc ann))] -> t -> Doc (Annotation ann)
showMessages Doc (Annotation ann)
specialPrefix [(Position, Marker (Doc ann))]
pipes t
lineLen
replaceLinesWith :: Doc ann -> Int -> Doc ann -> Doc ann
replaceLinesWith :: forall ann. Doc ann -> Int -> Doc ann -> Doc ann
replaceLinesWith Doc ann
repl = Int -> Doc ann -> Doc ann
go
where
replWidth :: Int
replWidth = forall {ann}. SimpleDocStream ann -> Int
sdsWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact forall a b. (a -> b) -> a -> b
$ Doc ann
repl
sdsWidth :: SimpleDocStream ann -> Int
sdsWidth = \case
SimpleDocStream ann
SFail -> Int
0
SimpleDocStream ann
SEmpty -> Int
0
SChar Char
_ SimpleDocStream ann
sds -> Int
1 forall a. Num a => a -> a -> a
+ SimpleDocStream ann -> Int
sdsWidth SimpleDocStream ann
sds
SText Int
l Text
_ SimpleDocStream ann
sds -> Int
l forall a. Num a => a -> a -> a
+ SimpleDocStream ann -> Int
sdsWidth SimpleDocStream ann
sds
SLine Int
_ SimpleDocStream ann
_ -> forall a. HasCallStack => String -> a
error String
"replaceLinesWith was given a prefix with a line break"
SAnnPush ann
_ SimpleDocStream ann
sds -> SimpleDocStream ann -> Int
sdsWidth SimpleDocStream ann
sds
SAnnPop SimpleDocStream ann
sds -> SimpleDocStream ann -> Int
sdsWidth SimpleDocStream ann
sds
replWithNesting :: Int -> Doc ann
replWithNesting Int
n = forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
repl forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (Int -> Text
textSpaces Int
n)
go :: Int -> Doc ann -> Doc ann
go Int
n = \case
Doc ann
Line -> Int -> Doc ann
replWithNesting Int
n
Doc ann
Fail -> forall ann. Doc ann
Fail
Doc ann
Empty -> forall ann. Doc ann
Empty
Char Char
c -> forall ann. Char -> Doc ann
Char Char
c
Text Int
l Text
txt -> forall ann. Int -> Text -> Doc ann
Text Int
l Text
txt
FlatAlt Doc ann
f Doc ann
d -> forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt (Int -> Doc ann -> Doc ann
go Int
n Doc ann
f) (Int -> Doc ann -> Doc ann
go Int
n Doc ann
d)
Cat Doc ann
c Doc ann
d -> forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Int -> Doc ann -> Doc ann
go Int
n Doc ann
c) (Int -> Doc ann -> Doc ann
go Int
n Doc ann
d)
Nest Int
n' Doc ann
d -> Int -> Doc ann -> Doc ann
go (Int
n forall a. Num a => a -> a -> a
+ Int
n') Doc ann
d
Union Doc ann
c Doc ann
d -> forall ann. Doc ann -> Doc ann -> Doc ann
Union (Int -> Doc ann -> Doc ann
go Int
n Doc ann
c) (Int -> Doc ann -> Doc ann
go Int
n Doc ann
d)
Column Int -> Doc ann
f -> forall ann. (Int -> Doc ann) -> Doc ann
Column (Int -> Doc ann -> Doc ann
go Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)
Nesting Int -> Doc ann
f -> forall ann. (Int -> Doc ann) -> Doc ann
Nesting (Int -> Doc ann -> Doc ann
go Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
replWidth) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
n))
Annotated ann
ann Doc ann
doc -> forall ann. ann -> Doc ann -> Doc ann
Annotated ann
ann (Int -> Doc ann -> Doc ann
go Int
n Doc ann
doc)
WithPageWidth PageWidth -> Doc ann
f -> forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth (Int -> Doc ann -> Doc ann
go Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc ann
f)
markerColor ::
Bool ->
Marker msg ->
Annotation ann
markerColor :: forall msg ann. Bool -> Marker msg -> Annotation ann
markerColor Bool
isError (This msg
_) = forall a. Bool -> Annotation a
ThisColor Bool
isError
markerColor Bool
_ (Where msg
_) = forall a. Annotation a
WhereColor
markerColor Bool
_ (Maybe msg
_) = forall a. Annotation a
MaybeColor
markerColor Bool
_ Marker msg
Blank = forall a. Annotation a
CodeStyle
{-# INLINE markerColor #-}
markerMessage :: Marker msg -> msg
markerMessage :: forall msg. Marker msg -> msg
markerMessage (This msg
m) = msg
m
markerMessage (Where msg
m) = msg
m
markerMessage (Maybe msg
m) = msg
m
markerMessage Marker msg
Blank = forall a. HasCallStack => a
undefined
{-# INLINE markerMessage #-}
prettyAllHints :: [Note (Doc ann)] -> Int -> WithUnicode -> Doc (Annotation ann)
prettyAllHints :: forall ann.
[Note (Doc ann)] -> Int -> WithUnicode -> Doc (Annotation ann)
prettyAllHints [] Int
_ WithUnicode
_ = forall a. Monoid a => a
mempty
prettyAllHints (Note (Doc ann)
h : [Note (Doc ann)]
hs) Int
leftLen WithUnicode
withUnicode =
let prefix :: Doc (Annotation ann)
prefix = forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> WithUnicode -> Doc (Annotation ann)
pipePrefix Int
leftLen WithUnicode
withUnicode
in forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall {a}. Doc (Annotation a)
prefix forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate forall a. Annotation a
HintColor (forall {a} {msg}. IsString a => Note msg -> a
notePrefix Note (Doc ann)
h forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Int -> Doc ann -> Doc ann
replaceLinesWith forall {a}. Doc (Annotation a)
prefix Int
7 (forall ann. Doc ann -> Doc (Annotation ann)
annotated forall a b. (a -> b) -> a -> b
$ forall {msg}. Note msg -> msg
noteMessage Note (Doc ann)
h))
forall a. Semigroup a => a -> a -> a
<> forall ann.
[Note (Doc ann)] -> Int -> WithUnicode -> Doc (Annotation ann)
prettyAllHints [Note (Doc ann)]
hs Int
leftLen WithUnicode
withUnicode
where
notePrefix :: Note msg -> a
notePrefix (Note msg
_) = a
"Note:"
notePrefix (Hint msg
_) = a
"Hint:"
noteMessage :: Note msg -> msg
noteMessage (Note msg
msg) = msg
msg
noteMessage (Hint msg
msg) = msg
msg
safeArrayIndex :: (Ix i, IArray a e) => i -> a i e -> Maybe e
safeArrayIndex :: forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
i -> a i e -> Maybe e
safeArrayIndex i
i a i e
a
| forall a. Ix a => (a, a) -> a -> Bool
Array.inRange (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Array.bounds a i e
a) i
i = forall a. a -> Maybe a
Just (a i e
a forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! i
i)
| Bool
otherwise = forall a. Maybe a
Nothing
annotated :: Doc ann -> Doc (Annotation ann)
annotated :: forall ann. Doc ann -> Doc (Annotation ann)
annotated = forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate forall a. a -> Annotation a
OtherStyle
unicode :: a -> a -> WithUnicode -> a
unicode :: forall a. a -> a -> WithUnicode -> a
unicode a
f a
t = \case
WithUnicode
WithoutUnicode -> a
f
WithUnicode
WithUnicode -> a
t