From d7e1b803f5c319b8b81ab56a5383a4b50ded7b37 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <ilya.rezvov@revjet.com>
Date: Mon, 13 Jan 2020 21:56:06 -0800
Subject: [PATCH] fix build and tests for ghc >8.6

---
 .gitignore                       | 9 ++++++++-
 src/Language/Wasm/Binary.hs      | 2 +-
 src/Language/Wasm/Interpreter.hs | 6 +++---
 src/Language/Wasm/Script.hs      | 4 ++--
 src/Language/Wasm/Validate.hs    | 6 +++++-
 wasm.cabal                       | 4 ++--
 6 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/.gitignore b/.gitignore
index 1454f89..a4b6f94 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,10 @@
 .stack-work
 tests/runnable/*
-dist/
\ No newline at end of file
+dist/
+.DS_Store
+build/
+cabal-config-flags
+dist-newstyle/
+doc/
+setup-config
+wasm-*-docs.tar.gz
\ No newline at end of file
diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 363415f..bb00f1c 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -154,7 +154,7 @@ getName = do
 putResultType :: ResultType -> Put
 putResultType [] = putWord8 0x40
 putResultType [valType] = put valType
-putResultType _ = fail "Current WebAssembly spec does not support returning more then one value"
+putResultType _ = error "Current WebAssembly spec does not support returning more then one value"
 
 getResultType :: Get ResultType
 getResultType = do
diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 50e0956..7f2e816 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -903,11 +903,11 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IXor) =
             return $ Done ctx { stack = VI64 (v1 `xor` v2) : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShl) =
-            return $ Done ctx { stack = VI64 (v1 `shiftL` (fromIntegral v2 `rem` 64)) : rest }
+            return $ Done ctx { stack = VI64 (v1 `shiftL` (fromIntegral (v2 `rem` 64))) : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShrU) =
-            return $ Done ctx { stack = VI64 (v1 `shiftR` (fromIntegral v2 `rem` 64)) : rest }
+            return $ Done ctx { stack = VI64 (v1 `shiftR` (fromIntegral (v2 `rem` 64))) : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShrS) =
-            return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `shiftR` (fromIntegral v2 `rem` 64)) : rest }
+            return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `shiftR` (fromIntegral (v2 `rem` 64))) : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRotl) =
             return $ Done ctx { stack = VI64 (v1 `rotateL` fromIntegral v2) : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRotr) =
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 303b44b..9bde7c7 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -194,12 +194,12 @@ runScript onAssertFail script = do
         runAssert st assert@(AssertInvalid moduleDef failureString) =
             let (_, m) = buildModule moduleDef in
             case Validate.validate m of
-                Right _ -> onAssertFail "Invalid module pass validation" assert
+                Right _ -> onAssertFail "An invalid module passed validation step" assert
                 Left reason ->
                     if failureString `elem` getFailureString reason
                     then return ()
                     else
-                        let msg = "Module invalid for other reason. Expected "
+                        let msg = "Module is invalid for other reason. Expected "
                                 ++ show failureString
                                 ++ ", but actual is "
                                 ++ show (getFailureString reason)
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index ca80ec1..92d4ae5 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -16,8 +16,8 @@ import qualified Data.Set as Set
 import Data.List (foldl')
 import qualified Data.Text.Lazy as TL
 import Data.Maybe (fromMaybe, maybeToList, catMaybes)
-import Data.Monoid ((<>))
 import Numeric.Natural (Natural)
+import Prelude hiding ((<>))
 
 import Control.Monad (foldM)
 import Control.Monad.Reader (ReaderT, runReaderT, withReaderT, ask)
@@ -52,6 +52,10 @@ data ValidationError =
 
 type ValidationResult = Either ValidationError ()
 
+-- semigroup definition for Either a b is in conflict with my ad-hoc instance
+-- to keep an old code Prelude version is hidden and redefined locally
+(<>) = mappend
+
 instance Monoid ValidationResult where
     mempty = Right ()
     mappend (Right ()) vr = vr
diff --git a/wasm.cabal b/wasm.cabal
index 4ae5662..8d06d29 100644
--- a/wasm.cabal
+++ b/wasm.cabal
@@ -1,5 +1,5 @@
 name:           wasm
-version:        1.0.0
+version:        1.0.1
 author:         Ilya Rezvov
 maintainer:     Ilya Rezvov <rezvov.ilya@gmail.com>
 license:        MIT
@@ -64,7 +64,7 @@ library
       Paths_wasm
   default-language: Haskell2010
 
-executable wasm
+executable wasm-bin
   main-is: Main.hs
   hs-source-dirs: exec
   build-depends: