Fix remaining monad pattern matches for ghc 8.6.

Tested with `stack test` (all passing). Fixes #494.
kadena-io · May 3, 2019 · 787b465 · 787b465
1 parent d7a2dbe
commit 787b465
Show file tree

Hide file tree

Showing 2 changed files with 49 additions and 36 deletions.
diff --git a/tests/AnalyzePropertiesSpec.hs b/tests/AnalyzePropertiesSpec.hs
@@ -57,28 +57,33 @@ testDualEvaluation' etm ty gState = do
       failure
 
     (Right pactVal, Right analyzeVal) -> do
-      Just etm' <- lift $ fromPactVal (EType ty) pactVal
-      case etm' of
-        Some ty' (CoreTerm (Lit pactSval)) -> do
-          Some ty'' (CoreTerm (Lit sval')) <- pure analyzeVal
-
-          -- compare results
-          case singEq ty' ty'' of
-            Just Refl
-              -- we only test bounded lists up to length 10. discard if the
-              -- pact list is too long.
-              -- TODO: this should only be considered a temporary fix. Done
-              -- properly we need to check all intermediate values.
-              | SList{} <- ty'
-              , length pactSval > 10
-              -> discard
-              | otherwise -> withEq ty' $ withShow ty' $ sval' === pactSval
-            Nothing   ->
-              if singEqB ty' (SList SAny) || singEqB ty'' (SList SAny)
-              then discard -- TODO: check this case
-              else EType ty' === EType ty'' -- this'll fail
-
-        Some _ (CoreTerm (LiteralObject _ _obj)) -> do
+      mEtm <- lift $ fromPactVal (EType ty) pactVal
+      case mEtm of
+        Just (Some ty' (CoreTerm (Lit pactSval))) -> do
+          someVal <- pure analyzeVal
+
+          case someVal of
+            Some ty'' (CoreTerm (Lit sval')) ->
+
+              -- compare results
+              case singEq ty' ty'' of
+                Just Refl
+                  -- we only test bounded lists up to length 10. discard if the
+                  -- pact list is too long.
+                  -- TODO: this should only be considered a temporary fix. Done
+                  -- properly we need to check all intermediate values.
+                  | SList{} <- ty'
+                  , length pactSval > 10
+                  -> discard
+                  | otherwise -> withEq ty' $ withShow ty' $ sval' === pactSval
+                Nothing   ->
+                  if singEqB ty' (SList SAny) || singEqB ty'' (SList SAny)
+                  then discard -- TODO: check this case
+                  else EType ty' === EType ty'' -- this'll fail
+
+            _ -> error $ "unexpected value (not literal): " ++ show someVal
+
+        Just (Some _ (CoreTerm (LiteralObject _ _obj))) -> do
           footnote "can't property test evaluation of objects"
           failure
 
@@ -96,8 +101,9 @@ prop_evaluation_time = property $ do
 
 prop_round_trip_type :: Property
 prop_round_trip_type = property $ do
-  ety@(EType ty) <- forAll genType
-  maybeTranslateType (reverseTranslateType ty) === Just ety
+  ety <- forAll genType
+  case ety of
+    EType ty -> maybeTranslateType (reverseTranslateType ty) === Just ety
 
 prop_round_trip_term :: Property
 prop_round_trip_term = property $ do

diff --git a/tests/RemoteVerifySpec.hs b/tests/RemoteVerifySpec.hs
@@ -79,13 +79,15 @@ testSingleModule = do
     Right replState0 <- pure eReplState0
     stateModuleData "mod1" replState0 `shouldSatisfy` isJust
 
-  Right replState0 <- pure eReplState0
-  Just (ModuleData mod1 _refs) <- pure $ stateModuleData "mod1" replState0
+  case eReplState0 of
+    Right replState0 -> case stateModuleData "mod1" replState0 of
+      Nothing -> error "failed stateModuleData \"mod1\""
+      Just (ModuleData mod1 _refs) -> do
+        resp <- runIO $ serveAndRequest 3000 $ Remote.Request [derefDef <$> mod1] "mod1"
 
-  resp <- runIO $ serveAndRequest 3000 $ Remote.Request [derefDef <$> mod1] "mod1"
-
-  it "verifies over the network" $
-    (Right ["Property proven valid",""]) `shouldBe` fmap (view Remote.responseLines) resp
+        it "verifies over the network" $
+          (Right ["Property proven valid",""]) `shouldBe` fmap (view Remote.responseLines) resp
+    Left (ReplError msg) -> error msg
 
 testUnsortedModules :: Spec
 testUnsortedModules = do
@@ -116,11 +118,16 @@ testUnsortedModules = do
     Right replState0 <- pure eReplState0
     stateModuleData "mod2" replState0 `shouldSatisfy` isJust
 
-  Right replState0 <- pure eReplState0
-  Just (ModuleData mod1 _refs) <- pure $ stateModuleData "mod1" replState0
-  Just (ModuleData mod2 _refs) <- pure $ stateModuleData "mod2" replState0
+  case eReplState0 of
+    Left (ReplError msg) -> error msg
+    Right replState0 -> case stateModuleData "mod1" replState0 of
+      Nothing -> error "failed stateModuleData \"mod1\""
+      Just (ModuleData mod1 _refs) ->
+        case stateModuleData "mod2" replState0 of
+          Nothing -> error "failed stateModuleData \"mod2\""
+          Just (ModuleData mod2 _refs) -> do
 
-  resp <- runIO $ serveAndRequest 3001 $ Remote.Request [derefDef <$> mod2, derefDef <$> mod1] "mod2"
+            resp <- runIO $ serveAndRequest 3001 $ Remote.Request [derefDef <$> mod2, derefDef <$> mod1] "mod2"
 
-  it "verifies over the network" $
-    (Right ["Property proven valid",""]) `shouldBe` fmap (view Remote.responseLines) resp
+            it "verifies over the network" $
+              (Right ["Property proven valid",""]) `shouldBe` fmap (view Remote.responseLines) resp