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