From b19c381edbf34abcf89f6bea78bd6ba21d160f98 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 6 Jun 2018 09:45:40 -0400
Subject: [PATCH] :fire: the Fail effect.

---
 src/Analysis/Abstract/Evaluating.hs | 7 ++-----
 src/Semantic/Graph.hs               | 6 ++----
 src/Semantic/Util.hs                | 7 ++-----
 test/SpecHelpers.hs                 | 2 +-
 4 files changed, 7 insertions(+), 15 deletions(-)

diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs
index b927bdbd5..7c07abd1a 100644
--- a/src/Analysis/Abstract/Evaluating.hs
+++ b/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
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index bef0be7e4..b18c32dcd 100644
--- a/src/Semantic/Graph.hs
+++ b/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
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 7ccc6cfb6..901db3204 100644
--- a/src/Semantic/Util.hs
+++ b/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) }
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 6aee58368..3aba7a008 100644
--- a/test/SpecHelpers.hs
+++ b/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