module Unison.Typechecker.Extractor where

import Control.Monad.Reader
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty)
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Unison.Blank qualified as B
import Unison.ConstructorReference (ConstructorReference)
import Unison.KindInference (KindError)
import Unison.Pattern (Pattern)
import Unison.Pattern qualified as Pattern
import Unison.Prelude hiding (whenM)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker.Context qualified as C
import Unison.Util.Monoid (whenM)
import Unison.Var (Var)
import Unison.Var qualified as Var

type RedundantTypeAnnotation = Bool

type Extractor e a = MaybeT (Reader e) a

type ErrorExtractor v loc a = Extractor (C.ErrorNote v loc) a

type InfoExtractor v loc a = Extractor (C.InfoNote v loc) a

type PathExtractor v loc a = Extractor (C.PathElement v loc) a

type SubseqExtractor v loc a = SubseqExtractor' (C.ErrorNote v loc) a

extractor :: (e -> Maybe a) -> Extractor e a
extractor :: forall e a. (e -> Maybe a) -> Extractor e a
extractor = Reader e (Maybe a) -> MaybeT (Reader e) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Reader e (Maybe a) -> MaybeT (Reader e) a)
-> ((e -> Maybe a) -> Reader e (Maybe a))
-> (e -> Maybe a)
-> MaybeT (Reader e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Maybe a) -> Reader e (Maybe a)
forall a. (e -> a) -> Reader e a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

extract :: Extractor e a -> e -> Maybe a
extract :: forall e a. Extractor e a -> e -> Maybe a
extract = Reader e (Maybe a) -> e -> Maybe a
forall r a. Reader r a -> r -> a
runReader (Reader e (Maybe a) -> e -> Maybe a)
-> (Extractor e a -> Reader e (Maybe a))
-> Extractor e a
-> e
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extractor e a -> Reader e (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

subseqExtractor :: (C.ErrorNote v loc -> [Ranged a]) -> SubseqExtractor v loc a
subseqExtractor :: forall v loc a.
(ErrorNote v loc -> [Ranged a]) -> SubseqExtractor v loc a
subseqExtractor ErrorNote v loc -> [Ranged a]
f = (ErrorNote v loc -> [Ranged a])
-> SubseqExtractor' (ErrorNote v loc) a
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ErrorNote v loc -> [Ranged a]
f

traceSubseq :: (Show a) => String -> SubseqExtractor' n a -> SubseqExtractor' n a
traceSubseq :: forall a n.
Show a =>
String -> SubseqExtractor' n a -> SubseqExtractor' n a
traceSubseq String
s SubseqExtractor' n a
ex = (n -> [Ranged a]) -> SubseqExtractor' n a
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged a]) -> SubseqExtractor' n a)
-> (n -> [Ranged a]) -> SubseqExtractor' n a
forall a b. (a -> b) -> a -> b
$ \n
n ->
  let rs :: [Ranged a]
rs = SubseqExtractor' n a -> n -> [Ranged a]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq SubseqExtractor' n a
ex n
n
   in String -> [Ranged a] -> [Ranged a]
forall a. String -> a -> a
trace (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then [Ranged a] -> String
forall a. Show a => a -> String
show [Ranged a]
rs else String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Ranged a] -> String
forall a. Show a => a -> String
show [Ranged a]
rs) [Ranged a]
rs

traceNote ::
  (Show a) => String -> ErrorExtractor v loc a -> ErrorExtractor v loc a
traceNote :: forall a v loc.
Show a =>
String -> ErrorExtractor v loc a -> ErrorExtractor v loc a
traceNote String
s ErrorExtractor v loc a
ex = (ErrorNote v loc -> Maybe a) -> ErrorExtractor v loc a
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((ErrorNote v loc -> Maybe a) -> ErrorExtractor v loc a)
-> (ErrorNote v loc -> Maybe a) -> ErrorExtractor v loc a
forall a b. (a -> b) -> a -> b
$ \ErrorNote v loc
n ->
  let result :: Maybe a
result = ErrorExtractor v loc a -> ErrorNote v loc -> Maybe a
forall e a. Extractor e a -> e -> Maybe a
extract ErrorExtractor v loc a
ex ErrorNote v loc
n
   in String -> Maybe a -> Maybe a
forall a. String -> a -> a
trace (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then Maybe a -> String
forall a. Show a => a -> String
show Maybe a
result else String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe a -> String
forall a. Show a => a -> String
show Maybe a
result) Maybe a
result

unique :: SubseqExtractor v loc a -> ErrorExtractor v loc a
unique :: forall v loc a. SubseqExtractor v loc a -> ErrorExtractor v loc a
unique SubseqExtractor v loc a
ex = (ErrorNote v loc -> Maybe a) -> Extractor (ErrorNote v loc) a
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((ErrorNote v loc -> Maybe a) -> Extractor (ErrorNote v loc) a)
-> (ErrorNote v loc -> Maybe a) -> Extractor (ErrorNote v loc) a
forall a b. (a -> b) -> a -> b
$ \ErrorNote v loc
note -> case SubseqExtractor v loc a -> ErrorNote v loc -> [Ranged a]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq SubseqExtractor v loc a
ex ErrorNote v loc
note of
  [Pure a
a] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
  [Ranged a
a Int
_ Int
_] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
  [Ranged a]
_ -> Maybe a
forall a. Maybe a
Nothing

data SubseqExtractor' n a = SubseqExtractor' {forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq :: n -> [Ranged a]}

data Ranged a
  = Pure a
  | Ranged {forall a. Ranged a -> a
get :: a, forall a. Ranged a -> Int
start :: Int, forall a. Ranged a -> Int
end :: Int}
  deriving ((forall a b. (a -> b) -> Ranged a -> Ranged b)
-> (forall a b. a -> Ranged b -> Ranged a) -> Functor Ranged
forall a b. a -> Ranged b -> Ranged a
forall a b. (a -> b) -> Ranged a -> Ranged 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) -> Ranged a -> Ranged b
fmap :: forall a b. (a -> b) -> Ranged a -> Ranged b
$c<$ :: forall a b. a -> Ranged b -> Ranged a
<$ :: forall a b. a -> Ranged b -> Ranged a
Functor, Int -> Ranged a -> String -> String
[Ranged a] -> String -> String
Ranged a -> String
(Int -> Ranged a -> String -> String)
-> (Ranged a -> String)
-> ([Ranged a] -> String -> String)
-> Show (Ranged a)
forall a. Show a => Int -> Ranged a -> String -> String
forall a. Show a => [Ranged a] -> String -> String
forall a. Show a => Ranged a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Ranged a -> String -> String
showsPrec :: Int -> Ranged a -> String -> String
$cshow :: forall a. Show a => Ranged a -> String
show :: Ranged a -> String
$cshowList :: forall a. Show a => [Ranged a] -> String -> String
showList :: [Ranged a] -> String -> String
Show)

-- | collects the regions where `xa` doesn't match / aka invert a set of intervals
-- unused, but don't want to delete it yet - Aug 30, 2018
_no :: SubseqExtractor' n a -> SubseqExtractor' n ()
_no :: forall n a. SubseqExtractor' n a -> SubseqExtractor' n ()
_no SubseqExtractor' n a
xa = (n -> [Ranged ()]) -> SubseqExtractor' n ()
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged ()]) -> SubseqExtractor' n ())
-> (n -> [Ranged ()]) -> SubseqExtractor' n ()
forall a b. (a -> b) -> a -> b
$ \n
note ->
  let as :: [Ranged a]
as = SubseqExtractor' n a -> n -> [Ranged a]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq SubseqExtractor' n a
xa n
note
   in if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a
a | Pure a
a <- [Ranged a]
as]
        then -- results are not full
          if [Ranged a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ranged a]
