{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeFamilies   #-}
-- GHC 8.10 wans about the derived MonoFoldable instance, GHC>=9.2 works fine
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module PlutusCore.Annotation
    ( Ann (..)
    , SrcSpan (..)
    , SrcSpans (..)
    , InlineHints (..)
    , Inline (..)
    , annAlwaysInline
    , annMayInline
    , Megaparsec.SourcePos (..)
    , Megaparsec.Pos
    , addSrcSpan
    , lineInSrcSpan
    ) where

import Control.DeepSeq
import Data.Hashable
import Data.List qualified as List
import Data.MonoTraversable
import Data.Semigroup (Any (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Flat (Flat (..))
import GHC.Generics
import Prettyprinter
import Text.Megaparsec.Pos as Megaparsec

newtype InlineHints name a = InlineHints { forall name a. InlineHints name a -> a -> name -> Bool
shouldInline :: a -> name -> Bool }
    deriving (NonEmpty (InlineHints name a) -> InlineHints name a
InlineHints name a -> InlineHints name a -> InlineHints name a
(InlineHints name a -> InlineHints name a -> InlineHints name a)
-> (NonEmpty (InlineHints name a) -> InlineHints name a)
-> (forall b.
    Integral b =>
    b -> InlineHints name a -> InlineHints name a)
-> Semigroup (InlineHints name a)
forall b.
Integral b =>
b -> InlineHints name a -> InlineHints name a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a name. NonEmpty (InlineHints name a) -> InlineHints name a
forall a name.
InlineHints name a -> InlineHints name a -> InlineHints name a
forall a name b.
Integral b =>
b -> InlineHints name a -> InlineHints name a
$c<> :: forall a name.
InlineHints name a -> InlineHints name a -> InlineHints name a
<> :: InlineHints name a -> InlineHints name a -> InlineHints name a
$csconcat :: forall a name. NonEmpty (InlineHints name a) -> InlineHints name a
sconcat :: NonEmpty (InlineHints name a) -> InlineHints name a
$cstimes :: forall a name b.
Integral b =>
b -> InlineHints name a -> InlineHints name a
stimes :: forall b.
Integral b =>
b -> InlineHints name a -> InlineHints name a
Semigroup, Semigroup (InlineHints name a)
InlineHints name a
Semigroup (InlineHints name a) =>
InlineHints name a
-> (InlineHints name a -> InlineHints name a -> InlineHints name a)
-> ([InlineHints name a] -> InlineHints name a)
-> Monoid (InlineHints name a)
[InlineHints name a] -> InlineHints name a
InlineHints name a -> InlineHints name a -> InlineHints name a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a name. Semigroup (InlineHints name a)
forall a name. InlineHints name a
forall a name. [InlineHints name a] -> InlineHints name a
forall a name.
InlineHints name a -> InlineHints name a -> InlineHints name a
$cmempty :: forall a name. InlineHints name a
mempty :: InlineHints name a
$cmappend :: forall a name.
InlineHints name a -> InlineHints name a -> InlineHints name a
mappend :: InlineHints name a -> InlineHints name a -> InlineHints name a
$cmconcat :: forall a name. [InlineHints name a] -> InlineHints name a
mconcat :: [InlineHints name a] -> InlineHints name a
Monoid) via (a -> name -> Any)

instance Show (InlineHints name a) where
    show :: InlineHints name a -> String
show InlineHints name a
_ = String
"<inline hints>"

-- | An annotation type used during the compilation.
data Ann = Ann
    { Ann -> Inline
annInline   :: Inline
    , Ann -> SrcSpans
annSrcSpans :: SrcSpans
    }
    deriving stock (Ann -> Ann -> Bool
(Ann -> Ann -> Bool) -> (Ann -> Ann -> Bool) -> Eq Ann
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ann -> Ann -> Bool
== :: Ann -> Ann -> Bool
$c/= :: Ann -> Ann -> Bool
/= :: Ann -> Ann -> Bool
Eq, Eq Ann
Eq Ann =>
(Ann -> Ann -> Ordering)
-> (Ann -> Ann -> Bool)
-> (Ann -> Ann -> Bool)
-> (Ann -> Ann -> Bool)
-> (Ann -> Ann -> Bool)
-> (Ann -> Ann -> Ann)
-> (Ann -> Ann -> Ann)
-> Ord Ann
Ann -> Ann -> Bool
Ann -> Ann -> Ordering
Ann -> Ann -> Ann
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
$ccompare :: Ann -> Ann -> Ordering
compare :: Ann -> Ann -> Ordering
$c< :: Ann -> Ann -> Bool
< :: Ann -> Ann -> Bool
$c<= :: Ann -> Ann -> Bool
<= :: Ann -> Ann -> Bool
$c> :: Ann -> Ann -> Bool
> :: Ann -> Ann -> Bool
$c>= :: Ann -> Ann -> Bool
>= :: Ann -> Ann -> Bool
$cmax :: Ann -> Ann -> Ann
max :: Ann -> Ann -> Ann
$cmin :: Ann -> Ann -> Ann
min :: Ann -> Ann -> Ann
Ord, (forall x. Ann -> Rep Ann x)
-> (forall x. Rep Ann x -> Ann) -> Generic Ann
forall x. Rep Ann x -> Ann
forall x. Ann -> Rep Ann x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ann -> Rep Ann x
from :: forall x. Ann -> Rep Ann x
$cto :: forall x. Rep Ann x -> Ann
to :: forall x. Rep Ann x -> Ann
Generic, Int -> Ann -> ShowS
[Ann] -> ShowS
Ann -> String
(Int -> Ann -> ShowS)
-> (Ann -> String) -> ([Ann] -> ShowS) -> Show Ann
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ann -> ShowS
showsPrec :: Int -> Ann -> ShowS
$cshow :: Ann -> String
show :: Ann -> String
$cshowList :: [Ann] -> ShowS
showList :: [Ann] -> ShowS
Show)
    deriving anyclass (Eq Ann
Eq Ann => (Int -> Ann -> Int) -> (Ann -> Int) -> Hashable Ann
Int -> Ann -> Int
Ann -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Ann -> Int
hashWithSalt :: Int -> Ann -> Int
$chash :: Ann -> Int
hash :: Ann -> Int
Hashable)

data Inline
    = -- | When calling @PlutusIR.Compiler.Definitions.defineTerm@ to add a new term definition,
      -- if we annotation the var on the LHS of the definition with `AlwaysInline`, the inliner will
      -- always inline that var.
      --
      -- This is currently used to ensure builtin functions such as @trace@ (when the @remove-trace@
      -- flag is on and @trace@ is rewritten to @const@) are inlined, because the inliner would
      -- otherwise not inline them. To achieve that, we annotate the definition with `AlwaysInline`
      -- when defining @trace@, i.e., @trace <AlwaysInline> = \_ a -> a@.
      AlwaysInline
    | MayInline
    deriving stock (Inline -> Inline -> Bool
(Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool) -> Eq Inline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
/= :: Inline -> Inline -> Bool
Eq, Eq Inline
Eq Inline =>
(Inline -> Inline -> Ordering)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Inline)
-> (Inline -> Inline -> Inline)
-> Ord Inline
Inline -> Inline -> Bool
Inline -> Inline -> Ordering
Inline -> Inline -> Inline
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
$ccompare :: Inline -> Inline -> Ordering
compare :: Inline -> Inline -> Ordering
$c< :: Inline -> Inline -> Bool
< :: Inline -> Inline -> Bool
$c<= :: Inline -> Inline -> Bool
<= :: Inline -> Inline -> Bool
$c> :: Inline -> Inline -> Bool
> :: Inline -> Inline -> Bool
$c>= :: Inline -> Inline -> Bool
>= :: Inline -> Inline -> Bool
$cmax :: Inline -> Inline -> Inline
max :: Inline -> Inline -> Inline
$cmin :: Inline -> Inline -> Inline
min :: Inline -> Inline -> Inline
Ord, (forall x. Inline -> Rep Inline x)
-> (forall x. Rep Inline x -> Inline) -> Generic Inline
forall x. Rep Inline x -> Inline
forall x. Inline -> Rep Inline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Inline -> Rep Inline x
from :: forall x. Inline -> Rep Inline x
$cto :: forall x. Rep Inline x -> Inline
to :: forall x. Rep Inline x -> Inline
Generic, Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
(Int -> Inline -> ShowS)
-> (Inline -> String) -> ([Inline] -> ShowS) -> Show Inline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inline -> ShowS
showsPrec :: Int -> Inline -> ShowS
$cshow :: Inline -> String
show :: Inline -> String
$cshowList :: [Inline] -> ShowS
showList :: [Inline] -> ShowS
Show)
    deriving anyclass (Eq Inline
Eq Inline =>
(Int -> Inline -> Int) -> (Inline -> Int) -> Hashable Inline
Int -> Inline -> Int
Inline -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Inline -> Int
hashWithSalt :: Int -> Inline -> Int
$chash :: Inline -> Int
hash :: Inline -> Int
Hashable)

instance Pretty Ann where
    pretty :: forall ann. Ann -> Doc ann
pretty = Ann -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- | Create an `Ann` with `AlwaysInline`.
annAlwaysInline :: Ann
annAlwaysInline :: Ann
annAlwaysInline = Ann{annInline :: Inline
annInline = Inline
AlwaysInline, annSrcSpans :: SrcSpans
annSrcSpans = SrcSpans
forall a. Monoid a => a
mempty}

-- | Create an `Ann` with `MayInline`.
annMayInline :: Ann
annMayInline :: Ann
annMayInline = Ann{annInline :: Inline
annInline = Inline
MayInline, annSrcSpans :: SrcSpans
annSrcSpans = SrcSpans
forall a. Monoid a => a
mempty}


-- | The span between two source locations.
--
-- This corresponds roughly to the `SrcSpan` used by GHC,
-- but we define our own version so we don't have to depend on `ghc` to use it.
--
-- The line and column numbers are 1-based, and the unit is Unicode code point (or `Char`).
data SrcSpan = SrcSpan
    { SrcSpan -> String
srcSpanFile  :: FilePath
    , SrcSpan -> Int
srcSpanSLine :: Int
    , SrcSpan -> Int
srcSpanSCol  :: Int
    , SrcSpan -> Int
srcSpanELine :: Int
    , SrcSpan -> Int
srcSpanECol  :: Int
    -- ^ Same as GHC's @SrcSpan@, @srcSpanECol@ is usually one more than the column of
    -- the last character of the thing this @SrcSpan@ is for (unless the last character
    -- is the line break).
    }
    deriving stock (SrcSpan -> SrcSpan -> Bool
(SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool) -> Eq SrcSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcSpan -> SrcSpan -> Bool
== :: SrcSpan -> SrcSpan -> Bool
$c/= :: SrcSpan -> SrcSpan -> Bool
/= :: SrcSpan -> SrcSpan -> Bool
Eq, Eq SrcSpan
Eq SrcSpan =>
(SrcSpan -> SrcSpan -> Ordering)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> SrcSpan)
-> (SrcSpan -> SrcSpan -> SrcSpan)
-> Ord SrcSpan
SrcSpan -> SrcSpan -> Bool
SrcSpan -> SrcSpan -> Ordering
SrcSpan -> SrcSpan -> SrcSpan
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
$ccompare :: SrcSpan -> SrcSpan -> Ordering
compare :: SrcSpan -> SrcSpan -> Ordering
$c< :: SrcSpan -> SrcSpan -> Bool
< :: SrcSpan -> SrcSpan -> Bool
$c<= :: SrcSpan -> SrcSpan -> Bool
<= :: SrcSpan -> SrcSpan -> Bool
$c> :: SrcSpan -> SrcSpan -> Bool
> :: SrcSpan -> SrcSpan -> Bool
$c>= :: SrcSpan -> SrcSpan -> Bool
>= :: SrcSpan -> SrcSpan -> Bool
$cmax :: SrcSpan -> SrcSpan -> SrcSpan
max :: SrcSpan -> SrcSpan -> SrcSpan
$cmin :: SrcSpan -> SrcSpan -> SrcSpan
min :: SrcSpan -> SrcSpan -> SrcSpan
Ord, (forall x. SrcSpan -> Rep SrcSpan x)
-> (forall x. Rep SrcSpan x -> SrcSpan) -> Generic SrcSpan
forall x. Rep SrcSpan x -> SrcSpan
forall x. SrcSpan -> Rep SrcSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SrcSpan -> Rep SrcSpan x
from :: forall x. SrcSpan -> Rep SrcSpan x
$cto :: forall x. Rep SrcSpan x -> SrcSpan
to :: forall x. Rep SrcSpan x -> SrcSpan
Generic)
    deriving anyclass (Get SrcSpan
SrcSpan -> Encoding
SrcSpan -> Int -> Int
(SrcSpan -> Encoding)
-> Get SrcSpan -> (SrcSpan -> Int -> Int) -> Flat SrcSpan
forall a. (a -> Encoding) -> Get a -> (a -> Int -> Int) -> Flat a
$cencode :: SrcSpan -> Encoding
encode :: SrcSpan -> Encoding
$cdecode :: Get SrcSpan
decode :: Get SrcSpan
$csize :: SrcSpan -> Int -> Int
size :: SrcSpan -> Int -> Int
Flat, Eq SrcSpan
Eq SrcSpan =>
(Int -> SrcSpan -> Int) -> (SrcSpan -> Int) -> Hashable SrcSpan
Int -> SrcSpan -> Int
SrcSpan -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SrcSpan -> Int
hashWithSalt :: Int -> SrcSpan -> Int
$chash :: SrcSpan -> Int
hash :: SrcSpan -> Int
Hashable, SrcSpan -> ()
(SrcSpan -> ()) -> NFData SrcSpan
forall a. (a -> ()) -> NFData a
$crnf :: SrcSpan -> ()
rnf :: SrcSpan -> ()
NFData)

instance Show SrcSpan where
    showsPrec :: Int -> SrcSpan -> ShowS
showsPrec Int
_ SrcSpan
s =
        String -> ShowS
showString (SrcSpan -> String
srcSpanFile SrcSpan
s)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':'
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (SrcSpan -> Int
srcSpanSLine SrcSpan
s)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':'
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (SrcSpan -> Int
srcSpanSCol SrcSpan
s)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'-'
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (SrcSpan -> Int
srcSpanELine SrcSpan
s)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':'
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (if SrcSpan -> Int
srcSpanECol SrcSpan
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else SrcSpan -> Int
srcSpanECol SrcSpan
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

instance Pretty SrcSpan where
    pretty :: forall ann. SrcSpan -> Doc ann
pretty = SrcSpan -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

newtype SrcSpans = SrcSpans {SrcSpans -> Set SrcSpan
unSrcSpans :: Set SrcSpan}
    deriving newtype (SrcSpans -> SrcSpans -> Bool
(SrcSpans -> SrcSpans -> Bool)
-> (SrcSpans -> SrcSpans -> Bool) -> Eq SrcSpans
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcSpans -> SrcSpans -> Bool
== :: SrcSpans -> SrcSpans -> Bool
$c/= :: SrcSpans -> SrcSpans -> Bool
/= :: SrcSpans -> SrcSpans -> Bool
Eq, Eq SrcSpans
Eq SrcSpans =>
(SrcSpans -> SrcSpans -> Ordering)
-> (SrcSpans -> SrcSpans -> Bool)
-> (SrcSpans -> SrcSpans -> Bool)
-> (SrcSpans -> SrcSpans -> Bool)
-> (SrcSpans -> SrcSpans -> Bool)
-> (SrcSpans -> SrcSpans -> SrcSpans)
-> (SrcSpans -> SrcSpans -> SrcSpans)
-> Ord SrcSpans
SrcSpans -> SrcSpans -> Bool
SrcSpans -> SrcSpans -> Ordering
SrcSpans -> SrcSpans -> SrcSpans
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
$ccompare :: SrcSpans -> SrcSpans -> Ordering
compare :: SrcSpans -> SrcSpans -> Ordering
$c< :: SrcSpans -> SrcSpans -> Bool
< :: SrcSpans -> SrcSpans -> Bool
$c<= :: SrcSpans -> SrcSpans -> Bool
<= :: SrcSpans -> SrcSpans -> Bool
$c> :: SrcSpans -> SrcSpans -> Bool
> :: SrcSpans -> SrcSpans -> Bool
$c>= :: SrcSpans -> SrcSpans -> Bool
>= :: SrcSpans -> SrcSpans -> Bool
$cmax :: SrcSpans -> SrcSpans -> SrcSpans
max :: SrcSpans -> SrcSpans -> SrcSpans
$cmin :: SrcSpans -> SrcSpans -> SrcSpans
min :: SrcSpans -> SrcSpans -> SrcSpans
Ord, Eq SrcSpans
Eq SrcSpans =>
(Int -> SrcSpans -> Int) -> (SrcSpans -> Int) -> Hashable SrcSpans
Int -> SrcSpans -> Int
SrcSpans -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SrcSpans -> Int
hashWithSalt :: Int -> SrcSpans -> Int
$chash :: SrcSpans -> Int
hash :: SrcSpans -> Int
Hashable, NonEmpty SrcSpans -> SrcSpans
SrcSpans -> SrcSpans -> SrcSpans
(SrcSpans -> SrcSpans -> SrcSpans)
-> (NonEmpty SrcSpans -> SrcSpans)
-> (forall b. Integral b => b -> SrcSpans -> SrcSpans)
-> Semigroup SrcSpans
forall b. Integral b => b -> SrcSpans -> SrcSpans
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SrcSpans -> SrcSpans -> SrcSpans
<> :: SrcSpans -> SrcSpans -> SrcSpans
$csconcat :: NonEmpty SrcSpans -> SrcSpans
sconcat :: NonEmpty SrcSpans -> SrcSpans
$cstimes :: forall b. Integral b => b -> SrcSpans -> SrcSpans
stimes :: forall b. Integral b => b -> SrcSpans -> SrcSpans
Semigroup, Semigroup SrcSpans
SrcSpans
Semigroup SrcSpans =>
SrcSpans
-> (SrcSpans -> SrcSpans -> SrcSpans)
-> ([SrcSpans] -> SrcSpans)
-> Monoid SrcSpans
[SrcSpans] -> SrcSpans
SrcSpans -> SrcSpans -> SrcSpans
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SrcSpans
mempty :: SrcSpans
$cmappend :: SrcSpans -> SrcSpans -> SrcSpans
mappend :: SrcSpans -> SrcSpans -> SrcSpans
$cmconcat :: [SrcSpans] -> SrcSpans
mconcat :: [SrcSpans] -> SrcSpans
Monoid, Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool
SrcSpans -> Bool
SrcSpans -> Int
SrcSpans -> Int64
SrcSpans -> [Element SrcSpans]
SrcSpans -> Element SrcSpans
(Element SrcSpans -> Bool) -> SrcSpans -> Bool
(Element SrcSpans -> Element SrcSpans -> Ordering)
-> SrcSpans -> Element SrcSpans
(Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
-> SrcSpans -> Element SrcSpans
(forall m. Monoid m => (Element SrcSpans -> m) -> SrcSpans -> m)
-> (forall b. (Element SrcSpans -> b -> b) -> b -> SrcSpans -> b)
-> (forall a. (a -> Element SrcSpans -> a) -> a -> SrcSpans -> a)
-> (SrcSpans -> [Element SrcSpans])
-> ((Element SrcSpans -> Bool) -> SrcSpans -> Bool)
-> ((Element SrcSpans -> Bool) -> SrcSpans -> Bool)
-> (SrcSpans -> Bool)
-> (SrcSpans -> Int)
-> (SrcSpans -> Int64)
-> (forall i. Integral i => SrcSpans -> i -> Ordering)
-> (forall (f :: * -> *) b.
    Applicative f =>
    (Element SrcSpans -> f b) -> SrcSpans -> f ())
-> (forall (f :: * -> *) b.
    Applicative f =>
    SrcSpans -> (Element SrcSpans -> f b) -> f ())
-> (forall (m :: * -> *).
    Applicative m =>
    (Element SrcSpans -> m ()) -> SrcSpans -> m ())
-> (forall (m :: * -> *).
    Applicative m =>
    SrcSpans -> (Element SrcSpans -> m ()) -> m ())
-> (forall (m :: * -> *) a.
    Monad m =>
    (a -> Element SrcSpans -> m a) -> a -> SrcSpans -> m a)
-> (forall m.
    Semigroup m =>
    (Element SrcSpans -> m) -> SrcSpans -> m)
-> ((Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
    -> SrcSpans -> Element SrcSpans)
-> ((Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
    -> SrcSpans -> Element SrcSpans)
-> (SrcSpans -> Element SrcSpans)
-> (SrcSpans -> Element SrcSpans)
-> (SrcSpans -> Element SrcSpans)
-> (SrcSpans -> Element SrcSpans)
-> ((Element SrcSpans -> Element SrcSpans -> Ordering)
    -> SrcSpans -> Element SrcSpans)
-> ((Element SrcSpans -> Element SrcSpans -> Ordering)
    -> SrcSpans -> Element SrcSpans)
-> (Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool)
-> (Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool)
-> MonoFoldable SrcSpans
forall i. Integral i => SrcSpans -> i -> Ordering
forall m. Semigroup m => (Element SrcSpans -> m) -> SrcSpans -> m
forall m. Monoid m => (Element SrcSpans -> m) -> SrcSpans -> m
forall a. (a -> Element SrcSpans -> a) -> a -> SrcSpans -> a
forall b. (Element SrcSpans -> b -> b) -> b -> SrcSpans -> b
forall mono.
(forall m. Monoid m => (Element mono -> m) -> mono -> m)
-> (forall b. (Element mono -> b -> b) -> b -> mono -> b)
-> (forall a. (a -> Element mono -> a) -> a -> mono -> a)
-> (mono -> [Element mono])
-> ((Element mono -> Bool) -> mono -> Bool)
-> ((Element mono -> Bool) -> mono -> Bool)
-> (mono -> Bool)
-> (mono -> Int)
-> (mono -> Int64)
-> (forall i. Integral i => mono -> i -> Ordering)
-> (forall (f :: * -> *) b.
    Applicative f =>
    (Element mono -> f b) -> mono -> f ())
-> (forall (f :: * -> *) b.
    Applicative f =>
    mono -> (Element mono -> f b) -> f ())
-> (forall (m :: * -> *).
    Applicative m =>
    (Element mono -> m ()) -> mono -> m ())
-> (forall (m :: * -> *).
    Applicative m =>
    mono -> (Element mono -> m ()) -> m ())
-> (forall (m :: * -> *) a.
    Monad m =>
    (a -> Element mono -> m a) -> a -> mono -> m a)
-> (forall m. Semigroup m => (Element mono -> m) -> mono -> m)
-> ((Element mono -> Element mono -> Element mono)
    -> mono -> Element mono)
-> ((Element mono -> Element mono -> Element mono)
    -> mono -> Element mono)
-> (mono -> Element mono)
-> (mono -> Element mono)
-> (mono -> Element mono)
-> (mono -> Element mono)
-> ((Element mono -> Element mono -> Ordering)
    -> mono -> Element mono)
-> ((Element mono -> Element mono -> Ordering)
    -> mono -> Element mono)
-> (Eq (Element mono) => Element mono -> mono -> Bool)
-> (Eq (Element mono) => Element mono -> mono -> Bool)
-> MonoFoldable mono
forall (m :: * -> *).
Applicative m =>
SrcSpans -> (Element SrcSpans -> m ()) -> m ()
forall (m :: * -> *).
Applicative m =>
(Element SrcSpans -> m ()) -> SrcSpans -> m ()
forall (m :: * -> *) a.
Monad m =>
(a -> Element SrcSpans -> m a) -> a -> SrcSpans -> m a
forall (f :: * -> *) b.
Applicative f =>
SrcSpans -> (Element SrcSpans -> f b) -> f ()
forall (f :: * -> *) b.
Applicative f =>
(Element SrcSpans -> f b) -> SrcSpans -> f ()
$cofoldMap :: forall m. Monoid m => (Element SrcSpans -> m) -> SrcSpans -> m
ofoldMap :: forall m. Monoid m => (Element SrcSpans -> m) -> SrcSpans -> m
$cofoldr :: forall b. (Element SrcSpans -> b -> b) -> b -> SrcSpans -> b
ofoldr :: forall b. (Element SrcSpans -> b -> b) -> b -> SrcSpans -> b
$cofoldl' :: forall a. (a -> Element SrcSpans -> a) -> a -> SrcSpans -> a
ofoldl' :: forall a. (a -> Element SrcSpans -> a) -> a -> SrcSpans -> a
$cotoList :: SrcSpans -> [Element SrcSpans]
otoList :: SrcSpans -> [Element SrcSpans]
$coall :: (Element SrcSpans -> Bool) -> SrcSpans -> Bool
oall :: (Element SrcSpans -> Bool) -> SrcSpans -> Bool
$coany :: (Element SrcSpans -> Bool) -> SrcSpans -> Bool
oany :: (Element SrcSpans -> Bool) -> SrcSpans -> Bool
$conull :: SrcSpans -> Bool
onull :: SrcSpans -> Bool
$colength :: SrcSpans -> Int
olength :: SrcSpans -> Int
$colength64 :: SrcSpans -> Int64
olength64 :: SrcSpans -> Int64
$cocompareLength :: forall i. Integral i => SrcSpans -> i -> Ordering
ocompareLength :: forall i. Integral i => SrcSpans -> i -> Ordering
$cotraverse_ :: forall (f :: * -> *) b.
Applicative f =>
(Element SrcSpans -> f b) -> SrcSpans -> f ()
otraverse_ :: forall (f :: * -> *) b.
Applicative f =>
(Element SrcSpans -> f b) -> SrcSpans -> f ()
$cofor_ :: forall (f :: * -> *) b.
Applicative f =>
SrcSpans -> (Element SrcSpans -> f b) -> f ()
ofor_ :: forall (f :: * -> *) b.
Applicative f =>
SrcSpans -> (Element SrcSpans -> f b) -> f ()
$comapM_ :: forall (m :: * -> *).
Applicative m =>
(Element SrcSpans -> m ()) -> SrcSpans -> m ()
omapM_ :: forall (m :: * -> *).
Applicative m =>
(Element SrcSpans -> m ()) -> SrcSpans -> m ()
$coforM_ :: forall (m :: * -> *).
Applicative m =>
SrcSpans -> (Element SrcSpans -> m ()) -> m ()
oforM_ :: forall (m :: * -> *).
Applicative m =>
SrcSpans -> (Element SrcSpans -> m ()) -> m ()
$cofoldlM :: forall (m :: * -> *) a.
Monad m =>
(a -> Element SrcSpans -> m a) -> a -> SrcSpans -> m a
ofoldlM :: forall (m :: * -> *) a.
Monad m =>
(a -> Element SrcSpans -> m a) -> a -> SrcSpans -> m a
$cofoldMap1Ex :: forall m. Semigroup m => (Element SrcSpans -> m) -> SrcSpans -> m
ofoldMap1Ex :: forall m. Semigroup m => (Element SrcSpans -> m) -> SrcSpans -> m
$cofoldr1Ex :: (Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
-> SrcSpans -> Element SrcSpans
ofoldr1Ex :: (Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
-> SrcSpans -> Element SrcSpans
$cofoldl1Ex' :: (Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
-> SrcSpans -> Element SrcSpans
ofoldl1Ex' :: (Element SrcSpans -> Element SrcSpans -> Element SrcSpans)
-> SrcSpans -> Element SrcSpans
$cheadEx :: SrcSpans -> Element SrcSpans
headEx :: SrcSpans -> Element SrcSpans
$clastEx :: SrcSpans -> Element SrcSpans
lastEx :: SrcSpans -> Element SrcSpans
$cunsafeHead :: SrcSpans -> Element SrcSpans
unsafeHead :: SrcSpans -> Element SrcSpans
$cunsafeLast :: SrcSpans -> Element SrcSpans
unsafeLast :: SrcSpans -> Element SrcSpans
$cmaximumByEx :: (Element SrcSpans -> Element SrcSpans -> Ordering)
-> SrcSpans -> Element SrcSpans
maximumByEx :: (Element SrcSpans -> Element SrcSpans -> Ordering)
-> SrcSpans -> Element SrcSpans
$cminimumByEx :: (Element SrcSpans -> Element SrcSpans -> Ordering)
-> SrcSpans -> Element SrcSpans
minimumByEx :: (Element SrcSpans -> Element SrcSpans -> Ordering)
-> SrcSpans -> Element SrcSpans
$coelem :: Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool
oelem :: Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool
$conotElem :: Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool
onotElem :: Eq (Element SrcSpans) => Element SrcSpans -> SrcSpans -> Bool
MonoFoldable, SrcSpans -> ()
(SrcSpans -> ()) -> NFData SrcSpans
forall a. (a -> ()) -> NFData a
$crnf :: SrcSpans -> ()
rnf :: SrcSpans -> ()
NFData)
    deriving stock ((forall x. SrcSpans -> Rep SrcSpans x)
-> (forall x. Rep SrcSpans x -> SrcSpans) -> Generic SrcSpans
forall x. Rep SrcSpans x -> SrcSpans
forall x. SrcSpans -> Rep SrcSpans x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SrcSpans -> Rep SrcSpans x
from :: forall x. SrcSpans -> Rep SrcSpans x
$cto :: forall x. Rep SrcSpans x -> SrcSpans
to :: forall x. Rep SrcSpans x -> SrcSpans
Generic)
    deriving anyclass (Get SrcSpans
SrcSpans -> Encoding
SrcSpans -> Int -> Int
(SrcSpans -> Encoding)
-> Get SrcSpans -> (SrcSpans -> Int -> Int) -> Flat SrcSpans
forall a. (a -> Encoding) -> Get a -> (a -> Int -> Int) -> Flat a
$cencode :: SrcSpans -> Encoding
encode :: SrcSpans -> Encoding
$cdecode :: Get SrcSpans
decode :: Get SrcSpans
$csize :: SrcSpans -> Int -> Int
size :: SrcSpans -> Int -> Int
Flat)

type instance Element SrcSpans = SrcSpan

instance Show SrcSpans where
    showsPrec :: Int -> SrcSpans -> ShowS
showsPrec Int
_ (SrcSpans Set SrcSpan
xs) =
        String -> ShowS
showString String
"{ "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString
                ( case Set SrcSpan -> [SrcSpan]
forall a. Set a -> [a]
Set.toList Set SrcSpan
xs of
                    [] -> String
"no-src-span"
                    [SrcSpan]
ys -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " (SrcSpan -> String
forall a. Show a => a -> String
show (SrcSpan -> String) -> [SrcSpan] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SrcSpan]
ys)
                )
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" }"

instance Pretty SrcSpans where
    pretty :: forall ann. SrcSpans -> Doc ann
pretty = SrcSpans -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- | Add an extra SrcSpan to existing 'SrcSpans' of 'Ann'
addSrcSpan :: SrcSpan -> Ann -> Ann
addSrcSpan :: SrcSpan -> Ann -> Ann
addSrcSpan SrcSpan
s (Ann Inline
i (SrcSpans Set SrcSpan
ss)) = Inline -> SrcSpans -> Ann
Ann Inline
i (Set SrcSpan -> SrcSpans
SrcSpans (Set SrcSpan -> SrcSpans) -> Set SrcSpan -> SrcSpans
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Set SrcSpan -> Set SrcSpan
forall a. Ord a => a -> Set a -> Set a
Set.insert SrcSpan
s Set SrcSpan
ss)

-- | Tells if a line (positive integer) falls inside a SrcSpan.
lineInSrcSpan :: Pos -> SrcSpan -> Bool
lineInSrcSpan :: Pos -> SrcSpan -> Bool
lineInSrcSpan Pos
pos SrcSpan
spn =
    let i :: Int
i = Pos -> Int
Megaparsec.unPos Pos
pos
    in Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SrcSpan -> Int
srcSpanSLine SrcSpan
spn Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SrcSpan -> Int
srcSpanELine SrcSpan
spn