{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Parser.Ann where

import Control.Comonad.Cofree (Cofree ((:<)))
import Data.List.NonEmpty (NonEmpty)
import Data.Void (absurd)
import Unison.Lexer.Pos qualified as L
import Unison.Prelude

data Ann
  = -- Used for things like Builtins which don't have a source position.
    Intrinsic -- { sig :: String, start :: L.Pos, end :: L.Pos }
  | External
  | -- Indicates that the term was generated from something at this location.
    -- E.g. generated record field accessors (get, modify, etc.) are generated from their field definition, so are tagged
    -- with @GeneratedFrom <field position>@
    GeneratedFrom Ann
  | Ann {Ann -> Pos
start :: L.Pos, Ann -> Pos
end :: L.Pos}
  deriving (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, 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)

startingLine :: Ann -> Maybe L.Line
startingLine :: Ann -> Maybe Int
startingLine (Ann (Pos -> Int
L.line -> Int
line) Pos
_) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
line
startingLine (GeneratedFrom Ann
a) = Ann -> Maybe Int
startingLine Ann
a
startingLine Ann
_ = Maybe Int
forall a. Maybe a
Nothing

instance Monoid Ann where
  mempty :: Ann
mempty = Ann
External

-- | This instance is commutative.
instance Semigroup Ann where
  Ann Pos
s1 Pos
e1 <> :: Ann -> Ann -> Ann
<> Ann Pos
s2 Pos
e2 = Pos -> Pos -> Ann
Ann (Pos -> Pos -> Pos
forall a. Ord a => a -> a -> a
min Pos
s1 Pos
s2) (Pos -> Pos -> Pos
forall a. Ord a => a -> a -> a
max Pos
e1 Pos
e2)
  -- If we have a concrete location from a file, use it
  Ann
External <> Ann
a = Ann
a
  Ann
a <> Ann
External = Ann
a
  Ann
Intrinsic <> Ann
a = Ann
a
  Ann
a <> Ann
Intrinsic = Ann
a
  GeneratedFrom Ann
a <> Ann
b = Ann
a Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
b
  Ann
a <> GeneratedFrom Ann
b = Ann
a Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
b

-- | Checks whether an annotation contains a given position
-- i.e. pos ∈ [start, end)
--
-- >>> Intrinsic `contains` L.Pos 1 1
-- False
--
-- >>> External `contains` L.Pos 1 1
-- False
--
-- >>> Ann (L.Pos 0 0) (L.Pos 0 10) `contains` L.Pos 0 5
-- True
--
-- >>> Ann (L.Pos 0 0) (L.Pos 0 10) `contains` L.Pos 0 10
-- False
contains :: Ann -> L.Pos -> Bool
contains :: Ann -> Pos -> Bool
contains Ann
Intrinsic Pos
_ = Bool
False
contains Ann
External Pos
_ = Bool
False
contains (Ann Pos
start Pos
end) Pos
p = Pos
start Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
p Bool -> Bool -> Bool
&& Pos
p Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
end
contains (GeneratedFrom Ann
ann) Pos
p = Ann -> Pos -> Bool
contains Ann
ann Pos
p

-- | Checks whether an annotation contains another annotation.
--
-- i.e. pos ∈ [start, end)
--
-- >>> Intrinsic `encompasses` Ann (L.Pos 1 1) (L.Pos 2 1)
-- Nothing
--
-- >>> External `encompasses` Ann (L.Pos 1 1) (L.Pos 2 1)
-- Nothing
--
-- >>> Ann (L.Pos 0 0) (L.Pos 0 10) `encompasses` Ann (L.Pos 0 1) (L.Pos 0 5)
-- Just True
--
-- >>> Ann (L.Pos 1 0) (L.Pos 1 10) `encompasses` Ann (L.Pos 0 0) (L.Pos 2 0)
-- Just False
encompasses :: Ann -> Ann -> Maybe Bool
encompasses :: Ann -> Ann -> Maybe Bool
encompasses Ann
Intrinsic Ann
_ = Maybe Bool
forall a. Maybe a
Nothing
encompasses Ann
External Ann
_ = Maybe Bool
forall a. Maybe a
Nothing
encompasses Ann
_ Ann
Intrinsic = Maybe Bool
forall a. Maybe a
Nothing
encompasses Ann
_ Ann
External = Maybe Bool
forall a. Maybe a
Nothing
encompasses (GeneratedFrom Ann
ann) Ann
other = Ann -> Ann -> Maybe Bool
encompasses Ann
ann Ann
other
encompasses Ann
ann (GeneratedFrom Ann
other) = Ann -> Ann -> Maybe Bool
encompasses Ann
ann Ann
other
encompasses (Ann Pos
start1 Pos
end1) (Ann Pos
start2 Pos
end2) =
  Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Pos
start1 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
start2 Bool -> Bool -> Bool
&& Pos
end1 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= Pos
end2

class Annotated a where
  ann :: a -> Ann

instance Annotated Ann where
  ann :: Ann -> Ann
ann = Ann -> Ann
forall a. a -> a
id

instance (Annotated a) => Annotated [a] where
  ann :: [a] -> Ann
ann = (a -> Ann) -> [a] -> Ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Ann
forall a. Annotated a => a -> Ann
ann

instance (Annotated a) => Annotated (NonEmpty a) where
  ann :: NonEmpty a -> Ann
ann = (a -> Ann) -> NonEmpty a -> Ann
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Ann
forall a. Annotated a => a -> Ann
ann

instance (Annotated a) => Annotated (Maybe a) where
  ann :: Maybe a -> Ann
ann = (a -> Ann) -> Maybe a -> Ann
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Ann
forall a. Annotated a => a -> Ann
ann

instance Annotated Void where
  ann :: Void -> Ann
ann = Void -> Ann
forall a. Void -> a
absurd

instance (Annotated a) => Annotated (Cofree f a) where
  ann :: Cofree f a -> Ann
ann (a
a :< f (Cofree f a)
_) = a -> Ann
forall a. Annotated a => a -> Ann
ann a
a