as
            then [() -> Ranged ()
forall a. a -> Ranged a
Pure ()] -- results are empty, make them full
            -- not full and not empty, find the negation
            else
              [Ranged ()] -> [Ranged ()]
forall a. [a] -> [a]
reverse ([Ranged ()] -> [Ranged ()])
-> (([Ranged ()], Maybe Int) -> [Ranged ()])
-> ([Ranged ()], Maybe Int)
-> [Ranged ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ranged ()], Maybe Int) -> [Ranged ()]
forall a b. (a, b) -> a
fst (([Ranged ()], Maybe Int) -> [Ranged ()])
-> ([Ranged ()], Maybe Int) -> [Ranged ()]
forall a b. (a -> b) -> a -> b
$
                (([Ranged ()], Maybe Int)
 -> (Int, Int) -> ([Ranged ()], Maybe Int))
-> ([Ranged ()], Maybe Int)
-> [(Int, Int)]
-> ([Ranged ()], Maybe Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                  ([Ranged ()], Maybe Int) -> (Int, Int) -> ([Ranged ()], Maybe Int)
go
                  ([], Maybe Int
forall a. Maybe a
Nothing)
                  ([(Int, Int)] -> [(Int, Int)]
forall a. Ord a => [a] -> [a]
List.sort ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Ranged a -> (Int, Int)) -> [Ranged a] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ranged a -> (Int, Int)
forall a. Ranged a -> (Int, Int)
toPairs [Ranged a]
as)
        else [] -- results were full, make them empty
  where
    toPairs :: Ranged a -> (Int, Int)
    toPairs :: forall a. Ranged a -> (Int, Int)
toPairs (Pure a
_) = String -> (Int, Int)
forall a. HasCallStack => String -> a
error String
"this case should be avoided by the if!"
    toPairs (Ranged a
_ Int
start Int
end) = (Int
start, Int
end)

    go :: ([Ranged ()], Maybe Int) -> (Int, Int) -> ([Ranged ()], Maybe Int)
    go :: ([Ranged ()], Maybe Int) -> (Int, Int) -> ([Ranged ()], Maybe Int)
go ([], Maybe Int
Nothing) (Int
0, Int
r) = ([], Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    go ([], Maybe Int
Nothing) (Int
l, Int
r) = ([() -> Int -> Int -> Ranged ()
forall a. a -> Int -> Int -> Ranged a
Ranged () Int
0 (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)], Int -> Maybe Int
forall a. a -> Maybe a
Just Int
r)
    go (Ranged ()
_ : [Ranged ()]
_, Maybe Int
Nothing) (Int, Int)
_ = String -> ([Ranged ()], Maybe Int)
forall a. HasCallStack => String -> a
error String
"state machine bug in Extractor2.no"
    go ([Ranged ()]
rs, Just Int
r0) (Int
l, Int
r) =
      (if Int
r0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then () -> Int -> Int -> Ranged ()
forall a. a -> Int -> Int -> Ranged a
Ranged () (Int
r0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Ranged () -> [Ranged ()] -> [Ranged ()]
forall a. a -> [a] -> [a]
: [Ranged ()]
rs else [Ranged ()]
rs, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
r)

-- unused / untested
_any :: SubseqExtractor v loc ()
_any :: forall v loc. SubseqExtractor v loc ()
_any = (ErrorNote v loc -> Int) -> SubseqExtractor' (ErrorNote v loc) ()
forall n. (n -> Int) -> SubseqExtractor' n ()
_any' (\ErrorNote v loc
n -> ErrorNote v loc -> Int
forall v loc. ErrorNote v loc -> Int
pathLength ErrorNote v loc
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    pathLength :: C.ErrorNote v loc -> Int
    pathLength :: forall v loc. ErrorNote v loc -> Int
pathLength = [PathElement v loc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PathElement v loc] -> Int)
-> (ErrorNote v loc -> [PathElement v loc])
-> ErrorNote v loc
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (PathElement v loc) -> [PathElement v loc]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (PathElement v loc) -> [PathElement v loc])
-> (ErrorNote v loc -> Seq (PathElement v loc))
-> ErrorNote v loc
-> [PathElement v loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorNote v loc -> Seq (PathElement v loc)
forall v loc. ErrorNote v loc -> Seq (PathElement v loc)
C.path

_any' :: (n -> Int) -> SubseqExtractor' n ()
_any' :: forall n. (n -> Int) -> SubseqExtractor' n ()
_any' n -> Int
getLast = (n -> [Ranged ()]) -> SubseqExtractor' n ()
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged ()]) -> SubseqExtractor' n ())
-> (n -> [Ranged ()]) -> SubseqExtractor' n ()
forall a b. (a -> b) -> a -> b
$ \n
note ->
  () -> Ranged ()
forall a. a -> Ranged a
Pure () Ranged () -> [Ranged ()] -> [Ranged ()]
forall a. a -> [a] -> [a]
: do
    let last :: Int
last = n -> Int
getLast n
note
    Int
start <- [Int
0 .. Int
last]
    Int
end <- [Int
0 .. Int
last]
    pure $ () -> Int -> Int -> Ranged ()
forall a. a -> Int -> Int -> Ranged a
Ranged () Int
start Int
end

-- Kind of a newtype for Ranged.Ranged.
-- The Eq instance ignores the embedded value
data DistinctRanged a = DistinctRanged a Int Int

instance Eq (DistinctRanged a) where
  DistinctRanged a
_ Int
l Int
r == :: DistinctRanged a -> DistinctRanged a -> Bool
== DistinctRanged a
_ Int
l' Int
r' = Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l' Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r'

instance Ord (DistinctRanged a) where
  DistinctRanged a
_ Int
l Int
r <= :: DistinctRanged a -> DistinctRanged a -> Bool
<= DistinctRanged a
_ Int
l' Int
r' =
    Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l' Bool -> Bool -> Bool
|| (Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l' Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r')

-- todo: this could return NonEmpty
some :: forall n a. SubseqExtractor' n a -> SubseqExtractor' n [a]
some :: forall n a. SubseqExtractor' n a -> SubseqExtractor' n [a]
some SubseqExtractor' n a
xa = (n -> [Ranged [a]]) -> SubseqExtractor' n [a]
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged [a]]) -> SubseqExtractor' n [a])
-> (n -> [Ranged [a]]) -> SubseqExtractor' n [a]
forall a b. (a -> b) -> a -> b
$ \n
note ->
  let as :: [Ranged a]
      as :: [Ranged a]
as = SubseqExtractor' n a -> n -> [Ranged a]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq SubseqExtractor' n a
xa n
note
   in -- Given a list of subseqs [Ranged a], find the adjacent groups [Ranged [a]].
      -- `Pure`s arguably can't be adjacent; not sure what to do with them. Currently ignored.
      ([a] -> [a]) -> Ranged [a] -> Ranged [a]
