{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Util.AnnotatedText where

import Data.Foldable qualified as Foldable
import Data.List qualified as L
import Data.ListLike qualified as LL
import Data.Map qualified as Map
import Data.Sequence (Seq ((:<|), (:|>)))
import Data.Sequence qualified as Seq
import GHC.Exts qualified
import Unison.Lexer.Pos (Line, Pos (..))
import Unison.Prelude
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Range (Range (..), inRange)

data Segment a = Segment {forall a. Segment a -> String
segment :: String, forall a. Segment a -> Maybe a
annotation :: Maybe a}
  deriving (Segment a -> Segment a -> Bool
(Segment a -> Segment a -> Bool)
-> (Segment a -> Segment a -> Bool) -> Eq (Segment a)
forall a. Eq a => Segment a -> Segment a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Segment a -> Segment a -> Bool
== :: Segment a -> Segment a -> Bool
$c/= :: forall a. Eq a => Segment a -> Segment a -> Bool
/= :: Segment a -> Segment a -> Bool
Eq, Int -> Segment a -> ShowS
[Segment a] -> ShowS
Segment a -> String
(Int -> Segment a -> ShowS)
-> (Segment a -> String)
-> ([Segment a] -> ShowS)
-> Show (Segment a)
forall a. Show a => Int -> Segment a -> ShowS
forall a. Show a => [Segment a] -> ShowS
forall a. Show a => Segment a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Segment a -> ShowS
showsPrec :: Int -> Segment a -> ShowS
$cshow :: forall a. Show a => Segment a -> String
show :: Segment a -> String
$cshowList :: forall a. Show a => [Segment a] -> ShowS
showList :: [Segment a] -> ShowS
Show, Eq (Segment a)
Eq (Segment a) =>
(Segment a -> Segment a -> Ordering)
-> (Segment a -> Segment a -> Bool)
-> (Segment a -> Segment a -> Bool)
-> (Segment a -> Segment a -> Bool)
-> (Segment a -> Segment a -> Bool)
-> (Segment a -> Segment a -> Segment a)
-> (Segment a -> Segment a -> Segment a)
-> Ord (Segment a)
Segment a -> Segment a -> Bool
Segment a -> Segment a -> Ordering
Segment a -> Segment a -> Segment a
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 a. Ord a => Eq (Segment a)
forall a. Ord a => Segment a -> Segment a -> Bool
forall a. Ord a => Segment a -> Segment a -> Ordering
forall a. Ord a => Segment a -> Segment a -> Segment a
$ccompare :: forall a. Ord a => Segment a -> Segment a -> Ordering
compare :: Segment a -> Segment a -> Ordering
$c< :: forall a. Ord a => Segment a -> Segment a -> Bool
< :: Segment a -> Segment a -> Bool
$c<= :: forall a. Ord a => Segment a -> Segment a -> Bool
<= :: Segment a -> Segment a -> Bool
$c> :: forall a. Ord a => Segment a -> Segment a -> Bool
> :: Segment a -> Segment a -> Bool
$c>= :: forall a. Ord a => Segment a -> Segment a -> Bool
>= :: Segment a -> Segment a -> Bool
$cmax :: forall a. Ord a => Segment a -> Segment a -> Segment a
max :: Segment a -> Segment a -> Segment a
$cmin :: forall a. Ord a => Segment a -> Segment a -> Segment a
min :: Segment a -> Segment a -> Segment a
Ord, (forall a b. (a -> b) -> Segment a -> Segment b)
-> (forall a b. a -> Segment b -> Segment a) -> Functor Segment
forall a b. a -> Segment b -> Segment a
forall a b. (a -> b) -> Segment a -> Segment b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Segment a -> Segment b
fmap :: forall a b. (a -> b) -> Segment a -> Segment b
$c<$ :: forall a b. a -> Segment b -> Segment a
<$ :: forall a b. a -> Segment b -> Segment a
Functor, (forall m. Monoid m => Segment m -> m)
-> (forall m a. Monoid m => (a -> m) -> Segment a -> m)
-> (forall m a. Monoid m => (a -> m) -> Segment a -> m)
-> (forall a b. (a -> b -> b) -> b -> Segment a -> b)
-> (forall a b. (a -> b -> b) -> b -> Segment a -> b)
-> (forall b a. (b -> a -> b) -> b -> Segment a -> b)
-> (forall b a. (b -> a -> b) -> b -> Segment a -> b)
-> (forall a. (a -> a -> a) -> Segment a -> a)
-> (forall a. (a -> a -> a) -> Segment a -> a)
-> (forall a. Segment a -> [a])
-> (forall a. Segment a -> Bool)
-> (forall a. Segment a -> Int)
-> (forall a. Eq a => a -> Segment a -> Bool)
-> (forall a. Ord a => Segment a -> a)
-> (forall a. Ord a => Segment a -> a)
-> (forall a. Num a => Segment a -> a)
-> (forall a. Num a => Segment a -> a)
-> Foldable Segment
forall a. Eq a => a -> Segment a -> Bool
forall a. Num a => Segment a -> a
forall a. Ord a => Segment a -> a
forall m. Monoid m => Segment m -> m
forall a. Segment a -> Bool
forall a. Segment a -> Int
forall a. Segment a -> [a]
forall a. (a -> a -> a) -> Segment a -> a
forall m a. Monoid m => (a -> m) -> Segment a -> m
forall b a. (b -> a -> b) -> b -> Segment a -> b
forall a b. (a -> b -> b) -> b -> Segment 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
$cfold :: forall m. Monoid m => Segment m -> m
fold :: forall m. Monoid m => Segment m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Segment a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Segment a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Segment a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Segment a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Segment a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Segment a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Segment a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Segment a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Segment a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Segment a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Segment a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Segment a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Segment a -> a
foldr1 :: forall a. (a -> a -> a) -> Segment a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Segment a -> a
foldl1 :: forall a. (a -> a -> a) -> Segment a -> a
$ctoList :: forall a. Segment a -> [a]
toList :: forall a. Segment a -> [a]
$cnull :: forall a. Segment a -> Bool
null :: forall a. Segment a -> Bool
$clength :: forall a. Segment a -> Int
length :: forall a. Segment a -> Int
$celem :: forall a. Eq a => a -> Segment a -> Bool
elem :: forall a. Eq a => a -> Segment a -> Bool
$cmaximum :: forall a. Ord a => Segment a -> a
maximum :: forall a. Ord a => Segment a -> a
$cminimum :: forall a. Ord a => Segment a -> a
minimum :: forall a. Ord a => Segment a -> a
$csum :: forall a. Num a => Segment a -> a
sum :: forall a. Num a => Segment a -> a
$cproduct :: forall a. Num a => Segment a -> a
product :: forall a. Num a => Segment a -> a
Foldable, (forall x. Segment a -> Rep (Segment a) x)
-> (forall x. Rep (Segment a) x -> Segment a)
-> Generic (Segment a)
forall x. Rep (Segment a) x -> Segment a
forall x. Segment a -> Rep (Segment a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Segment a) x -> Segment a
forall a x. Segment a -> Rep (Segment a) x
$cfrom :: forall a x. Segment a -> Rep (Segment a) x
from :: forall x. Segment a -> Rep (Segment a) x
$cto :: forall a x. Rep (Segment a) x -> Segment a
to :: forall x. Rep (Segment a) x -> Segment a
Generic)

toPair :: Segment a -> (String, Maybe a)
toPair :: forall a. Segment a -> (String, Maybe a)
toPair (Segment String
s Maybe a
a) = (String
s, Maybe a
a)

newtype AnnotatedText a = AnnotatedText (Seq (Segment a))
  deriving (AnnotatedText a -> AnnotatedText a -> Bool
(AnnotatedText a -> AnnotatedText a -> Bool)
-> (AnnotatedText a -> AnnotatedText a -> Bool)
-> Eq (AnnotatedText a)
forall a. Eq a => AnnotatedText a -> AnnotatedText a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AnnotatedText a -> AnnotatedText a -> Bool
== :: AnnotatedText a -> AnnotatedText a -> Bool
$c/= :: forall a. Eq a => AnnotatedText a -> AnnotatedText a -> Bool
/= :: AnnotatedText a -> AnnotatedText a -> Bool
Eq, (forall a b. (a -> b) -> AnnotatedText a -> AnnotatedText b)
-> (forall a b. a -> AnnotatedText b -> AnnotatedText a)
-> Functor AnnotatedText
forall a b. a -> AnnotatedText b -> AnnotatedText a
forall a b. (a -> b) -> AnnotatedText a -> AnnotatedText b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AnnotatedText a -> AnnotatedText b
fmap :: forall a b. (a -> b) -> AnnotatedText a -> AnnotatedText b
$c<$ :: forall a b. a -> AnnotatedText b -> AnnotatedText a
<$ :: forall a b. a -> AnnotatedText b -> AnnotatedText a
Functor, (forall m. Monoid m => AnnotatedText m -> m)
-> (forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m)
-> (forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m)
-> (forall a b. (a -> b -> b) -> b -> AnnotatedText a -> b)
-> (forall a b. (a -> b -> b) -> b -> AnnotatedText a -> b)
-> (forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b)
-> (forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b)
-> (forall a. (a -> a -> a) -> AnnotatedText a -> a)
-> (forall a. (a -> a -> a) -> AnnotatedText a -> a)
-> (forall a. AnnotatedText a -> [a])
-> (forall a. AnnotatedText a -> Bool)
-> (forall a. AnnotatedText a -> Int)
-> (forall a. Eq a => a -> AnnotatedText a -> Bool)
-> (forall a. Ord a => AnnotatedText a -> a)
-> (forall a. Ord a => AnnotatedText a -> a)
-> (forall a. Num a => AnnotatedText a -> a)
-> (forall a. Num a => AnnotatedText a -> a)
-> Foldable AnnotatedText
forall a. Eq a => a -> AnnotatedText a -> Bool
forall a. Num a => AnnotatedText a -> a
forall a. Ord a => AnnotatedText a -> a
forall m. Monoid m => AnnotatedText m -> m
forall a. AnnotatedText a -> Bool
forall a. AnnotatedText a -> Int
forall a. AnnotatedText a -> [a]
forall a. (a -> a -> a) -> AnnotatedText a -> a
forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m
forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b
forall a b. (a -> b -> b) -> b -> AnnotatedText 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
$cfold :: forall m. Monoid m => AnnotatedText m -> m
fold :: forall m. Monoid m => AnnotatedText m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> AnnotatedText a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> AnnotatedText a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AnnotatedText a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AnnotatedText a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AnnotatedText a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> AnnotatedText a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> AnnotatedText a -> a
foldr1 :: forall a. (a -> a -> a) -> AnnotatedText a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AnnotatedText a -> a
foldl1 :: forall a. (a -> a -> a) -> AnnotatedText a -> a
$ctoList :: forall a. AnnotatedText a -> [a]
toList :: forall a. AnnotatedText a -> [a]
$cnull :: forall a. AnnotatedText a -> Bool
null :: forall a. AnnotatedText a -> Bool
$clength :: forall a. AnnotatedText a -> Int
length :: forall a. AnnotatedText a -> Int
$celem :: forall a. Eq a => a -> AnnotatedText a -> Bool
elem :: forall a. Eq a => a -> AnnotatedText a -> Bool
$cmaximum :: forall a. Ord a => AnnotatedText a -> a
maximum :: forall a. Ord a => AnnotatedText a -> a
$cminimum :: forall a. Ord a => AnnotatedText a -> a
minimum :: forall a. Ord a => AnnotatedText a -> a
$csum :: forall a. Num a => AnnotatedText a -> a
sum :: forall a. Num a => AnnotatedText a -> a
$cproduct :: forall a. Num a => AnnotatedText a -> a
product :: forall a. Num a => AnnotatedText a -> a
Foldable, Int -> AnnotatedText a -> ShowS
[AnnotatedText a] -> ShowS
AnnotatedText a -> String
(Int -> AnnotatedText a -> ShowS)
-> (AnnotatedText a -> String)
-> ([AnnotatedText a] -> ShowS)
-> Show (AnnotatedText a)
forall a. Show a => Int -> AnnotatedText a -> ShowS
forall a. Show a => [AnnotatedText a] -> ShowS
forall a. Show a => AnnotatedText a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AnnotatedText a -> ShowS
showsPrec :: Int -> AnnotatedText a -> ShowS
$cshow :: forall a. Show a => AnnotatedText a -> String
show :: AnnotatedText a -> String
$cshowList :: forall a. Show a => [AnnotatedText a] -> ShowS
showList :: [AnnotatedText a] -> ShowS
Show, Eq (AnnotatedText a)
Eq (AnnotatedText a) =>
(AnnotatedText a -> AnnotatedText a -> Ordering)
-> (AnnotatedText a -> AnnotatedText a -> Bool)
-> (AnnotatedText a -> AnnotatedText a -> Bool)
-> (AnnotatedText a -> AnnotatedText a -> Bool)
-> (AnnotatedText a -> AnnotatedText a -> Bool)
-> (AnnotatedText a -> AnnotatedText a -> AnnotatedText a)
-> (AnnotatedText a -> AnnotatedText a -> AnnotatedText a)
-> Ord (AnnotatedText a)
AnnotatedText a -> AnnotatedText a -> Bool
AnnotatedText a -> AnnotatedText a -> Ordering
AnnotatedText a -> AnnotatedText a -> AnnotatedText a
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 a. Ord a => Eq (AnnotatedText a)
forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Bool
forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Ordering
forall a.
Ord a =>
AnnotatedText a -> AnnotatedText a -> AnnotatedText a
$ccompare :: forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Ordering
compare :: AnnotatedText a -> AnnotatedText a -> Ordering
$c< :: forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Bool
< :: AnnotatedText a -> AnnotatedText a -> Bool
$c<= :: forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Bool
<= :: AnnotatedText a -> AnnotatedText a -> Bool
$c> :: forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Bool
> :: AnnotatedText a -> AnnotatedText a -> Bool
$c>= :: forall a. Ord a => AnnotatedText a -> AnnotatedText a -> Bool
>= :: AnnotatedText a -> AnnotatedText a -> Bool
$cmax :: forall a.
Ord a =>
AnnotatedText a -> AnnotatedText a -> AnnotatedText a
max :: AnnotatedText a -> AnnotatedText a -> AnnotatedText a
$cmin :: forall a.
Ord a =>
AnnotatedText a -> AnnotatedText a -> AnnotatedText a
min :: AnnotatedText a -> AnnotatedText a -> AnnotatedText a
Ord, (forall x. AnnotatedText a -> Rep (AnnotatedText a) x)
-> (forall x. Rep (AnnotatedText a) x -> AnnotatedText a)
-> Generic (AnnotatedText a)
forall x. Rep (AnnotatedText a) x -> AnnotatedText a
forall x. AnnotatedText a -> Rep (AnnotatedText a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AnnotatedText a) x -> AnnotatedText a
forall a x. AnnotatedText a -> Rep (AnnotatedText a) x
$cfrom :: forall a x. AnnotatedText a -> Rep (AnnotatedText a) x
from :: forall x. AnnotatedText a -> Rep (AnnotatedText a) x
$cto :: forall a x. Rep (AnnotatedText a) x -> AnnotatedText a
to :: forall x. Rep (AnnotatedText a) x -> AnnotatedText a
Generic)

instance Semigroup (AnnotatedText a) where
  AnnotatedText (Seq (Segment a)
as :|> Segment String
"" Maybe a
_) <> :: AnnotatedText a -> AnnotatedText a -> AnnotatedText a
<> AnnotatedText a
bs = Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
as AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> AnnotatedText a
bs
  AnnotatedText a
as <> AnnotatedText (Segment String
"" Maybe a
_ :<| Seq (Segment a)
bs) = AnnotatedText a
as AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
bs
  AnnotatedText Seq (Segment a)
as <> AnnotatedText Seq (Segment a)
bs = Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a)
as Seq (Segment a) -> Seq (Segment a) -> Seq (Segment a)
forall a. Semigroup a => a -> a -> a
<> Seq (Segment a)
bs)

