diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs index f6309b1b0..a05c4a8fe 100644 --- a/semantic-core/src/Analysis/Concrete.hs +++ b/semantic-core/src/Analysis/Concrete.hs @@ -78,7 +78,7 @@ concrete -> (term Name -> m (Concrete (term Name))) ) -> [File (term Name)] - -> (Heap (term Name), [File (Either (File String) (Concrete (term Name)))]) + -> (Heap (term Name), [File (Either (Path, Span, String) (Concrete (term Name)))]) concrete eval = run . runFresh @@ -100,7 +100,7 @@ runFile -> (term Name -> m (Concrete (term Name))) ) -> File (term Name) - -> m (File (Either (File String) (Concrete (term Name)))) + -> m (File (Either (Path, Span, String) (Concrete (term Name)))) runFile eval file = traverse run file where run = runReader (filePath file) . runReader (fileSpan file) diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs index 638eb7ee8..0369f4f65 100644 --- a/semantic-core/src/Analysis/ImportGraph.hs +++ b/semantic-core/src/Analysis/ImportGraph.hs @@ -59,7 +59,7 @@ importGraph ) -> [File term] -> ( Heap Name (Value term) - , [File (Either (File String) (Value term))] + , [File (Either (Path, Span, String) (Value term))] ) importGraph eval = run @@ -82,7 +82,7 @@ runFile -> (term -> m (Value term)) ) -> File term - -> m (File (Either (File String) (Value term))) + -> m (File (Either (Path, Span, String) (Value term))) runFile eval file = traverse run file where run = runReader (filePath file) . runReader (fileSpan file) diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs index daa1363f3..d013adc8a 100644 --- a/semantic-core/src/Analysis/ScopeGraph.hs +++ b/semantic-core/src/Analysis/ScopeGraph.hs @@ -56,7 +56,7 @@ scopeGraph -> (term -> m ScopeGraph) ) -> [File term] - -> (Heap Name ScopeGraph, [File (Either (File String) ScopeGraph)]) + -> (Heap Name ScopeGraph, [File (Either (Path, Span, String) ScopeGraph)]) scopeGraph eval = run . runFresh @@ -77,7 +77,7 @@ runFile -> (term -> m ScopeGraph) ) -> File term - -> m (File (Either (File String) ScopeGraph)) + -> m (File (Either (Path, Span, String) ScopeGraph)) runFile eval file = traverse run file where run = runReader (filePath file) . runReader (fileSpan file) diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs index 7e8242328..c77d6ab38 100644 --- a/semantic-core/src/Analysis/Typecheck.hs +++ b/semantic-core/src/Analysis/Typecheck.hs @@ -102,7 +102,7 @@ typecheckingFlowInsensitive ) -> [File term] -> ( Heap Name Type - , [File (Either (File String) (Term (Polytype :+: Monotype) Void))] + , [File (Either (Path, Span, String) (Term (Polytype :+: Monotype) Void))] ) typecheckingFlowInsensitive eval = run @@ -125,7 +125,7 @@ runFile -> (term -> m Type) ) -> File term - -> m (File (Either (File String) Type)) + -> m (File (Either (Path, Span, String) Type)) runFile eval file = traverse run file where run = (\ m -> do diff --git a/semantic-core/src/Control/Carrier/Fail/WithFile.hs b/semantic-core/src/Control/Carrier/Fail/WithFile.hs index e6513c7b6..d37c42229 100644 --- a/semantic-core/src/Control/Carrier/Fail/WithFile.hs +++ b/semantic-core/src/Control/Carrier/Fail/WithFile.hs @@ -13,18 +13,20 @@ import Control.Effect.Error import Control.Effect.Fail (Fail(..), MonadFail(..)) import Control.Effect.Reader import Data.Loc -import Data.File import Prelude hiding (fail) import Source.Span -runFail :: FailC m a -> m (Either (File String) a) +runFail :: FailC m a -> m (Either (Path, Span, String) a) runFail = runError . runFailC -newtype FailC m a = FailC { runFailC :: ErrorC (File String) m a } +newtype FailC m a = FailC { runFailC :: ErrorC (Path, Span, String) m a } deriving (Alternative, Applicative, Functor, Monad) instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => MonadFail (FailC m) where - fail s = File <$> ask <*> ask <*> pure s >>= FailC . throwError + fail s = do + path <- ask + span <- ask + FailC (throwError (path :: Path, span :: Span, s)) instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => Carrier (Fail :+: sig) (FailC m) where eff (L (Fail s)) = fail s