forall a b. (a -> b) -> Ranged a -> Ranged b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (Ranged [a] -> Ranged [a]) -> [Ranged [a]] -> [Ranged [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (DistinctRanged [a]) -> [Ranged a] -> [Ranged [a]]
go Set (DistinctRanged [a])
forall a. Set a
Set.empty [Ranged a]
as
  where
    fromDistinct :: DistinctRanged a -> Ranged a
fromDistinct (DistinctRanged a
a Int
l Int
r) = a -> Int -> Int -> Ranged a
forall a. a -> Int -> Int -> Ranged a
Ranged a
a Int
l Int
r
    go :: Set (DistinctRanged [a]) -> [Ranged a] -> [Ranged [a]]
    go :: Set (DistinctRanged [a]) -> [Ranged a] -> [Ranged [a]]
go Set (DistinctRanged [a])
seen [] = (DistinctRanged [a] -> Ranged [a])
-> [DistinctRanged [a]] -> [Ranged [a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DistinctRanged [a] -> Ranged [a]
forall {a}. DistinctRanged a -> Ranged a
fromDistinct ([DistinctRanged [a]] -> [Ranged [a]])
-> (Set (DistinctRanged [a]) -> [DistinctRanged [a]])
-> Set (DistinctRanged [a])
-> [Ranged [a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (DistinctRanged [a]) -> [DistinctRanged [a]]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (DistinctRanged [a]) -> [Ranged [a]])
-> Set (DistinctRanged [a]) -> [Ranged [a]]
forall a b. (a -> b) -> a -> b
$ Set (DistinctRanged [a])
seen
    go Set (DistinctRanged [a])
seen (rh :: Ranged a
rh@(Ranged a
h Int
start Int
end) : [Ranged a]
t) =
      let seen' :: Set (DistinctRanged [a])
          seen' :: Set (DistinctRanged [a])
seen' =
            [DistinctRanged [a]] -> Set (DistinctRanged [a])
forall a. Ord a => [a] -> Set a
Set.fromList ([DistinctRanged [a]] -> Set (DistinctRanged [a]))
-> (Set (DistinctRanged [a]) -> [DistinctRanged [a]])
-> Set (DistinctRanged [a])
-> Set (DistinctRanged [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[DistinctRanged [a]]] -> [DistinctRanged [a]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[DistinctRanged [a]]] -> [DistinctRanged [a]])
-> (Set (DistinctRanged [a]) -> [[DistinctRanged [a]]])
-> Set (DistinctRanged [a])
-> [DistinctRanged [a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DistinctRanged [a] -> [DistinctRanged [a]])
-> [DistinctRanged [a]] -> [[DistinctRanged [a]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (DistinctRanged [a]) -> [DistinctRanged [a]]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe (DistinctRanged [a]) -> [DistinctRanged [a]])
-> (DistinctRanged [a] -> Maybe (DistinctRanged [a]))
-> DistinctRanged [a]
-> [DistinctRanged [a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ranged a -> DistinctRanged [a] -> Maybe (DistinctRanged [a])
consRange Ranged a
rh) ([DistinctRanged [a]] -> [[DistinctRanged [a]]])
-> (Set (DistinctRanged [a]) -> [DistinctRanged [a]])
-> Set (DistinctRanged [a])
-> [[DistinctRanged [a]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (DistinctRanged [a]) -> [DistinctRanged [a]]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (DistinctRanged [a]) -> Set (DistinctRanged [a]))
-> Set (DistinctRanged [a]) -> Set (DistinctRanged [a])
forall a b. (a -> b) -> a -> b
$ Set (DistinctRanged [a])
seen
       in Set (DistinctRanged [a]) -> [Ranged a] -> [Ranged [a]]
go (DistinctRanged [a]
-> Set (DistinctRanged [a]) -> Set (DistinctRanged [a])
forall a. Ord a => a -> Set a -> Set a
Set.insert ([a] -> Int -> Int -> DistinctRanged [a]
forall a. a -> Int -> Int -> DistinctRanged a
DistinctRanged [a
h] Int
start Int
end) Set (DistinctRanged [a])
seen Set (DistinctRanged [a])
-> Set (DistinctRanged [a]) -> Set (DistinctRanged [a])
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (DistinctRanged [a])
seen') [Ranged a]
t
    go Set (DistinctRanged [a])
seen (Pure a
_ : [Ranged a]
t) = Set (DistinctRanged [a]) -> [Ranged a] -> [Ranged [a]]
go Set (DistinctRanged [a])
seen [Ranged a]
t

    consRange :: Ranged a -> DistinctRanged [a] -> Maybe (DistinctRanged [a])
    consRange :: Ranged a -> DistinctRanged [a] -> Maybe (DistinctRanged [a])
consRange Ranged a
new group :: DistinctRanged [a]
group@(DistinctRanged [a]
as Int
start' Int
_) =
      if DistinctRanged [a] -> Ranged a -> Bool
forall a b. DistinctRanged a -> Ranged b -> Bool
isAdjacent DistinctRanged [a]
group Ranged a
new
        then DistinctRanged [a] -> Maybe (DistinctRanged [a])
forall a. a -> Maybe a
Just ([a] -> Int -> Int -> DistinctRanged [a]
forall a. a -> Int -> Int -> DistinctRanged a
DistinctRanged (Ranged a -> a
forall a. Ranged a -> a
get Ranged a
new a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) Int
start' (Ranged a -> Int
forall a. Ranged a -> Int
end Ranged a
new))
        else Maybe (DistinctRanged [a])
forall a. Maybe a
Nothing

    -- Returns true if inputs are adjacent Ranged regions
    -- Question: Should a Pure be considered adjacent?
    isAdjacent :: forall a b. DistinctRanged a -> Ranged b -> Bool
    isAdjacent :: forall a b. DistinctRanged a -> Ranged b -> Bool
isAdjacent (DistinctRanged a
_ Int
_ Int
endA) (Ranged b
_ Int
startB Int
_) = Int
endA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startB
    isAdjacent DistinctRanged a
_ Ranged b
_ = Bool
False

pathStart :: SubseqExtractor' n ()
pathStart :: forall n. SubseqExtractor' n ()
pathStart = (n -> [Ranged ()]) -> SubseqExtractor' n ()
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged ()]) -> SubseqExtractor' n ())
-> (n -> [Ranged ()]) -> SubseqExtractor' n ()
forall a b. (a -> b) -> a -> b
$ \n
_ -> [() -> Int -> Int -> Ranged ()
forall a. a -> Int -> Int -> Ranged a
Ranged () (-Int
1) (-Int
1)]

-- Scopes --
asPathExtractor :: (C.PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor :: forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor = PathExtractor v loc a -> SubseqExtractor v loc a
forall v loc a. PathExtractor v loc a -> SubseqExtractor v loc a
fromPathExtractor (PathExtractor v loc a -> SubseqExtractor v loc a)
-> ((PathElement v loc -> Maybe a) -> PathExtractor v loc a)
-> (PathElement v loc -> Maybe a)
-> SubseqExtractor v loc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathElement v loc -> Maybe a) -> PathExtractor v loc a
forall e a. (e -> Maybe a) -> Extractor e a
extractor
  where
    fromPathExtractor :: PathExtractor v loc a -> SubseqExtractor v loc a
    fromPathExtractor :: forall v loc a. PathExtractor v loc a -> SubseqExtractor v loc a
fromPathExtractor PathExtractor v loc a
ex =
      (ErrorNote v loc -> [Ranged a]) -> SubseqExtractor v loc a
forall v loc a.
(ErrorNote v loc -> [Ranged a]) -> SubseqExtractor v loc a
subseqExtractor ((ErrorNote v loc -> [Ranged a]) -> SubseqExtractor v loc a)
-> (ErrorNote v loc -> [Ranged a]) -> SubseqExtractor v loc a
forall a b. (a -> b) -> a -> b
$ [[Ranged a]] -> [Ranged a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Ranged a]] -> [Ranged a])
-> (ErrorNote v loc -> [[Ranged a]])
-> ErrorNote v loc
-> [Ranged a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PathElement v loc, Int) -> [Ranged a])
-> [(PathElement v loc, Int)] -> [[Ranged a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathElement v loc, Int) -> [Ranged a]
go ([(PathElement v loc, Int)] -> [[Ranged a]])
-> (ErrorNote v loc -> [(PathElement v loc, Int)])
-> ErrorNote v loc
-> [[Ranged a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PathElement v loc] -> [Int] -> [(PathElement v loc, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0 ..]) ([PathElement v loc] -> [(PathElement v loc, Int)])
-> (ErrorNote v loc -> [PathElement v loc])
-> ErrorNote v loc
-> [(PathElement v loc, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (PathElement v loc) -> [PathElement v loc]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (PathElement v loc) -> [PathElement v loc])
-> (ErrorNote v loc -> Seq (PathElement v loc))
-> ErrorNote v loc
-> [PathElement v loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorNote v loc -> Seq (PathElement v loc)
forall v loc. ErrorNote v loc -> Seq (PathElement v loc)
C.path
      where
        go :: (PathElement v loc, Int) -> [Ranged a]
go (PathElement v loc
e, Int
i) = case PathExtractor v loc a -> PathElement v loc -> Maybe a
forall e a. Extractor e a -> e -> Maybe a
extract PathExtractor v loc a
ex PathElement v loc
e of
          Just a
a -> [a -> Int -> Int -> Ranged a
forall a. a -> Int -> Int -> Ranged a
Ranged a
a Int
i Int
i]
          Maybe a
Nothing -> []

inSynthesize :: SubseqExtractor v loc (C.Term v loc)
inSynthesize :: forall v loc. SubseqExtractor v loc (Term v loc)
inSynthesize = (PathElement v loc -> Maybe (Term v loc))
-> SubseqExtractor v loc (Term v loc)
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe (Term v loc))
 -> SubseqExtractor v loc (Term v loc))
-> (PathElement v loc -> Maybe (Term v loc))
-> SubseqExtractor v loc (Term v loc)
forall a b. (a -> b) -> a -> b
$ \case
  C.InSynthesize Term v loc
t -> Term v loc -> Maybe (Term v loc)
forall a. a -> Maybe a
Just Term v loc
t
  PathElement v loc
_ -> Maybe (Term v loc)
forall a. Maybe a
Nothing

inSubtype :: SubseqExtractor v loc (C.Type v loc, C.Type v loc)
inSubtype :: forall v loc. SubseqExtractor v loc (Type v loc, Type v loc)
inSubtype = (PathElement v loc -> Maybe (Type v loc, Type v loc))
-> SubseqExtractor v loc (Type v loc, Type v loc)
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe (Type v loc, Type v loc))
 -> SubseqExtractor v loc (Type v loc, Type v loc))
-> (PathElement v loc -> Maybe (Type v loc, Type v loc))
-> SubseqExtractor v loc (Type v loc, Type v loc)
forall a b. (a -> b) -> a -> b
$ \case
  C.InSubtype Type v loc
found Type v loc
expected -> (Type v loc, Type v loc) -> Maybe (Type v loc, Type v loc)
forall a. a -> Maybe a
Just (Type v loc
found, Type v loc
expected)
  C.InEquate Type v loc
found Type v loc
expected -> (Type v loc, Type v loc) -> Maybe (Type v loc, Type v loc)
forall a. a -> Maybe a
Just (Type v loc
found, Type v loc
expected)
  PathElement v loc
_ -> Maybe (Type v loc, Type v loc)
forall a. Maybe a
Nothing

inEquate :: SubseqExtractor v loc (C.Type v loc, C.Type v loc)
inEquate :: forall v loc. SubseqExtractor v loc (Type v loc, Type v loc)
inEquate = (PathElement v loc -> Maybe (Type v loc, Type v loc))
-> SubseqExtractor v loc (Type v loc, Type v loc)
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe (Type v loc, Type v loc))
 -> SubseqExtractor v loc (Type v loc, Type v loc))
-> (PathElement v loc -> Maybe (Type v loc, Type v loc))
-> SubseqExtractor v loc (Type v loc, Type v loc)
forall a b. (a -> b) -> a -> b
$ \case
  C.InEquate Type v loc
lhs Type v loc
rhs -> (Type v loc, Type v loc) -> Maybe (Type v loc, Type v loc)
forall a. a -> Maybe a
Just (Type v loc
lhs, Type v loc
rhs)
  PathElement v loc
_ -> Maybe (Type v loc, Type v loc)
forall a. Maybe a
Nothing

inCheck :: SubseqExtractor v loc (C.Term v loc, C.Type v loc)
inCheck :: forall v loc. SubseqExtractor v loc (Term v loc, Type v loc)
inCheck = (PathElement v loc -> Maybe (Term v loc, Type v loc))
-> SubseqExtractor v loc (Term v loc, Type v loc)
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe (Term v loc, Type v loc))
 -> SubseqExtractor v loc (Term v loc, Type v loc))