instance Monoid (AnnotatedText a) where
  mempty :: AnnotatedText a
mempty = Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
forall a. Seq a
Seq.empty

instance LL.FoldableLL (AnnotatedText a) Char where
  foldl' :: forall a. (a -> Char -> a) -> a -> AnnotatedText a -> a
foldl' a -> Char -> a
f a
z (AnnotatedText Seq (Segment a)
at) = (a -> Segment a -> a) -> a -> Seq (Segment a) -> a
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' a -> Segment a -> a
f' a
z Seq (Segment a)
at
    where
      f' :: a -> Segment a -> a
f' a
z (Segment String
str Maybe a
_) = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' a -> Char -> a
f a
z String
str
  foldl :: forall a. (a -> Char -> a) -> a -> AnnotatedText a -> a
foldl = (a -> Char -> a) -> a -> AnnotatedText a -> a
forall a. (a -> Char -> a) -> a -> AnnotatedText a -> a
forall full item a.
FoldableLL full item =>
(a -> item -> a) -> a -> full -> a
LL.foldl
  foldr :: forall b. (Char -> b -> b) -> b -> AnnotatedText a -> b
foldr Char -> b -> b
f b
z (AnnotatedText Seq (Segment a)
at) = (Segment a -> b -> b) -> b -> Seq (Segment a) -> b
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr Segment a -> b -> b
f' b
z Seq (Segment a)
at
    where
      f' :: Segment a -> b -> b
