Improve encoding/decoding speed (#1500)

... by not going through a `Term` intermediate

This gives a ~28% performance in decoding improvement, which means that
cache looks are not faster.

Here are the new decoding benchmarks before and after this change:

Before:

```
benchmarked Issue #108/Binary
time                 266.5 μs   (265.7 μs .. 267.4 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 266.3 μs   (265.6 μs .. 267.1 μs)
std dev              2.418 μs   (1.891 μs .. 3.436 μs)

benchmarking Kubernetes/Binary ... took 36.94 s, total 56 iterations
benchmarked Kubernetes/Binary
time                 641.3 ms   (623.0 ms .. 655.4 ms)
                     0.999 R²   (0.997 R² .. 1.000 R²)
mean                 679.7 ms   (665.5 ms .. 702.6 ms)
std dev              29.48 ms   (14.15 ms .. 39.05 ms)
```

After:

```
benchmarked Issue #108/Binary
time                 282.2 μs   (279.6 μs .. 284.7 μs)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 281.9 μs   (280.7 μs .. 287.7 μs)
std dev              7.089 μs   (2.550 μs .. 15.44 μs)
variance introduced by outliers: 11% (moderately inflated)

benchmarking Kubernetes/Binary ... took 27.57 s, total 56 iterations
benchmarked Kubernetes/Binary
time                 499.1 ms   (488.1 ms .. 506.6 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 498.9 ms   (494.4 ms .. 503.9 ms)
std dev              8.539 ms   (6.236 ms .. 12.56 ms)
```

There's a slight performance regression for the decoding microbenchmark, but
in practice my testing on real examples matches performance improvements seen
in the larger benchmark based on an example cache product from
`dhall-kubernetes`.

Note that is a breaking change because:

* There is no longer a `FromTerm` nor `ToTerm` class.  Now we use the
  `Serialise` class and `{encode,decode}Expression` now work on `ByteString`s
  instead of `Term`s

* I further narrowed the types of several encoding/decoding utilites to expect a
  `Void` for the first type parameter of `Expr`

* This is a regression with respect to stripping 55799 CBOR tags, mainly
  because properly handling the tags at every possible point in the syntax tree
  would considerably complicate the code

dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs

@@ -165,5 +165,5 @@ normalize (WellTyped expr) = Normal $ Dhall.normalize expr
 --   Dhall's hash annotations (prefixed by "sha256:" and base-64 encoded).
 hashNormalToCode :: Normal -> Text
 hashNormalToCode (Normal expr) =
-  Dhall.hashExpressionToCode alphaNormal
+  Dhall.hashExpressionToCode (Dhall.denote alphaNormal)
   where alphaNormal = Dhall.alphaNormalize expr

dhall/benchmark/parser/Main.hs

@@ -6,7 +6,8 @@ module Main where
 import Control.Monad (forM)
 import Data.Map (Map, foldrWithKey, singleton, unions)
 import Data.Monoid ((<>))
-import Gauge (defaultMain, bgroup, bench, whnf, nfIO)
+import Data.Void (Void)
+import Gauge (defaultMain, bgroup, bench, nf, whnf, nfIO)
 
 import System.Directory
 
@@ -67,27 +68,25 @@ benchExprFromText name expr =
 
 benchExprFromBytes
     :: String -> Data.ByteString.Lazy.ByteString -> Gauge.Benchmark
-benchExprFromBytes name bytes = bench name (whnf f bytes)
+benchExprFromBytes name bytes = bench name (nf f bytes)
   where
     f bytes = do
-        term <- case Codec.Serialise.deserialiseOrFail bytes of
+        case Dhall.Binary.decodeExpression bytes of
-            Left  _    -> Nothing
+            Left  exception  -> error (show exception)
-            Right term -> return term
+            Right expression -> expression :: Dhall.Expr Void Dhall.Import
-        case Dhall.Binary.decodeExpression term
-          :: Either Dhall.Binary.DecodingFailure (Dhall.Expr () Dhall.Import) of
-            Left  _          -> Nothing
-            Right expression -> return expression
 
 main :: IO ()
 main = do
     prelude <- loadPreludeFiles
     issue108Text  <- TIO.readFile "benchmark/examples/issue108.dhall"
     issue108Bytes <- Data.ByteString.Lazy.readFile "benchmark/examples/issue108.dhall.bin"
+    kubernetesExample <- Data.ByteString.Lazy.readFile "benchmark/examples/kubernetes.dhall.bin"
     defaultMain
         [ bgroup "Issue #108"
             [ benchExprFromText  "Text"   issue108Text
             , benchExprFromBytes "Binary" issue108Bytes
             ]
+        , benchExprFromBytes "Kubernetes/Binary" kubernetesExample
         , benchExprFromText "Long variable names" (T.replicate 1000000 "x")
         , benchExprFromText "Large number of function arguments" (T.replicate 10000 "x ")
         , benchExprFromText "Long double-quoted strings" ("\"" <> T.replicate 1000000 "x" <> "\"")

dhall/src/Dhall/Diff.hs

@@ -26,7 +26,6 @@ import Data.Text (Text)
 import Data.Text.Prettyprint.Doc (Doc, Pretty)
 import Data.Void (Void)
 import Dhall.Syntax (Binding(..), Chunks (..), Const(..), DhallDouble(..), Expr(..), Var(..))
-import Dhall.Binary (ToTerm)
 import Dhall.Map (Map)
 import Dhall.Set (Set)
 import Dhall.Pretty.Internal (Ann)
@@ -156,7 +155,7 @@ rparen :: Diff
 rparen = token Internal.rparen
 
 -- | Render the difference between the normal form of two expressions
-diffNormalized :: (Eq a, Pretty a, ToTerm a) => Expr s a -> Expr s a -> Diff
+diffNormalized :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
 diffNormalized l0 r0 = Dhall.Diff.diff l1 r1
   where
     l1 = Dhall.Normalize.alphaNormalize (Dhall.Normalize.normalize l0)

dhall/src/Dhall/Freeze.hs

@@ -62,7 +62,7 @@ freezeImport directory import_ = do
             Dhall.Core.alphaNormalize (Dhall.Core.normalize expression)
 
     -- make sure the frozen import is present in the semantic cache
-    Dhall.Import.writeExpressionToSemanticCache expression
+    Dhall.Import.writeExpressionToSemanticCache (Dhall.Core.denote expression)
 
     let expressionHash = Dhall.Import.hashExpression normalizedExpression
 

dhall/src/Dhall/Import.hs

@@ -138,7 +138,6 @@ module Dhall.Import (
     ) where
 
 import Control.Applicative (Alternative(..))
-import Codec.CBOR.Term (Term(..))
 import Control.Exception (Exception, SomeException, IOException, toException)
 import Control.Monad (when)
 import Control.Monad.Catch (throwM, MonadCatch(catch), handle)
@@ -180,6 +179,8 @@ import Dhall.Import.Types
 import Dhall.Parser (Parser(..), ParseError(..), Src(..), SourcedException(..))
 import Lens.Family.State.Strict (zoom)
 
+import qualified Codec.CBOR.Encoding              as Encoding
+import qualified Codec.CBOR.Write                 as Write
 import qualified Codec.Serialise
 import qualified Control.Monad.Trans.Maybe        as Maybe
 import qualified Control.Monad.Trans.State.Strict as State
@@ -504,6 +505,7 @@ loadImportWithSemanticCache
     case mCached of
         Just bytesStrict -> do
             let actualHash = Dhall.Crypto.sha256Hash bytesStrict
+
             if semanticHash == actualHash
                 then return ()
                 else do
@@ -511,12 +513,10 @@ loadImportWithSemanticCache
                     throwMissingImport (Imported _stack (HashMismatch {expectedHash = semanticHash, ..}))
 
             let bytesLazy = Data.ByteString.Lazy.fromStrict bytesStrict
-            term <- case Codec.Serialise.deserialiseOrFail bytesLazy of
+
-                Left err -> throwMissingImport (Imported _stack err)
+            importSemantics <- case Dhall.Binary.decodeExpression bytesLazy of
-                Right t -> return t
+                Left  err -> throwMissingImport (Imported _stack err)
-            importSemantics <- case Dhall.Binary.decodeExpression term of
+                Right e   -> return e
-                Left err -> throwMissingImport (Imported _stack err)
-                Right sem -> return sem
 
             return (ImportSemantics {..})
 
@@ -544,7 +544,7 @@ fetchFromSemanticCache expectedHash = Maybe.runMaybeT $ do
 
 -- | Ensure that the given expression is present in the semantic cache. The
 --   given expression should be alpha-beta-normal.
-writeExpressionToSemanticCache :: Expr Src Void -> IO ()
+writeExpressionToSemanticCache :: Expr Void Void -> IO ()
 writeExpressionToSemanticCache expression = writeToSemanticCache hash bytes
   where
     bytes = encodeExpression NoVersion expression
@@ -592,18 +592,14 @@ loadImportWithSemisemanticCache (Chained (Import (ImportHashed _ importType) Cod
     -- Check the semi-semantic cache. See
     -- https://github.com/dhall-lang/dhall-haskell/issues/1098 for the reasoning
     -- behind semi-semantic caching.
-    let semisemanticHash = computeSemisemanticHash resolvedExpr
+    let semisemanticHash = computeSemisemanticHash (Dhall.Core.denote resolvedExpr)
     mCached <- lift $ fetchFromSemisemanticCache semisemanticHash
 
     importSemantics <- case mCached of
         Just bytesStrict -> do
             let bytesLazy = Data.ByteString.Lazy.fromStrict bytesStrict
 
-            term <- case Codec.Serialise.deserialiseOrFail bytesLazy of
+            importSemantics <- case Dhall.Binary.decodeExpression bytesLazy of
-                Left err -> throwMissingImport (Imported _stack err)
-                Right t -> return t
-
-            importSemantics <- case Dhall.Binary.decodeExpression term of
                 Left err -> throwMissingImport (Imported _stack err)
                 Right sem -> return sem
 
@@ -659,7 +655,7 @@ loadImportWithSemisemanticCache (Chained (Import (ImportHashed _ importType) Loc
 -- AST (without normalising or type-checking it first). See
 -- https://github.com/dhall-lang/dhall-haskell/issues/1098 for further
 -- discussion.
-computeSemisemanticHash :: Expr Src Void -> Dhall.Crypto.SHA256Digest
+computeSemisemanticHash :: Expr Void Void -> Dhall.Crypto.SHA256Digest
 computeSemisemanticHash resolvedExpr = hashExpression resolvedExpr
 
 -- Fetch encoded normal form from "semi-semantic cache"
@@ -1012,7 +1008,7 @@ loadWith expr₀ = case expr₀ of
     ImportSemantics {..} <- loadImport child
     zoom stack (State.put _stack)
 
-    return importSemantics
+    return (Dhall.Core.renote importSemantics)
 
   ImportAlt a b -> loadWith a `catch` handler₀
     where
@@ -1109,33 +1105,30 @@ loadRelativeTo rootDirectory semanticCacheMode expression =
         (emptyStatus rootDirectory) { _semanticCacheMode = semanticCacheMode }
 
 encodeExpression
-    :: forall s
+    :: StandardVersion
-    .  StandardVersion
     -- ^ `NoVersion` means to encode without the version tag
-    -> Expr s Void
+    -> Expr Void Void
     -> Data.ByteString.ByteString
 encodeExpression _standardVersion expression = bytesStrict
   where
-    intermediateExpression :: Expr s Import
+    intermediateExpression :: Expr Void Import
     intermediateExpression = fmap absurd expression
 
-    term :: Term
+    encoding =
-    term = Dhall.Binary.encodeExpression intermediateExpression
-
-    taggedTerm :: Term
-    taggedTerm =
         case _standardVersion of
-            NoVersion -> term
+            NoVersion ->
-            s         -> TList [ TString v, term ]
+                Codec.Serialise.encode intermediateExpression
+            s ->
+                    Encoding.encodeListLen 2
+                <>  Encoding.encodeString v
+                <>  Codec.Serialise.encode intermediateExpression
               where
                 v = Dhall.Binary.renderStandardVersion s
 
-    bytesLazy = Codec.Serialise.serialise taggedTerm
+    bytesStrict = Write.toStrictByteString encoding
-
-    bytesStrict = Data.ByteString.Lazy.toStrict bytesLazy
 
 -- | Hash a fully resolved expression
-hashExpression :: Expr s Void -> Dhall.Crypto.SHA256Digest
+hashExpression :: Expr Void Void -> Dhall.Crypto.SHA256Digest
 hashExpression expression =
     Dhall.Crypto.sha256Hash (encodeExpression NoVersion expression)
 
@@ -1145,7 +1138,7 @@ hashExpression expression =
     In other words, the output of this function can be pasted into Dhall
     source code to add an integrity check to an import
 -}
-hashExpressionToCode :: Expr s Void -> Text
+hashExpressionToCode :: Expr Void Void -> Text
 hashExpressionToCode expr =
     "sha256:" <> Text.pack (show (hashExpression expr))
 

dhall/src/Dhall/Import/Types.hs

@@ -49,7 +49,7 @@ instance Pretty Chained where
 
 -- | An import that has been fully interpeted
 data ImportSemantics = ImportSemantics
-    { importSemantics :: Expr Src Void
+    { importSemantics :: Expr Void Void
     -- ^ The fully resolved import, typechecked and beta-normal.
     }
 

dhall/src/Dhall/Main.hs

@@ -44,7 +44,6 @@ import Text.Dot ((.->.))
 import qualified Codec.CBOR.JSON
 import qualified Codec.CBOR.Read
 import qualified Codec.CBOR.Write
-import qualified Codec.Serialise
 import qualified Control.Exception
 import qualified Control.Monad.Trans.State.Strict          as State
 import qualified Data.Aeson
@@ -673,9 +672,7 @@ command (Options {..}) = do
         Encode {..} -> do
             expression <- getExpression file
 
-            let term = Dhall.Binary.encodeExpression expression
+            let bytes = Dhall.Binary.encodeExpression (Dhall.Core.denote expression)
-
-            let bytes = Codec.Serialise.serialise term
 
             if json
                 then do
@@ -696,7 +693,7 @@ command (Options {..}) = do
                     InputFile f   -> Data.ByteString.Lazy.readFile f
                     StandardInput -> Data.ByteString.Lazy.getContents
 
-            term <- do
+            expression <- do
                 if json
                     then do
                         value <- case Data.Aeson.eitherDecode' bytes of
@@ -705,15 +702,14 @@ command (Options {..}) = do
 
                         let encoding = Codec.CBOR.JSON.encodeValue value
 
-                        let cborBytes = Codec.CBOR.Write.toLazyByteString encoding
+                        let cborgBytes = Codec.CBOR.Write.toLazyByteString encoding
-                        Dhall.Core.throws (Codec.Serialise.deserialiseOrFail cborBytes)
+
+                        Dhall.Core.throws (Dhall.Binary.decodeExpression cborgBytes)
                     else do
-                        Dhall.Core.throws (Codec.Serialise.deserialiseOrFail bytes)
+                        Dhall.Core.throws (Dhall.Binary.decodeExpression bytes)
 
-            expression <- Dhall.Core.throws (Dhall.Binary.decodeExpression term)
-                :: IO (Expr Src Import)
 
-            let doc = Dhall.Pretty.prettyCharacterSet characterSet expression
+            let doc = Dhall.Pretty.prettyCharacterSet characterSet (Dhall.Core.renote expression :: Expr Src Import)
 
             renderDoc System.IO.stdout doc
 

dhall/src/Dhall/Syntax.hs

@@ -211,7 +211,7 @@ newtype DhallDouble = DhallDouble { getDhallDouble :: Double }
 --
 -- This instance is also consistent with with the binary encoding of Dhall @Double@s:
 --
--- >>> toBytes n = Codec.Serialise.serialise (Dhall.Binary.encode (n :: DhallDouble))
+-- >>> toBytes n = Dhall.Binary.encodeExpression (DoubleLit n :: Expr Void Import)
 --
 -- prop> \a b -> (a == b) == (toBytes a == toBytes b)
 instance Eq DhallDouble where

dhall/src/Dhall/TypeCheck.hs

@@ -37,7 +37,6 @@ import Data.Text (Text)
 import Data.Text.Prettyprint.Doc (Doc, Pretty(..))
 import Data.Typeable (Typeable)
 import Data.Void (Void, absurd)
-import Dhall.Binary (ToTerm(..))
 import Dhall.Context (Context)
 import Dhall.Syntax (Binding(..), Const(..), Chunks(..), Expr(..), Var(..))
 import Dhall.Eval
@@ -1330,13 +1329,13 @@ data TypeMessage s a
     | CantMultiply (Expr s a) (Expr s a)
     deriving (Show)
 
-shortTypeMessage :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> Doc Ann
+shortTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
 shortTypeMessage msg =
     "\ESC[1;31mError\ESC[0m: " <> short <> "\n"
   where
     ErrorMessages {..} = prettyTypeMessage msg
 
-longTypeMessage :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> Doc Ann
+longTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
 longTypeMessage msg =
         "\ESC[1;31mError\ESC[0m: " <> short <> "\n"
     <>  "\n"
@@ -1357,8 +1356,7 @@ _NOT = "\ESC[1mnot\ESC[0m"
 insert :: Pretty a => a -> Doc Ann
 insert = Dhall.Util.insert
 
-prettyTypeMessage
+prettyTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
-    :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> ErrorMessages
 prettyTypeMessage (UnboundVariable x) = ErrorMessages {..}
   -- We do not need to print variable name here. For the discussion see:
   -- https://github.com/dhall-lang/dhall-haskell/pull/116
@@ -4252,12 +4250,12 @@ data TypeError s a = TypeError
     , typeMessage :: TypeMessage s a
     }
 
-instance (Eq a, Pretty s, Pretty a, ToTerm a) => Show (TypeError s a) where
+instance (Eq a, Pretty s, Pretty a) => Show (TypeError s a) where
     show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty
 
-instance (Eq a, Pretty s, Pretty a, ToTerm a, Typeable s, Typeable a) => Exception (TypeError s a)
+instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (TypeError s a)
 
-instance (Eq a, Pretty s, Pretty a, ToTerm a) => Pretty (TypeError s a) where
+instance (Eq a, Pretty s, Pretty a) => Pretty (TypeError s a) where
     pretty (TypeError _ expr msg)
         = Pretty.unAnnotate
             (   "\n"
@@ -4425,12 +4423,12 @@ messageExpressions f m = case m of
 newtype DetailedTypeError s a = DetailedTypeError (TypeError s a)
     deriving (Typeable)
 
-instance (Eq a, Pretty s, Pretty a, ToTerm a) => Show (DetailedTypeError s a) where
+instance (Eq a, Pretty s, Pretty a) => Show (DetailedTypeError s a) where
     show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty
 
-instance (Eq a, Pretty s, Pretty a, ToTerm a, Typeable s, Typeable a) => Exception (DetailedTypeError s a)
+instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (DetailedTypeError s a)
 
-instance (Eq a, Pretty s, Pretty a, ToTerm a) => Pretty (DetailedTypeError s a) where
+instance (Eq a, Pretty s, Pretty a) => Pretty (DetailedTypeError s a) where
     pretty (DetailedTypeError (TypeError ctx expr msg))
         = Pretty.unAnnotate
             (   "\n"

dhall/tests/Dhall/Test/Parser.hs

@@ -10,9 +10,6 @@ import Prelude hiding (FilePath)
 import Test.Tasty (TestTree)
 import Turtle (FilePath, (</>))
 
-import qualified Codec.CBOR.Read      as CBOR
-import qualified Codec.CBOR.Term      as CBOR
-import qualified Codec.Serialise      as Serialise
 import qualified Control.Monad        as Monad
 import qualified Data.Bifunctor       as Bifunctor
 import qualified Data.ByteString      as ByteString
@@ -26,6 +23,7 @@ import qualified Dhall.Parser         as Parser
 import qualified Dhall.Test.Util      as Test.Util
 import qualified Test.Tasty           as Tasty
 import qualified Test.Tasty.HUnit     as Tasty.HUnit
+import qualified Text.Printf          as Printf
 import qualified Turtle
 
 parseDirectory :: FilePath
@@ -135,16 +133,16 @@ shouldParse path = do
 
         expression <- Core.throws (Parser.exprFromText mempty text)
 
-        let term = Binary.encodeExpression expression
+        let bytes = Binary.encodeExpression (Core.denote expression)
 
-        let bytes = Serialise.serialise term
+        let render =
+                  concatMap (Printf.printf "%02x ")
+                . ByteString.Lazy.unpack
 
         Monad.unless (encoded == bytes) $ do
-            ("", expected) <- Core.throws (CBOR.deserialiseFromBytes CBOR.decodeTerm encoded)
-
             let message = "The expected CBOR representation doesn't match the actual one\n"
-                          ++ "expected: " ++ show expected ++ "\n but got: " ++ show term
+                          ++ "expected: " ++ render encoded ++ "\n but got: " ++ render bytes
-                          ++ "\n expr: " ++ show expression
+                          ++ "\n expr: " ++ show (Core.denote expression :: Expr Void Import)
 
             Tasty.HUnit.assertFailure message
 
@@ -202,16 +200,29 @@ shouldNotParse path = do
 
 shouldDecode :: Text -> TestTree
 shouldDecode pathText = do
-    let expectedFailures = []
+    let expectedFailures =
+          [ {- Note that this test actually successfully decodes the value, but
+               mistakenly decodes the value to `_` instead of `x`.  This is
+               because the 55799 tag causes normal decoding to fail, so it falls
+               back to treating the `"x"` as a version tag instead of a label.
+
+               Either way, fixing 55799 decoding would cause this test to pass
+               again.
+            -}
+            binaryDecodeDirectory </> "success/unit/SelfDescribeCBORX2"
+          , binaryDecodeDirectory </> "success/unit/SelfDescribeCBORX3"
+          ]
 
     let pathString = Text.unpack pathText
 
     Test.Util.testCase pathText expectedFailures (do
         bytes <- ByteString.Lazy.readFile (pathString <> "A.dhallb")
 
-        term <- Core.throws (Serialise.deserialiseOrFail bytes)
+        decodedExpression <- case Binary.decodeExpression bytes of
-
+            Left exception ->
-        decodedExpression <- Core.throws (Binary.decodeExpression term)
+                Tasty.HUnit.assertFailure (show exception)
+            Right decodedExpression ->
+                return decodedExpression
 
         text <- Text.IO.readFile (pathString <> "B.dhall")
 
@@ -223,7 +234,7 @@ shouldDecode pathText = do
         let message =
                 "The decoded expression didn't match the parsed expression"
 
-        Tasty.HUnit.assertEqual message decodedExpression strippedExpression )
+        Tasty.HUnit.assertEqual message strippedExpression decodedExpression )
 
 shouldNotDecode :: Text -> TestTree
 shouldNotDecode pathText = do
@@ -234,8 +245,6 @@ shouldNotDecode pathText = do
     Test.Util.testCase pathText expectedFailures (do
         bytes <- ByteString.Lazy.readFile (pathString <> ".dhallb")
 
-        term <- Core.throws (Serialise.deserialiseOrFail bytes)
+        case Binary.decodeExpression bytes :: Either Binary.DecodingFailure (Expr Void Import) of
-
-        case Binary.decodeExpression term :: Either Binary.DecodingFailure (Expr Void Import) of
             Left _ -> return ()
             Right _ -> Tasty.HUnit.assertFailure "Unexpected successful decode" )

dhall/tests/Dhall/Test/QuickCheck.hs

@@ -10,10 +10,10 @@
 
 module Dhall.Test.QuickCheck where
 
-import Codec.Serialise (DeserialiseFailure(..))
 import Data.Either (isRight)
 import Data.Either.Validation (Validation(..))
 import Data.Monoid ((<>))
+import Data.Void (Void)
 import Dhall (ToDhall(..), FromDhall(..), auto, extract, inject, embed, Vector)
 import Dhall.Map (Map)
 import Dhall.Core
@@ -53,8 +53,6 @@ import Test.Tasty.QuickCheck (QuickCheckTests(..))
 import Text.Megaparsec (SourcePos(..), Pos)
 
 import qualified Control.Spoon
-import qualified Codec.Serialise
-import qualified Data.Coerce
 import qualified Data.List
 import qualified Data.Sequence
 import qualified Data.SpecialValues
@@ -78,13 +76,6 @@ import qualified Test.Tasty
 import qualified Test.Tasty.QuickCheck
 import qualified Text.Megaparsec       as Megaparsec
 
-newtype DeserialiseFailureWithEq = D DeserialiseFailure
-    deriving (Show)
-
-instance Eq DeserialiseFailureWithEq where
-    D (DeserialiseFailure aL bL) == D (DeserialiseFailure aR bR) =
-        aL == aR && bL == bR
-
 instance (Arbitrary a, Ord a) => Arbitrary (Set a) where
   arbitrary = Dhall.Set.fromList <$> arbitrary
   shrink = map Dhall.Set.fromList . shrink . Dhall.Set.toList
@@ -412,21 +403,11 @@ instance Arbitrary Var where
 
 binaryRoundtrip :: Expr () Import -> Property
 binaryRoundtrip expression =
-        wrap
+        Dhall.Binary.decodeExpression (Dhall.Binary.encodeExpression denotedExpression)
-            (fmap
+    === Right denotedExpression
-                Dhall.Binary.decodeExpression
-                (Codec.Serialise.deserialiseOrFail
-                  (Codec.Serialise.serialise
-                    (Dhall.Binary.encodeExpression expression)
-                  )
-                )
-            )
-    === wrap (Right (Right (Dhall.Core.denote expression :: Expr () Import)))
   where
-    wrap
+    denotedExpression :: Expr Void Import
-        :: Either DeserialiseFailure       a
+    denotedExpression = Dhall.Core.denote expression
-        -> Either DeserialiseFailureWithEq a
-    wrap = Data.Coerce.coerce
 
 everythingWellTypedNormalizes :: Expr () () -> Property
 everythingWellTypedNormalizes expression =