-> (PathElement v loc -> Maybe (Term v loc, Type v loc))
-> SubseqExtractor v loc (Term v loc, Type v loc)
forall a b. (a -> b) -> a -> b
$ \case
  C.InCheck Term v loc
e Type v loc
t -> (Term v loc, Type v loc) -> Maybe (Term v loc, Type v loc)
forall a. a -> Maybe a
Just (Term v loc
e, Type v loc
t)
  PathElement v loc
_ -> Maybe (Term v loc, Type v loc)
forall a. Maybe a
Nothing

-- inInstantiateL
-- inInstantiateR

inActionRestriction :: SubseqExtractor v loc ()
inActionRestriction :: forall v loc. SubseqExtractor v loc ()
inActionRestriction = (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ())
-> (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall a b. (a -> b) -> a -> b
$ \case
  PathElement v loc
C.InActionRestriction -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  PathElement v loc
_ -> Maybe ()
forall a. Maybe a
Nothing

inSynthesizeApp :: SubseqExtractor v loc (C.Type v loc, C.Term v loc, Int)
inSynthesizeApp :: forall v loc. SubseqExtractor v loc (Type v loc, Term v loc, Int)
inSynthesizeApp = (PathElement v loc -> Maybe (Type v loc, Term v loc, Int))
-> SubseqExtractor v loc (Type v loc, Term v loc, Int)
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe (Type v loc, Term v loc, Int))
 -> SubseqExtractor v loc (Type v loc, Term v loc, Int))
-> (PathElement v loc -> Maybe (Type v loc, Term v loc, Int))
-> SubseqExtractor v loc (Type v loc, Term v loc, Int)
forall a b. (a -> b) -> a -> b
$ \case
  C.InSynthesizeApp Type v loc
t Term v loc
e Int
n -> (Type v loc, Term v loc, Int)
-> Maybe (Type v loc, Term v loc, Int)
forall a. a -> Maybe a
Just (Type v loc
t, Term v loc
e, Int
n)
  PathElement v loc
_ -> Maybe (Type v loc, Term v loc, Int)
forall a. Maybe a
Nothing

inFunctionCall ::
  SubseqExtractor v loc ([v], C.Term v loc, C.Type v loc, [C.Term v loc])
inFunctionCall :: forall v loc.
SubseqExtractor v loc ([v], Term v loc, Type v loc, [Term v loc])
inFunctionCall = (PathElement v loc
 -> Maybe ([v], Term v loc, Type v loc, [Term v loc]))
-> SubseqExtractor
     v loc ([v], Term v loc, Type v loc, [Term v loc])
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc
  -> Maybe ([v], Term v loc, Type v loc, [Term v loc]))
 -> SubseqExtractor
      v loc ([v], Term v loc, Type v loc, [Term v loc]))
-> (PathElement v loc
    -> Maybe ([v], Term v loc, Type v loc, [Term v loc]))
-> SubseqExtractor
     v loc ([v], Term v loc, Type v loc, [Term v loc])
forall a b. (a -> b) -> a -> b
$ \case
  C.InFunctionCall [v]
vs Term v loc
f Type v loc
ft [Term v loc]
e -> case Term v loc
f of
    Term.Ann' Term v loc
f Type v loc
_ -> ([v], Term v loc, Type v loc, [Term v loc])
-> Maybe ([v], Term v loc, Type v loc, [Term v loc])
forall a. a -> Maybe a
Just ([v]
vs, Term v loc
f, Type v loc
ft, [Term v loc]
e)
    Term v loc