f' (Segment String
str Maybe a
_) b
z = (Char -> b -> b) -> b -> String -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr Char -> b -> b
f b
z String
str

instance LL.ListLike (AnnotatedText a) Char where
  singleton :: Char -> AnnotatedText a
singleton Char
ch = String -> AnnotatedText a
forall a. IsString a => String -> a
fromString [Char
ch]
  uncons :: AnnotatedText a -> Maybe (Char, AnnotatedText a)
uncons (AnnotatedText Seq (Segment a)
at) = case Seq (Segment a)
at of
    Segment String
s Maybe a
a :<| Seq (Segment a)
tl -> case String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
L.uncons String
s of
      Maybe (Char, String)
Nothing -> AnnotatedText a -> Maybe (Char, AnnotatedText a)
forall full item. ListLike full item => full -> Maybe (item, full)
LL.uncons (Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
tl)
      Just (Char
hd, String
s) -> (Char, AnnotatedText a) -> Maybe (Char, AnnotatedText a)
forall a. a -> Maybe a
Just (Char
hd, Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a) -> AnnotatedText a)
-> Seq (Segment a) -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s Maybe a
a Segment a -> Seq (Segment a) -> Seq (Segment a)
forall a. a -> Seq a -> Seq a
:<| Seq (Segment a)
tl)
    Seq (Segment a)
