From d7aa900dc16027bea8d27647546773f53d3f25b6 Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Tue, 24 Sep 2019 14:22:27 +0300
Subject: [PATCH] fixup! Add Distribution.Utils.StructuredBinary

---
 Cabal/Distribution/Utils/StructuredBinary.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/Cabal/Distribution/Utils/StructuredBinary.hs b/Cabal/Distribution/Utils/StructuredBinary.hs
index 37316af7b0..e776fb9c4a 100644
--- a/Cabal/Distribution/Utils/StructuredBinary.hs
+++ b/Cabal/Distribution/Utils/StructuredBinary.hs
@@ -6,6 +6,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
+#if __GLASGOW_HASKELL__ >= 711
+{-# LANGUAGE PatternSynonyms #-}
+#endif
 -- |
 --
 -- Copyright: (c) 2019 Oleg Grenrus
@@ -65,7 +68,6 @@ import Data.Int                           (Int16, Int32, Int64, Int8)
 import Data.List.NonEmpty                 (NonEmpty)
 import Data.Proxy                         (Proxy (..))
 import Data.Ratio                         (Ratio)
-import Data.Tagged                        (Tagged (..), untag)
 import Data.Typeable                      (Typeable)
 import Data.Word                          (Word, Word16, Word32, Word64, Word8)
 
@@ -187,6 +189,8 @@ class Structured a where
     structureHash' :: Tagged a MD5
     structureHash' = Tagged (hashStructure (structure (Proxy :: Proxy a)))
 
+-- private Tagged
+newtype Tagged a b = Tagged { untag :: b }
 
 -- | Semantically @'hashStructure' . 'structure'@.
 structureHash :: forall a. Structured a => Proxy a -> MD5
@@ -380,4 +384,3 @@ instance Structured Time.TimeOfDay       where structure = nominalStructure
 instance Structured Time.LocalTime       where structure = nominalStructure
 
 instance Structured (Proxy a)
-instance Structured a => Structured (Tagged b a)
-- 
GitLab