f -> ([v], Term v loc, Type v loc, [Term v loc])
-> Maybe ([v], Term v loc, Type v loc, [Term v loc])
forall a. a -> Maybe a
Just ([v]
vs, Term v loc
f, Type v loc
ft, [Term v loc]
e)
  PathElement v loc
_ -> Maybe ([v], Term v loc, Type v loc, [Term v loc])
forall a. Maybe a
Nothing

inRecordLiteral ::
  SubseqExtractor v loc loc
inRecordLiteral :: forall v loc. SubseqExtractor v loc loc
inRecordLiteral = (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc)
-> (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall a b. (a -> b) -> a -> b
$ \case
  C.InRecordLiteral loc
loc -> loc -> Maybe loc
forall a. a -> Maybe a
Just loc
loc
  PathElement v loc
_ -> Maybe loc
forall a. Maybe a
Nothing

inRecordField ::
  SubseqExtractor v loc (loc, Text)
inRecordField :: forall v loc. SubseqExtractor v loc (loc, Text)
inRecordField = (PathElement v loc -> Maybe (loc, Text))
-> SubseqExtractor v loc (loc, Text)
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe (loc, Text))
 -> SubseqExtractor v loc (loc, Text))
-> (PathElement v loc -> Maybe (loc, Text))
-> SubseqExtractor v loc (loc, Text)
forall a b. (a -> b) -> a -> b
$ \case
  C.InRecordField loc
loc Text
t -> (loc, Text) -> Maybe (loc, Text)
forall a. a -> Maybe a
Just (loc
loc, Text
t)
  PathElement v loc
_ -> Maybe (loc, Text)
forall a. Maybe a
Nothing

inAndApp,
  inOrApp,
  inIfCond,
  inMatchGuard,
  inMatchBody ::
    SubseqExtractor v loc ()
inAndApp :: forall v loc. SubseqExtractor v loc ()
inAndApp = (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ())
-> (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall a b. (a -> b) -> a -> b
$ \case
  PathElement v loc
C.InAndApp -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  PathElement v loc
_ -> Maybe ()
forall a. Maybe a
Nothing
inOrApp :: forall v loc. SubseqExtractor v loc ()
inOrApp = (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ())
-> (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall a b. (a -> b) -> a -> b
$ \case
  PathElement v loc
C.InOrApp -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  PathElement v loc
_ -> Maybe ()
forall a. Maybe a
Nothing
inIfCond :: forall v loc. SubseqExtractor v loc ()
inIfCond = (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ())
-> (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall a b. (a -> b) -> a -> b
$ \case
  PathElement v loc
C.InIfCond -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  PathElement v loc
_ -> Maybe ()
forall a. Maybe a
Nothing
inMatchGuard :: forall v loc. SubseqExtractor v loc ()
inMatchGuard = (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ())
-> (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall a b. (a -> b) -> a -> b
$ \case
  PathElement v loc
C.InMatchGuard -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  PathElement v loc
_ -> Maybe ()
forall a. Maybe a
Nothing
inMatchBody :: forall v loc. SubseqExtractor v loc ()
inMatchBody = (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ())
-> (PathElement v loc -> Maybe ()) -> SubseqExtractor v loc ()
forall a b. (a -> b) -> a -> b
$ \case
  PathElement v loc
C.InMatchBody -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  PathElement v loc
_ -> Maybe ()
forall a. Maybe a
Nothing

inMatch, inVector, inIfBody :: SubseqExtractor v loc loc
inMatch :: forall v loc. SubseqExtractor v loc loc
inMatch = (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc)
-> (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall a b. (a -> b) -> a -> b
$ \case
  C.InMatch loc
loc -> loc -> Maybe loc
forall a. a -> Maybe a
Just loc
loc
  PathElement v loc
_ -> Maybe loc
forall a. Maybe a
Nothing
inVector :: forall v loc. SubseqExtractor v loc loc
inVector = (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc)
-> (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall a b. (a -> b) -> a -> b
$ \case
  C.InVectorApp loc
loc -> loc -> Maybe loc
forall a. a -> Maybe a
Just loc
loc
  PathElement v loc
_ -> Maybe loc
forall a. Maybe a
Nothing
inIfBody :: forall v loc. SubseqExtractor v loc loc
inIfBody = (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall v loc a.
(PathElement v loc -> Maybe a) -> SubseqExtractor v loc a
asPathExtractor ((PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc)
-> (PathElement v loc -> Maybe loc) -> SubseqExtractor v loc loc
forall a b. (a -> b) -> a -> b
$ \case
  C.InIfBody loc
loc -> loc -> Maybe loc
forall a. a -> Maybe a
Just loc
loc
  PathElement v loc
_ -> Maybe loc
forall a. Maybe a
Nothing

-- Causes --
cause :: ErrorExtractor v loc (C.Cause v loc)
cause :: forall v loc. ErrorExtractor v loc (Cause v loc)
cause = (ErrorNote v loc -> Maybe (Cause v loc))
-> Extractor (ErrorNote v loc) (Cause v loc)
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((ErrorNote v loc -> Maybe (Cause v loc))
 -> Extractor (ErrorNote v loc) (Cause v loc))
-> (ErrorNote v loc -> Maybe (Cause v loc))
-> Extractor (ErrorNote v loc) (Cause v loc)
forall a b. (a -> b) -> a -> b
$ Cause v loc -> Maybe (Cause v loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cause v loc -> Maybe (Cause v loc))
-> (ErrorNote v loc -> Cause v loc)
-> ErrorNote v loc
-> Maybe (Cause v loc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorNote v loc -> Cause v loc
forall v loc. ErrorNote v loc -> Cause v loc
C.cause

duplicateDefinitions :: ErrorExtractor v loc (NonEmpty (v, NESet loc))
duplicateDefinitions :: forall v loc. ErrorExtractor v loc (NonEmpty (v, NESet loc))
duplicateDefinitions =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (v, NESet loc)))
-> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (v, NESet loc))
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.DuplicateDefinitions NonEmpty (v, NESet loc)
vs -> NonEmpty (v, NESet loc)
-> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (v, NESet loc))
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (v, NESet loc)
vs
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (v, NESet loc))
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

uncoveredPatterns :: ErrorExtractor v loc (loc, NonEmpty (Pattern ()))
uncoveredPatterns :: forall v loc. ErrorExtractor v loc (loc, NonEmpty (Pattern ()))
uncoveredPatterns =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (loc, NonEmpty (Pattern ())))
-> MaybeT (Reader (ErrorNote v loc)) (loc, NonEmpty (Pattern ()))
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.UncoveredPatterns loc
matchLoc NonEmpty (Pattern ())
xs -> (loc, NonEmpty (Pattern ()))
-> MaybeT (Reader (ErrorNote v loc)) (loc, NonEmpty (Pattern ()))
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (loc
matchLoc, NonEmpty (Pattern ())
xs)
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (loc, NonEmpty (Pattern ()))
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Alternative f => f a
empty

redundantPattern :: ErrorExtractor v loc loc
redundantPattern :: forall v loc. ErrorExtractor v loc loc
redundantPattern =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc -> MaybeT (Reader (ErrorNote v loc)) loc)
-> MaybeT (Reader (ErrorNote v loc)) loc
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.RedundantPattern loc
patternLoc -> loc -> MaybeT (Reader (ErrorNote v loc)) loc
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure loc
patternLoc
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) loc
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Alternative f => f a
empty

kindInferenceFailure :: ErrorExtractor v loc (KindError v loc)
kindInferenceFailure :: forall v loc. ErrorExtractor v loc (KindError v loc)
kindInferenceFailure =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (KindError v loc))
-> MaybeT (Reader (ErrorNote v loc)) (KindError v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.KindInferenceFailure KindError v loc
ke -> KindError v loc
-> MaybeT (Reader (ErrorNote v loc)) (KindError v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KindError v loc
ke
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (KindError v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Alternative f => f a
empty

runWatchTypeMismatch :: ErrorExtractor v loc (loc, Type v loc)
runWatchTypeMismatch :: forall v loc. ErrorExtractor v loc (loc, Type v loc)
runWatchTypeMismatch =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc))
-> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.RunWatchTypeMismatch loc
loc Type v loc
typ -> (loc, Type v loc)
-> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (loc
loc, Type v loc
typ)
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

typeMismatch :: ErrorExtractor v loc (C.Context v loc)
typeMismatch :: forall v loc. ErrorExtractor v loc (Context v loc)
typeMismatch =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (Context v loc))
-> MaybeT (Reader (ErrorNote v loc)) (Context v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.TypeMismatch Context v loc
c -> Context v loc -> MaybeT (Reader (ErrorNote v loc)) (Context v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context v loc
c
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (Context v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

missingRecordField :: ErrorExtractor v loc (Text, C.Type v loc, C.Type v loc, C.Type v loc)
missingRecordField :: forall v loc.
ErrorExtractor v loc (Text, Type v loc, Type v loc, Type v loc)
missingRecordField =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc))
         (Text, Type v loc, Type v loc, Type v loc))