Seq.Empty -> Maybe (Char, AnnotatedText a)
forall a. Maybe a
Nothing
  break :: (Char -> Bool)
-> AnnotatedText a -> (AnnotatedText a, AnnotatedText a)
break Char -> Bool
f AnnotatedText a
at = ((Char -> Bool) -> AnnotatedText a -> AnnotatedText a
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) AnnotatedText a
at, (Char -> Bool) -> AnnotatedText a -> AnnotatedText a
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) AnnotatedText a
at)
  takeWhile :: (Char -> Bool) -> AnnotatedText a -> AnnotatedText a
takeWhile Char -> Bool
f (AnnotatedText Seq (Segment a)
at) = case Seq (Segment a)
at of
    Seq (Segment a)
Seq.Empty -> Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
forall a. Seq a
Seq.Empty
    Segment String
s Maybe a
a :<| Seq (Segment a)
tl ->
      let s' :: String
s' = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
L.takeWhile Char -> Bool
f String
s
       in if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
            then
              Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Segment a -> Seq (Segment a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Segment a -> Seq (Segment a)) -> Segment a -> Seq (Segment a)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s Maybe a
a)
                AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> AnnotatedText a -> AnnotatedText a
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.takeWhile Char -> Bool
f (Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
tl)
            else Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Segment a -> Seq (Segment a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Segment a -> Seq (Segment a)) -> Segment a -> Seq (Segment a)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s' Maybe a
a)
  dropWhile :: (Char -> Bool) -> AnnotatedText a -> AnnotatedText a
dropWhile Char -> Bool
f (AnnotatedText Seq (Segment a)
at) = case Seq (Segment a)
at of
    Seq (Segment a)
Seq.Empty -> Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
forall a. Seq a
Seq.Empty
    Segment String
