🔥 the Fail effect.

src/Analysis/Abstract/Evaluating.hs

@@ -5,7 +5,6 @@ module Analysis.Abstract.Evaluating
 ) where
 
 import Control.Abstract
-import Control.Monad.Effect.Fail
 import Data.Semilattice.Lower
 
 -- | An analysis evaluating @term@s to @value@s with a list of @effects@ using 'Evaluatable', and producing incremental results of type @a@.
@@ -20,15 +19,13 @@ deriving instance (Show (Cell address value), Show address, Show value) => Show
 
 
 evaluating :: Evaluator address value
-                (  Fail
-                ': Fresh
+                (  Fresh
                 ': State (Heap address (Cell address) value)
                 ': State (ModuleTable (Maybe (value, Environment address)))
                 ': effects) result
-           -> Evaluator address value effects (Either String result, EvaluatingState address value)
+           -> Evaluator address value effects (result, EvaluatingState address value)
 evaluating
   = fmap (\ ((result, heap), modules) -> (result, EvaluatingState heap modules))
   . runState lowerBound -- State (ModuleTable (Maybe (value, Environment address)))
   . runState lowerBound -- State (Heap address (Cell address) value)
   . runFresh 0
-  . runFail

src/Semantic/Graph.hs

@@ -19,7 +19,6 @@ module Semantic.Graph
 import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
 import           Control.Abstract
-import qualified Control.Exception as Exc
 import           Control.Monad.Effect (reinterpret)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
@@ -38,7 +37,7 @@ import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
 
-runGraph :: ( Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
+runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
          -> Project
@@ -53,8 +52,7 @@ runGraph graphType includePackages project
         analyzeModule = (if includePackages then graphingPackages else id) . graphingModules
     analyze runGraphAnalysis (evaluatePackageWith analyzeModule analyzeTerm package) >>= extractGraph
     where extractGraph result = case result of
-            (Right ((_, graph), _), _) -> pure (simplify graph)
-            _ -> Task.throwError (toException (Exc.ErrorCall ("graphImports: import graph rendering failed " <> show result)))
+            (((_, graph), _), _) -> pure (simplify graph)
           runGraphAnalysis
             = run
             . evaluating

src/Semantic/Util.hs

@@ -35,9 +35,9 @@ import qualified Language.TypeScript.Assignment as TypeScript
 
 justEvaluating
   = runM
-  . fmap (first reassociate)
   . evaluating
   . runPrintingTrace
+  . fmap reassociate
   . runLoadError
   . runUnspecialized
   . runResolutionError
@@ -87,13 +87,10 @@ blob :: FilePath -> IO Blob
 blob = runTask . readBlob . file
 
 
-injectConst :: a -> SomeExc (Sum '[Const a])
-injectConst = SomeExc . inject . Const
-
 mergeExcs :: Either (SomeExc (Sum excs)) (Either (SomeExc exc) result) -> Either (SomeExc (Sum (exc ': excs))) result
 mergeExcs = either (\ (SomeExc sum) -> Left (SomeExc (weaken sum))) (either (\ (SomeExc exc) -> Left (SomeExc (inject exc))) Right)
 
-reassociate = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . first injectConst
+reassociate = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . Right
 
 
 newtype Quieterm syntax ann = Quieterm { unQuieterm :: TermF syntax ann (Quieterm syntax ann) }

test/SpecHelpers.hs

@@ -80,8 +80,8 @@ readFilePair paths = let paths' = fmap file paths in
 testEvaluating
   = run
   . runReturningTrace
-  . fmap (first reassociate)
   . evaluating
+  . fmap reassociate
   . runLoadError
   . runUnspecialized
   . runResolutionError