-> MaybeT
     (Reader (ErrorNote v loc))
     (Text, Type v loc, Type v loc, Type v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.MissingRecordField Text
fieldName Type v loc
expectedFieldType Type v loc
actualRecordType Type v loc
expectedRecordType ->
      (Text, Type v loc, Type v loc, Type v loc)
-> MaybeT
     (Reader (ErrorNote v loc))
     (Text, Type v loc, Type v loc, Type v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldName, Type v loc
expectedFieldType, Type v loc
actualRecordType, Type v loc
expectedRecordType)
    Cause v loc
_ -> MaybeT
  (Reader (ErrorNote v loc))
  (Text, Type v loc, Type v loc, Type v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

unexpectedRecordField :: ErrorExtractor v loc (Text, C.Type v loc, C.Type v loc, C.Type v loc)
unexpectedRecordField :: forall v loc.
ErrorExtractor v loc (Text, Type v loc, Type v loc, Type v loc)
unexpectedRecordField =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc))
         (Text, Type v loc, Type v loc, Type v loc))
-> MaybeT
     (Reader (ErrorNote v loc))
     (Text, Type v loc, Type v loc, Type v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.UnexpectedRecordField Text
fieldName Type v loc
actualFieldType Type v loc
recordWithoutField Type v loc
recordWithField ->
      (Text, Type v loc, Type v loc, Type v loc)
-> MaybeT
     (Reader (ErrorNote v loc))
     (Text, Type v loc, Type v loc, Type v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldName, Type v loc
actualFieldType, Type v loc
recordWithoutField, Type v loc
recordWithField)
    Cause v loc
_ -> MaybeT
  (Reader (ErrorNote v loc))
  (Text, Type v loc, Type v loc, Type v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

patternMatchedMissingField :: ErrorExtractor v loc (Text, loc, C.Type v loc)
patternMatchedMissingField :: forall v loc. ErrorExtractor v loc (Text, loc, Type v loc)
patternMatchedMissingField =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (Text, loc, Type v loc))
-> MaybeT (Reader (ErrorNote v loc)) (Text, loc, Type v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.PatternMatchedMissingField Text
fieldName Pattern loc
fieldPat Type v loc
recordType ->
      (Text, loc, Type v loc)
-> MaybeT (Reader (ErrorNote v loc)) (Text, loc, Type v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldName, Pattern loc -> loc
forall loc. Pattern loc -> loc
Pattern.loc Pattern loc
fieldPat, Type v loc
recordType)
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (Text, loc, Type v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

recordPatternMatchOnNonRecordType :: ErrorExtractor v loc (loc, C.Type v loc)
recordPatternMatchOnNonRecordType :: forall v loc. ErrorExtractor v loc (loc, Type v loc)
recordPatternMatchOnNonRecordType =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc))
-> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.RecordPatternMatchOnNonRecordType Pattern loc
recordPat Type v loc
nonRecordType ->
      (loc, Type v loc)
-> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> loc
forall loc. Pattern loc -> loc
Pattern.loc Pattern loc
recordPat, Type v loc
nonRecordType)
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (loc, Type v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

illFormedType :: ErrorExtractor v loc (C.Context v loc)
illFormedType :: forall v loc. ErrorExtractor v loc (Context v loc)
illFormedType =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT (Reader (ErrorNote v loc)) (Context v loc))
-> MaybeT (Reader (ErrorNote v loc)) (Context v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.IllFormedType Context v loc
c -> Context v loc -> MaybeT (Reader (ErrorNote v loc)) (Context v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context v loc
c
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (Context v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

unknownSymbol :: ErrorExtractor v loc (loc, v)
unknownSymbol :: forall v loc. ErrorExtractor v loc (loc, v)
unknownSymbol =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc -> MaybeT (Reader (ErrorNote v loc)) (loc, v))
-> MaybeT (Reader (ErrorNote v loc)) (loc, v)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.UnknownSymbol loc
loc v
v -> (loc, v) -> MaybeT (Reader (ErrorNote v loc)) (loc, v)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (loc
loc, v
v)
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (loc, v)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

unknownTerm :: (Var v) => ErrorExtractor v loc (loc, v, [C.Suggestion v loc], C.Type v loc)
unknownTerm :: forall v loc.
Var v =>
ErrorExtractor v loc (loc, v, [Suggestion v loc], Type v loc)
unknownTerm =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc))
         (loc, v, [Suggestion v loc], Type v loc))
-> MaybeT
     (Reader (ErrorNote v loc)) (loc, v, [Suggestion v loc], Type v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.UnknownTerm loc
loc v
v [Suggestion v loc]
suggestions Type v loc
expectedType -> do
      let k :: Type
k = InferenceType -> Type
Var.Inference InferenceType
Var.Ability
          cleanup :: Type (TypeVar v loc) a -> Type (TypeVar v loc) a
cleanup = Type (TypeVar v loc) a -> Type (TypeVar v loc) a
forall v a. Var v => Type v a -> Type v a
Type.cleanup (Type (TypeVar v loc) a -> Type (TypeVar v loc) a)
-> (Type (TypeVar v loc) a -> Type (TypeVar v loc) a)
-> Type (TypeVar v loc) a
-> Type (TypeVar v loc) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Type (TypeVar v loc) a -> Type (TypeVar v loc) a
forall v a. Var v => Bool -> Type v a -> Type v a
Type.removePureEffects Bool
False (Type (TypeVar v loc) a -> Type (TypeVar v loc) a)
-> (Type (TypeVar v loc) a -> Type (TypeVar v loc) a)
-> Type (TypeVar v loc) a
-> Type (TypeVar v loc) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type (TypeVar v loc) a -> Type (TypeVar v loc) a
forall v a. Var v => Type -> Type v a -> Type v a
Type.generalize' Type
k
      (loc, v, [Suggestion v loc], Type v loc)
-> MaybeT
     (Reader (ErrorNote v loc)) (loc, v, [Suggestion v loc], Type v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (loc
loc, v
v, [Suggestion v loc]
suggestions, Type v loc -> Type v loc
forall {a}. Type (TypeVar v loc) a -> Type (TypeVar v loc) a
cleanup Type v loc
expectedType)
    Cause v loc
_ -> MaybeT
  (Reader (ErrorNote v loc)) (loc, v, [Suggestion v loc], Type v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

abilityCheckFailure ::
  ErrorExtractor v loc ([C.Type v loc], [C.Type v loc], C.Context v loc)
abilityCheckFailure :: forall v loc.
ErrorExtractor v loc ([Type v loc], [Type v loc], Context v loc)
abilityCheckFailure =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc))
         ([Type v loc], [Type v loc], Context v loc))