s Maybe a
a :<| Seq (Segment a)
tl -> case (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile Char -> Bool
f String
s of
      [] -> (Char -> Bool) -> AnnotatedText a -> AnnotatedText a
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhile Char -> Bool
f (Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
tl)
      String
s -> Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a) -> AnnotatedText a)
-> Seq (Segment a) -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ (String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s Maybe a
a) Segment a -> Seq (Segment a) -> Seq (Segment a)
forall a. a -> Seq a -> Seq a
:<| Seq (Segment a)
tl
  take :: Int -> AnnotatedText a -> AnnotatedText a
take Int
n (AnnotatedText Seq (Segment a)
at) = case Seq (Segment a)
at of
    Seq (Segment a)
Seq.Empty -> Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
forall a. Seq a
Seq.Empty
    Segment String
s Maybe a
a :<| Seq (Segment a)
tl ->
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
        then Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a) -> AnnotatedText a)
-> Seq (Segment a) -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ Segment a -> Seq (Segment a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n String
s) Maybe a
a)
        else
          Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Segment a -> Seq (Segment a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s Maybe a
a))
            AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> Int -> AnnotatedText a -> AnnotatedText a
forall full item. ListLike full item => Int -> full -> full
LL.take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
tl)
  drop :: Int -> AnnotatedText a -> AnnotatedText a
drop Int
n (AnnotatedText Seq (Segment a)
at) = case Seq (Segment a)
at of
    Seq (Segment a)
Seq.Empty -> Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
forall a. Seq a
Seq.Empty
    Segment String
s Maybe a
a :<| Seq (Segment a)
tl ->
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
        then Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a) -> AnnotatedText a)
-> Seq (Segment a) -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ (String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
n String
s) Maybe a
a) Segment a -> Seq (Segment a) -> Seq (Segment a)
forall a. a -> Seq a -> Seq a
:<| Seq (Segment a)
tl
        else Int -> AnnotatedText a -> AnnotatedText a
forall full item. ListLike full item => Int -> full -> full
LL.drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
tl)
  null :: AnnotatedText a -> Bool
null (AnnotatedText Seq (Segment a)
at) = (Segment a -> Bool) -> Seq (Segment a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (Segment a -> String) -> Segment a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment a -> String
forall a. Segment a -> String
segment) Seq (Segment a)
at

-- Quoted text (indented, with source line numbers) with annotated portions.
data AnnotatedExcerpt a = AnnotatedExcerpt
  { forall a. AnnotatedExcerpt a -> Int
lineOffset :: Line,
    forall a. AnnotatedExcerpt a -> String
text :: String,
    forall a. AnnotatedExcerpt a -> Map Range a
annotations :: Map Range a
  }
  deriving ((forall a b. (a -> b) -> AnnotatedExcerpt a -> AnnotatedExcerpt b)
-> (forall a b. a -> AnnotatedExcerpt b -> AnnotatedExcerpt a)
-> Functor AnnotatedExcerpt
forall a b. a -> AnnotatedExcerpt b -> AnnotatedExcerpt a
forall a b. (a -> b) -> AnnotatedExcerpt a -> AnnotatedExcerpt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AnnotatedExcerpt a -> AnnotatedExcerpt b
fmap :: forall a b. (a -> b) -> AnnotatedExcerpt a -> AnnotatedExcerpt b
$c<$ :: forall a b. a -> AnnotatedExcerpt b -> AnnotatedExcerpt a
<$ :: forall a b. a -> AnnotatedExcerpt b -> AnnotatedExcerpt a
Functor)

annotate' :: Maybe b -> AnnotatedText a -> AnnotatedText b
annotate' :: forall b a. Maybe b -> AnnotatedText a -> AnnotatedText b
annotate' Maybe b
a (AnnotatedText Seq (Segment a)
at) =
  Seq (Segment b) -> AnnotatedText b
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment b) -> AnnotatedText b)
-> Seq (Segment b) -> AnnotatedText b
forall a b. (a -> b) -> a -> b
$ (\(Segment String
s Maybe a
_) -> String -> Maybe b -> Segment b
forall a. String -> Maybe a -> Segment a
Segment String
s Maybe b
a) (Segment a -> Segment b) -> Seq (Segment a) -> Seq (Segment b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Segment a)
at

deannotate :: AnnotatedText a -> AnnotatedText b
deannotate :: forall a b. AnnotatedText a -> AnnotatedText b
deannotate = Maybe b -> AnnotatedText a -> AnnotatedText b
forall b a. Maybe b -> AnnotatedText a -> AnnotatedText b
annotate' Maybe b
forall a. Maybe a
Nothing

-- Replace the annotation (whether existing or no) with the given annotation
annotate :: a -> AnnotatedText a -> AnnotatedText a
annotate :: forall a. a -> AnnotatedText a -> AnnotatedText a
annotate a
a (AnnotatedText Seq (Segment a)
at) =
  Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a) -> AnnotatedText a)
-> Seq (Segment a) -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ (\(Segment String
s Maybe a
_) -> String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s (a -> Maybe a
forall a. a -> Maybe a
Just a
a)) (Segment a -> Segment a) -> Seq (Segment a) -> Seq (Segment a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Segment a)
at

