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 Unison.Blank qualified as B
import Unison.ConstructorReference (ConstructorReference)
import Unison.KindInference (KindError)
import Unison.Pattern (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

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

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, [loc]))
duplicateDefinitions :: forall v loc. ErrorExtractor v loc (NonEmpty (v, [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, [loc])))
-> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (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.DuplicateDefinitions NonEmpty (v, [loc])
vs -> NonEmpty (v, [loc])
-> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (v, [loc]))
forall a. a -> MaybeT (Reader (ErrorNote v loc)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (v, [loc])
vs
    Cause v loc
_ -> MaybeT (Reader (ErrorNote v loc)) (NonEmpty (v, [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

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

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