-> MaybeT
     (Reader (ErrorNote v loc))
     ([Type v loc], [Type v loc], Context v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.AbilityCheckFailure [Type v loc]
ambient [Type v loc]
requested Context v loc
ctx -> ([Type v loc], [Type v loc], Context v loc)
-> MaybeT
     (Reader (ErrorNote v loc))
     ([Type v loc], [Type v loc], Context v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type v loc]
ambient, [Type v loc]
requested, Context v loc
ctx)
    Cause v loc
_ -> MaybeT
  (Reader (ErrorNote v loc))
  ([Type v loc], [Type v loc], Context v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

abilityEqFailure ::
  ErrorExtractor v loc ([C.Type v loc], [C.Type v loc], C.Context v loc)
abilityEqFailure :: forall v loc.
ErrorExtractor v loc ([Type v loc], [Type v loc], Context v loc)
abilityEqFailure =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc))
         ([Type v loc], [Type v loc], Context v loc))
-> MaybeT
     (Reader (ErrorNote v loc))
     ([Type v loc], [Type v loc], Context v loc)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.AbilityEqFailure [Type v loc]
lhs [Type v loc]
rhs Context v loc
ctx -> ([Type v loc], [Type v loc], Context v loc)
-> MaybeT
     (Reader (ErrorNote v loc))
     ([Type v loc], [Type v loc], Context v loc)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type v loc]
lhs, [Type v loc]
rhs, Context v loc
ctx)
    Cause v loc
_ -> MaybeT
  (Reader (ErrorNote v loc))
  ([Type v loc], [Type v loc], Context v loc)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

effectConstructorWrongArgCount ::
  ErrorExtractor
    v
    loc
    (C.ExpectedArgCount, C.ActualArgCount, ConstructorReference)
effectConstructorWrongArgCount :: forall v loc. ErrorExtractor v loc (Int, Int, ConstructorReference)
effectConstructorWrongArgCount =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc)) (Int, Int, ConstructorReference))
-> MaybeT
     (Reader (ErrorNote v loc)) (Int, Int, ConstructorReference)
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.EffectConstructorWrongArgCount Int
expected Int
actual ConstructorReference
r ->
      (Int, Int, ConstructorReference)
-> MaybeT
     (Reader (ErrorNote v loc)) (Int, Int, ConstructorReference)
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
expected, Int
actual, ConstructorReference
r)
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (Int, Int, ConstructorReference)
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

malformedEffectBind ::
  ErrorExtractor v loc (C.Type v loc, C.Type v loc, [C.Type v loc])
malformedEffectBind :: forall v loc.
ErrorExtractor v loc (Type v loc, Type v loc, [Type v loc])
malformedEffectBind =
  ErrorExtractor v loc (Cause v loc)
forall v loc. ErrorExtractor v loc (Cause v loc)
cause ErrorExtractor v loc (Cause v loc)
-> (Cause v loc
    -> MaybeT
         (Reader (ErrorNote v loc)) (Type v loc, Type v loc, [Type v loc]))
-> MaybeT
     (Reader (ErrorNote v loc)) (Type v loc, Type v loc, [Type v loc])
forall a b.
MaybeT (Reader (ErrorNote v loc)) a
-> (a -> MaybeT (Reader (ErrorNote v loc)) b)
-> MaybeT (Reader (ErrorNote v loc)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    C.MalformedEffectBind Type v loc
ctor Type v loc
ctorResult [Type v loc]
es -> (Type v loc, Type v loc, [Type v loc])
-> MaybeT
     (Reader (ErrorNote v loc)) (Type v loc, Type v loc, [Type v loc])
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type v loc
ctor, Type v loc
ctorResult, [Type v loc]
es)
    Cause v loc
_ -> MaybeT
  (Reader (ErrorNote v loc)) (Type v loc, Type v loc, [Type v loc])