annotateMaybe :: AnnotatedText (Maybe a) -> AnnotatedText a
annotateMaybe :: forall a. AnnotatedText (Maybe a) -> AnnotatedText a
annotateMaybe (AnnotatedText Seq (Segment (Maybe a))
segments) =
  Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText ((Segment (Maybe a) -> Segment a)
-> Seq (Segment (Maybe a)) -> Seq (Segment a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Segment String
s Maybe (Maybe a)
a) -> String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe a)
a)) Seq (Segment (Maybe a))
segments)

trailingNewLine :: AnnotatedText a -> Bool
trailingNewLine :: forall a. AnnotatedText a -> Bool
trailingNewLine (AnnotatedText (Seq (Segment a)
init :|> (Segment String
s Maybe a
_))) =
  case String -> Maybe Char
forall a. [a] -> Maybe a
lastMay String
s of
    Just Char
'\n' -> Bool
True
    Just Char
_ -> Bool
False
    Maybe Char
_ -> AnnotatedText a -> Bool
forall a. AnnotatedText a -> Bool
trailingNewLine (Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText Seq (Segment a)
init)
trailingNewLine AnnotatedText a
_ = Bool
False

markup :: AnnotatedExcerpt a -> Map Range a -> AnnotatedExcerpt a
markup :: forall a. AnnotatedExcerpt a -> Map Range a -> AnnotatedExcerpt a
markup AnnotatedExcerpt a
a Map Range a
r = AnnotatedExcerpt a
a {annotations = r `Map.union` annotations a}

-- renderTextUnstyled :: AnnotatedText a -> Rendered Void
-- renderTextUnstyled (AnnotatedText chunks) = foldl' go mempty chunks
--   where go r (text, _) = r <> fromString text

textLength :: AnnotatedText a -> Int
textLength :: forall a. AnnotatedText a -> Int
textLength (AnnotatedText Seq (Segment a)
chunks) = (Int -> Segment a -> Int) -> Int -> Seq (Segment a) -> Int
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Segment a -> Int
forall {a}. Int -> Segment a -> Int
go Int
0 Seq (Segment a)
chunks
  where
    go :: Int -> Segment a -> Int
go Int
len (Segment a -> (String, Maybe a)
forall a. Segment a -> (String, Maybe a)
toPair -> (String
text, Maybe a
_a)) = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
text

textEmpty :: AnnotatedText a -> Bool
textEmpty :: forall a. AnnotatedText a -> Bool
textEmpty = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool)
-> (AnnotatedText a -> Int) -> AnnotatedText a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedText a -> Int
forall a. AnnotatedText a -> Int
textLength

condensedExcerptToText :: Int -> AnnotatedExcerpt a -> AnnotatedText a
condensedExcerptToText :: forall a. Int -> AnnotatedExcerpt a -> AnnotatedText a
condensedExcerptToText Int
margin AnnotatedExcerpt a
e =
  AnnotatedText a
-> (AnnotatedExcerpt a -> AnnotatedText a)
-> [AnnotatedExcerpt a]
-> AnnotatedText a
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap AnnotatedText a
"    .\n" AnnotatedExcerpt a -> AnnotatedText a
forall a. AnnotatedExcerpt a -> AnnotatedText a
excerptToText ([AnnotatedExcerpt a] -> AnnotatedText a)
-> [AnnotatedExcerpt a] -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
forall a. Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
snipWithContext Int
margin AnnotatedExcerpt a
e

excerptToText :: forall a. AnnotatedExcerpt a -> AnnotatedText a
excerptToText :: forall a. AnnotatedExcerpt a -> AnnotatedText a
excerptToText AnnotatedExcerpt a
e =
  Pos
-> [(a, Pos)]
-> [(Range, a)]
-> AnnotatedText a
-> String
-> AnnotatedText a
track (Int -> Int -> Pos
Pos Int
line1 Int
1) [] (Map Range a -> [(Range, a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Range a -> [(Range, a)]) -> Map Range a -> [(Range, a)]
forall a b. (a -> b) -> a -> b
$ AnnotatedExcerpt a -> Map Range a
forall a. AnnotatedExcerpt a -> Map Range a
annotations AnnotatedExcerpt a
e) (Int -> AnnotatedText a
renderLineNumber Int
line1) (AnnotatedExcerpt a -> String
forall a. AnnotatedExcerpt a -> String
text AnnotatedExcerpt a
e)
  where
    line1 :: Int
    line1 :: Int
line1 = AnnotatedExcerpt a -> Int
forall a. AnnotatedExcerpt a -> Int
lineOffset AnnotatedExcerpt a
e
    renderLineNumber :: Int -> AnnotatedText a
    renderLineNumber :: Int -> AnnotatedText a
renderLineNumber Int
n = String -> AnnotatedText a
forall a. IsString a => String -> a
fromString (String -> AnnotatedText a) -> String -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
spaces String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | "
      where
        sn :: String
sn = Int -> String
forall a. Show a => a -> String
show Int
n
        spaces :: String
spaces = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
lineNumberWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sn) Char
' '
        lineNumberWidth :: Int
lineNumberWidth = Int
4

    -- step through the source characters and annotations
    track :: Pos
-> [(a, Pos)]
-> [(Range, a)]
-> AnnotatedText a
-> String
-> AnnotatedText a
track Pos
_ [(a, Pos)]
_ [(Range, a)]
_ AnnotatedText a
rendered String
"" = AnnotatedText a
rendered
    track Pos
_ [(a, Pos)]
_ [(Range, a)]
_ AnnotatedText a
rendered String
"\n" = AnnotatedText a
rendered AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> AnnotatedText a
"\n"
    track pos :: Pos
pos@(Pos Int
line Int
col) [(a, Pos)]
stack [(Range, a)]
annotations AnnotatedText a
rendered _input :: String
_input@(Char
c : String
rest) =
      let ([(Range, a)]
poppedAnnotations, [(Range, a)]
remainingAnnotations) = ((Range, a) -> Bool)
-> [(Range, a)] -> ([(Range, a)], [(Range, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Pos -> Range -> Bool
inRange Pos
pos (Range -> Bool) -> ((Range, a) -> Range) -> (Range, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, a) -> Range
forall a b. (a, b) -> a
fst) [(Range, a)]
annotations
          -- drop any stack entries that will be closed after this char
          -- and add new stack entries
          stack' :: [(a, Pos)]
stack' = ([(a, Pos)] -> (Range, a) -> [(a, Pos)])
-> [(a, Pos)] -> [(Range, a)] -> [(a, Pos)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(a, Pos)] -> (Range, a) -> [(a, Pos)]
forall {a}. [(a, Pos)] -> (Range, a) -> [(a, Pos)]
pushColor [(a, Pos)]
stack0 [(Range, a)]
poppedAnnotations
            where
              pushColor :: [(a, Pos)] -> (Range, a) -> [(a, Pos)]
pushColor [(a, Pos)]
s (Range Pos
_ Pos
end, a
style) = (a
style, Pos
end) (a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall a. a -> [a] -> [a]
: [(a, Pos)]
s
              stack0 :: [(a, Pos)]
stack0 = ((a, Pos) -> Bool) -> [(a, Pos)] -> [(a, Pos)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
pos) (Pos -> Bool) -> ((a, Pos) -> Pos) -> (a, Pos) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Pos) -> Pos
forall a b. (a, b) -> b
snd) [(a, Pos)]
stack
          maybeColor :: Maybe a
maybeColor = (a, Pos) -> a
forall a b. (a, b) -> a
fst ((a, Pos) -> a) -> Maybe (a, Pos) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Pos)] -> Maybe (a, Pos)
forall a. [a] -> Maybe a
headMay [(a, Pos)]
stack'
          -- on new line, advance pos' vertically and set up line header
          -- additions :: AnnotatedText (Maybe a)
          pos' :: Pos
          (AnnotatedText a
additions, Pos
pos') =
            if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
              then (AnnotatedText a
"\n" AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> Int -> AnnotatedText a
renderLineNumber (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int -> Int -> Pos
Pos (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1)
              else (Maybe a -> AnnotatedText Any -> AnnotatedText a
forall b a. Maybe b -> AnnotatedText a -> AnnotatedText b
annotate' Maybe a
maybeColor (String -> AnnotatedText Any
forall a. IsString a => String -> a
fromString [Char
c]), Int -> Int -> Pos
Pos Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
       in Pos
-> [(a, Pos)]
-> [(Range, a)]
-> AnnotatedText a
-> String
-> AnnotatedText a
track Pos
pos' [(a, Pos)]
stack' [(Range, a)]
remainingAnnotations (AnnotatedText a
rendered AnnotatedText a -> AnnotatedText a -> AnnotatedText a
forall a. Semigroup a => a -> a -> a
<> AnnotatedText a
additions) String
rest

snipWithContext :: Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
snipWithContext :: forall a. Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
snipWithContext Int
margin AnnotatedExcerpt a
source =
  case ((Maybe Range, Map Range a, Map Range a)
 -> (Range, a) -> (Maybe Range, Map Range a, Map Range a))
-> (Maybe Range, Map Range a, Map Range a)
-> [(Range, a)]
-> (Maybe Range, Map Range a, Map Range a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    (Maybe Range, Map Range a, Map Range a)
-> (Range, a) -> (Maybe Range, Map Range a, Map Range a)
forall a.
(Maybe Range, Map Range a, Map Range a)
-> (Range, a) -> (Maybe Range, Map Range a, Map Range a)
whileWithinMargin
    (Maybe Range
forall a. Maybe a
Nothing, Map Range a
forall a. Monoid a => a
mempty, Map Range a
forall a. Monoid a => a
mempty)
    (Map Range a -> [(Range, a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Range a -> [(Range, a)]) -> Map Range a -> [(Range, a)]
forall a b. (a -> b) -> a -> b
$ AnnotatedExcerpt a -> Map Range a
forall a. AnnotatedExcerpt a -> Map Range a
annotations AnnotatedExcerpt a
source) of
    (Maybe Range
Nothing, Map Range a
_, Map Range a
_) -> []
    (Just (Range (Pos Int
startLine' Int
_) (Pos Int
endLine' Int
_)), Map Range a
group', Map Range a
rest') ->
      let dropLineCount :: Int
dropLineCount = Int
startLine' Int -> Int -> Int
forall a. Num a => a -> a -> a
- AnnotatedExcerpt a -> Int
forall a. AnnotatedExcerpt a -> Int
lineOffset AnnotatedExcerpt a
source
          takeLineCount :: Int
takeLineCount = Int
endLine' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startLine' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          text', text2' :: [String]
          ([String]
text', [String]
text2') =
            Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
takeLineCount (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
dropLineCount (String -> [String]
lines (AnnotatedExcerpt a -> String
forall a. AnnotatedExcerpt a -> String
text AnnotatedExcerpt a
source)))
       in Int -> String -> Map Range a -> AnnotatedExcerpt a
forall a. Int -> String -> Map Range a -> AnnotatedExcerpt a
AnnotatedExcerpt Int
startLine' ([String] -> String
unlines [String]
text') Map Range a
group'
            AnnotatedExcerpt a -> [AnnotatedExcerpt a] -> [AnnotatedExcerpt a]
forall a. a -> [a] -> [a]
: Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
forall a. Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
snipWithContext
              Int
margin
              (Int -> String -> Map Range a -> AnnotatedExcerpt a
forall a. Int -> String -> Map Range a -> AnnotatedExcerpt a
AnnotatedExcerpt (Int
endLine' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([String] -> String
unlines [String]
text2') Map Range a
rest')
  where
    withinMargin :: Range -> Range -> Bool
    withinMargin :: Range -> Range -> Bool
withinMargin (Range Pos
_start1 (Pos Int
end1 Int
_)) (Range (Pos Int
start2 Int
_) Pos
_end2) =
      Int
end1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
start2

    whileWithinMargin ::
      (Maybe Range, Map Range a, Map Range a) ->
      (Range, a) ->
      (Maybe Range, Map Range a, Map Range a)
    whileWithinMargin :: forall a.
(Maybe Range, Map Range a, Map Range a)
-> (Range, a) -> (Maybe Range, Map Range a, Map Range a)
whileWithinMargin (Maybe Range
r0, Map Range a
taken, Map Range a
rest) (Range
r1, a
a1) =
      case Maybe Range
r0 of
        Maybe Range
Nothing ->
          -- haven't processed any annotations yet
          (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
r1, Range -> a -> Map Range a
forall k a. k -> a -> Map k a
Map.singleton Range
r1 a
a1, Map Range a
forall a. Monoid a => a
mempty)
        Just Range
r0 ->
          -- if all annotations so far can be joined without .. separations
          if Map Range a -> Bool
forall a. Map Range a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Range a
rest
            then -- if this one can be joined to the new region without .. separation
              if Range -> Range -> Bool
withinMargin Range
r0 Range
r1
                then -- add it to the first set and grow the compare region
                  (Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ Range
r0 Range -> Range -> Range
forall a. Semigroup a => a -> a -> a
<> Range
r1, Range -> a -> Map Range a -> Map Range a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Range
r1 a
a1 Map Range a
taken, Map Range a
forall a. Monoid a => a
mempty)
                else -- otherwise add it to the second set
                  (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
r0, Map Range a
taken, Range -> a -> Map Range a
forall k a. k -> a -> Map k a
Map.singleton Range
r1 a
a1)
            else -- once we've added to the second set, anything more goes there too
              (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
r0, Map Range a
taken, Range -> a -> Map Range a -> Map Range a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Range
r1 a
a1 Map Range a
rest)

instance IsString (AnnotatedText a) where
  fromString :: String -> AnnotatedText a
fromString String
s = Seq (Segment a) -> AnnotatedText a
forall a. Seq (Segment a) -> AnnotatedText a
AnnotatedText (Seq (Segment a) -> AnnotatedText a)
-> (Segment a -> Seq (Segment a)) -> Segment a -> AnnotatedText a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment a -> Seq (Segment a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Segment a -> AnnotatedText a) -> Segment a -> AnnotatedText a
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> Segment a
forall a. String -> Maybe a -> Segment a
Segment String
s Maybe a
forall a. Maybe a
Nothing

instance IsString (AnnotatedExcerpt a) where
  fromString :: String -> AnnotatedExcerpt a
fromString String
s = Int -> String -> Map Range a -> AnnotatedExcerpt a
forall a. Int -> String -> Map Range a -> AnnotatedExcerpt a
AnnotatedExcerpt Int
1 String
s Map Range a
forall a. Monoid a => a
mempty

instance GHC.Exts.IsList (AnnotatedText a) where
  type Item (AnnotatedText a) = Char
  fromList :: [Item (AnnotatedText a)] -> AnnotatedText a
fromList [Item (AnnotatedText a)]
s = String -> AnnotatedText a
forall a. IsString a => String -> a
fromString String
[Item (AnnotatedText a)]
s
  toList :: AnnotatedText a -> [Item (AnnotatedText a)]
toList (AnnotatedText Seq (Segment a)
s) = [String] -> String
[String] -> [Item (AnnotatedText a)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> [Item (AnnotatedText a)])
-> (Seq String -> [String])
-> Seq String
-> [Item (AnnotatedText a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq String -> [String]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq String -> [Item (AnnotatedText a)])
-> Seq String -> [Item (AnnotatedText a)]
forall a b. (a -> b) -> a -> b
$ (Segment a -> String) -> Seq (Segment a) -> Seq String
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment a -> String
forall a. Segment a -> String
segment Seq (Segment a)
s