forall a. MaybeT (Reader (ErrorNote v loc)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

solvedBlank :: InfoExtractor v loc (B.Recorded loc, v, C.Type v loc)
solvedBlank :: forall v loc. InfoExtractor v loc (Recorded loc, v, Type v loc)
solvedBlank = (InfoNote v loc -> Maybe (Recorded loc, v, Type v loc))
-> Extractor (InfoNote v loc) (Recorded loc, v, Type v loc)
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((InfoNote v loc -> Maybe (Recorded loc, v, Type v loc))
 -> Extractor (InfoNote v loc) (Recorded loc, v, Type v loc))
-> (InfoNote v loc -> Maybe (Recorded loc, v, Type v loc))
-> Extractor (InfoNote v loc) (Recorded loc, v, Type v loc)
forall a b. (a -> b) -> a -> b
$ \InfoNote v loc
n -> case InfoNote v loc
n of
  C.SolvedBlank Recorded loc
b v
v Type v loc
t -> (Recorded loc, v, Type v loc)
-> Maybe (Recorded loc, v, Type v loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Recorded loc
b, v
v, Type v loc
t)
  InfoNote v loc
_ -> Maybe (Recorded loc, v, Type v loc)
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- Misc --
errorNote :: ErrorExtractor v loc (C.ErrorNote v loc)
errorNote :: forall v loc. ErrorExtractor v loc (ErrorNote v loc)
errorNote = (ErrorNote v loc -> Maybe (ErrorNote v loc))
-> Extractor (ErrorNote v loc) (ErrorNote v loc)
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((ErrorNote v loc -> Maybe (ErrorNote v loc))
 -> Extractor (ErrorNote v loc) (ErrorNote v loc))
-> (ErrorNote v loc -> Maybe (ErrorNote v loc))
-> Extractor (ErrorNote v loc) (ErrorNote v loc)
forall a b. (a -> b) -> a -> b
$ ErrorNote v loc -> Maybe (ErrorNote v loc)
forall a. a -> Maybe a
Just (ErrorNote v loc -> Maybe (ErrorNote v loc))
-> (ErrorNote v loc -> ErrorNote v loc)
-> ErrorNote v loc
-> Maybe (ErrorNote v loc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorNote v loc -> ErrorNote v loc
forall a. a -> a
id

infoNote :: InfoExtractor v loc (C.InfoNote v loc)
infoNote :: forall v loc. InfoExtractor v loc (InfoNote v loc)
infoNote = (InfoNote v loc -> Maybe (InfoNote v loc))
-> Extractor (InfoNote v loc) (InfoNote v loc)
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((InfoNote v loc -> Maybe (InfoNote v loc))
 -> Extractor (InfoNote v loc) (InfoNote v loc))
-> (InfoNote v loc -> Maybe (InfoNote v loc))
-> Extractor (InfoNote v loc) (InfoNote v loc)
forall a b. (a -> b) -> a -> b
$ InfoNote v loc -> Maybe (InfoNote v loc)
forall a. a -> Maybe a
Just (InfoNote v loc -> Maybe (InfoNote v loc))
-> (InfoNote v loc -> InfoNote v loc)
-> InfoNote v loc
-> Maybe (InfoNote v loc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoNote v loc -> InfoNote v loc
forall a. a -> a
id

innermostTerm :: ErrorExtractor v loc (C.Term v loc)
innermostTerm :: forall v loc. ErrorExtractor v loc (Term v loc)
innermostTerm = (ErrorNote v loc -> Maybe (Term v loc))
-> Extractor (ErrorNote v loc) (Term v loc)
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((ErrorNote v loc -> Maybe (Term v loc))
 -> Extractor (ErrorNote v loc) (Term v loc))
-> (ErrorNote v loc -> Maybe (Term v loc))
-> Extractor (ErrorNote v loc) (Term v loc)
forall a b. (a -> b) -> a -> b
$ \ErrorNote v loc
n -> case ErrorNote v loc -> Maybe (Term v loc)
forall v loc. ErrorNote v loc -> Maybe (Term v loc)
C.innermostErrorTerm ErrorNote v loc
n of
  Just Term v loc
e -> Term v loc -> Maybe (Term v loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term v loc
e
  Maybe (Term v loc)
Nothing -> Maybe (Term v loc)
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

path :: ErrorExtractor v loc [C.PathElement v loc]
path :: forall v loc. ErrorExtractor v loc [PathElement v loc]
path = (ErrorNote v loc -> Maybe [PathElement v loc])
-> Extractor (ErrorNote v loc) [PathElement v loc]
forall e a. (e -> Maybe a) -> Extractor e a
extractor ((ErrorNote v loc -> Maybe [PathElement v loc])
 -> Extractor (ErrorNote v loc) [PathElement v loc])
-> (ErrorNote v loc -> Maybe [PathElement v loc])
-> Extractor (ErrorNote v loc) [PathElement v loc]
forall a b. (a -> b) -> a -> b
$ [PathElement v loc] -> Maybe [PathElement v loc]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PathElement v loc] -> Maybe [PathElement v loc])
-> (ErrorNote v loc -> [PathElement v loc])
-> ErrorNote v loc
-> Maybe [PathElement v loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (PathElement v loc) -> [PathElement v loc]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (PathElement v loc) -> [PathElement v loc])
-> (ErrorNote v loc -> Seq (PathElement v loc))
-> ErrorNote v loc
-> [PathElement v loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorNote v loc -> Seq (PathElement v loc)
forall v loc. ErrorNote v loc -> Seq (PathElement v loc)
C.path

-- Informational notes --
topLevelComponent ::
  InfoExtractor
    v
    loc
    [(v, Type v loc, RedundantTypeAnnotation)]
topLevelComponent :: forall v loc. InfoExtractor v loc [(v, Type v loc, Bool)]
topLevelComponent = (InfoNote v loc -> Maybe [(v, Type v loc, Bool)])
-> Extractor (InfoNote v loc) [(v, Type v loc, Bool)]
forall e a. (e -> Maybe a) -> Extractor e a
extractor InfoNote v loc -> Maybe [(v, Type v loc, Bool)]
forall {v} {loc}. InfoNote v loc -> Maybe [(v, Type v loc, Bool)]
go
  where
    go :: InfoNote v loc -> Maybe [(v, Type v loc, Bool)]
go (C.TopLevelComponent [(v, Type v loc, Bool)]
c) = [(v, Type v loc, Bool)] -> Maybe [(v, Type v loc, Bool)]
forall a. a -> Maybe a
Just [(v, Type v loc, Bool)]
c
    go InfoNote v loc
_ = Maybe [(v, Type v loc, Bool)]
forall a. Maybe a
Nothing

instance Functor (SubseqExtractor' n) where
  fmap :: forall a b.
(a -> b) -> SubseqExtractor' n a -> SubseqExtractor' n b
fmap = (a -> b) -> SubseqExtractor' n a -> SubseqExtractor' n b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (SubseqExtractor' n) where
  pure :: forall a. a -> SubseqExtractor' n a
pure a
a = (n -> [Ranged a]) -> SubseqExtractor' n a
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged a]) -> SubseqExtractor' n a)
-> (n -> [Ranged a]) -> SubseqExtractor' n a
forall a b. (a -> b) -> a -> b
$ \n
_ -> [a -> Ranged a
forall a. a -> Ranged a
Pure a
a]
  <*> :: forall a b.
SubseqExtractor' n (a -> b)
-> SubseqExtractor' n a -> SubseqExtractor' n b
(<*>) = SubseqExtractor' n (a -> b)
-> SubseqExtractor' n a -> SubseqExtractor' n b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadFail (SubseqExtractor' n) where
  fail :: forall a. String -> SubseqExtractor' n a
fail String
_ = SubseqExtractor' n a
forall a. SubseqExtractor' n a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance Monad (SubseqExtractor' n) where
  return :: forall a. a -> SubseqExtractor' n a
return = a -> SubseqExtractor' n a
forall a. a -> SubseqExtractor' n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  SubseqExtractor' n a
xa >>= :: forall a b.
SubseqExtractor' n a
-> (a -> SubseqExtractor' n b) -> SubseqExtractor' n b
>>= a -> SubseqExtractor' n b
f = (n -> [Ranged b]) -> SubseqExtractor' n b
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged b]) -> SubseqExtractor' n b)
-> (n -> [Ranged b]) -> SubseqExtractor' n b
forall a b. (a -> b) -> a -> b
$ \n
note ->
    let as :: [Ranged a]
as = SubseqExtractor' n a -> n -> [Ranged a]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq SubseqExtractor' n a
xa n
note
     in do
          Ranged a
ra <- [Ranged a]
as
          case Ranged a
ra of
            Pure a
a -> SubseqExtractor' n b -> n -> [Ranged b]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq (a -> SubseqExtractor' n b
f a
a) n
note
            Ranged a
a Int
startA Int
endA ->
              let rbs :: [Ranged b]
rbs = SubseqExtractor' n b -> n -> [Ranged b]
forall n a. SubseqExtractor' n a -> n -> [Ranged a]
runSubseq (a -> SubseqExtractor' n b
f a
a) n
note
               in do
                    Ranged b
rb <- [Ranged b]
rbs
                    case Ranged b
rb of
                      Pure b
b -> Ranged b -> [Ranged b]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Int -> Int -> Ranged b
forall a. a -> Int -> Int -> Ranged a
Ranged b
b Int
startA Int
endA)
                      Ranged b
b Int
startB Int
endB ->
                        Bool -> [Ranged b] -> [Ranged b]
forall a. Monoid a => Bool -> a -> a
whenM (Int
startB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ranged b -> [Ranged b]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Int -> Int -> Ranged b
forall a. a -> Int -> Int -> Ranged a
Ranged b
b Int
startA Int
endB))

instance Alternative (SubseqExtractor' n) where
  empty :: forall a. SubseqExtractor' n a
empty = SubseqExtractor' n a
forall a. SubseqExtractor' n a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a.
SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
(<|>) = SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
forall a.
SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance MonadPlus (SubseqExtractor' n) where
  mzero :: forall a. SubseqExtractor' n a
mzero = (n -> [Ranged a]) -> SubseqExtractor' n a
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' ((n -> [Ranged a]) -> SubseqExtractor' n a)
-> (n -> [Ranged a]) -> SubseqExtractor' n a
forall a b. (a -> b) -> a -> b
$ \n
_ -> []
  mplus :: forall a.
SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
mplus (SubseqExtractor' n -> [Ranged a]
f1) (SubseqExtractor' n -> [Ranged a]
f2) =
    (n -> [Ranged a]) -> SubseqExtractor' n a
forall n a. (n -> [Ranged a]) -> SubseqExtractor' n a
SubseqExtractor' (\n
n -> n -> [Ranged a]
f1 n
n [Ranged a] -> [Ranged a] -> [Ranged a]
forall a. [a] -> [a] -> [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` n -> [Ranged a]
f2 n
n)

instance Monoid (SubseqExtractor' n a) where
  mempty :: SubseqExtractor' n a
mempty = SubseqExtractor' n a
forall a. SubseqExtractor' n a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance Semigroup (SubseqExtractor' n a) where
  <> :: SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
(<>) = SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
forall a.
SubseqExtractor' n a
-> SubseqExtractor' n a -> SubseqExtractor' n a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus