Merge branch 'T43' into 'master'

Use better text-2.0–accommodating patches for cribit, double-conversion

See merge request !204

ci/config.sh

@@ -98,7 +98,7 @@ esac
 #
 # These are packages which we don't have patches for but want to test anyways.
 extra_package lens 5.0.1
-extra_package aeson 2.0.2.0
+extra_package aeson 2.0.3.0
 extra_package criterion
 extra_package scotty
 extra_package generic-lens 2.2.0.0

patches/aeson-2.0.2.0.patch

-diff --git a/src-pure/Data/Aeson/Parser/UnescapePure.hs b/src-pure/Data/Aeson/Parser/UnescapePure.hs
-index 26e9ac8..fbdb448 100644
---- a/src-pure/Data/Aeson/Parser/UnescapePure.hs
-+++ b/src-pure/Data/Aeson/Parser/UnescapePure.hs
-@@ -5,6 +5,9 @@
- 
- -- The security check at the end (pos > length) only works if pos grows
- -- monotonously, if this condition does not hold, the check is flawed.
-+
-+{-# LANGUAGE CPP #-}
-+
- module Data.Aeson.Parser.UnescapePure
-     (
-       unescapeText
-@@ -13,7 +16,6 @@ module Data.Aeson.Parser.UnescapePure
- import Control.Exception (evaluate, throw, try)
- import Control.Monad (when)
- import Data.ByteString as B
--import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
- import Data.Text (Text)
- import qualified Data.Text.Array as A
- import Data.Text.Encoding.Error (UnicodeException (..))
-@@ -22,6 +24,22 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)
- import Data.Word (Word8, Word16, Word32)
- import GHC.ST (ST)
- 
-+#if MIN_VERSION_text(2,0,0)
-+import Data.Bits (Bits, shiftL, (.&.), (.|.))
-+import Data.Text.Internal.Encoding.Utf16 (chr2)
-+import Data.Text.Internal.Unsafe.Char (unsafeChr16, unsafeChr32, unsafeWrite)
-+#else
-+import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
-+#endif
-+
-+#if MIN_VERSION_text(2,0,0)
-+import Data.Bits (Bits, shiftL, (.&.), (.|.))
-+import Data.Text.Internal.Encoding.Utf16 (chr2)
-+import Data.Text.Internal.Unsafe.Char (unsafeChr16, unsafeChr32, unsafeWrite)
-+#else
-+import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
-+#endif
-+
- -- Different UTF states.
- data Utf =
-       UtfGround
-@@ -42,12 +60,12 @@ data State =
-     | StateU1 !Word16
-     | StateU2 !Word16
-     | StateU3 !Word16
--    | StateS0
--    | StateS1
--    | StateSU0
--    | StateSU1 !Word16
--    | StateSU2 !Word16
--    | StateSU3 !Word16
-+    | StateS0 !Word16
-+    | StateS1 !Word16
-+    | StateSU0 !Word16
-+    | StateSU1 !Word16 !Word16
-+    | StateSU2 !Word16 !Word16
-+    | StateSU3 !Word16 !Word16
-     deriving (Eq)
- 
- -- References:
-@@ -144,11 +162,17 @@ unescapeText' bs = runText $ \done -> do
-       runUtf dest pos st point c = case decode st point c of
-         (UtfGround, 92) -> -- Backslash
-             return (pos, StateBackslash)
-+#if MIN_VERSION_text(2,0,0)
-+        (UtfGround, w) -> do
-+            d <- unsafeWrite dest pos (unsafeChr32 w)
-+            return (pos + d, StateNone)
-+#else
-         (UtfGround, w) | w <= 0xffff ->
-             writeAndReturn dest pos (fromIntegral w) StateNone
-         (UtfGround, w) -> do
--            write dest pos (0xd7c0 + fromIntegral (w `shiftR` 10))
-+            A.unsafeWrite dest pos (0xd7c0 + fromIntegral (w `shiftR` 10))
-             writeAndReturn dest (pos + 1) (0xdc00 + fromIntegral (w .&. 0x3ff)) StateNone
-+#endif
-         (st', p) ->
-             return (pos, StateUtf st' p)
- 
-@@ -195,53 +219,60 @@ unescapeText' bs = runText $ \done -> do
-         let u = w' .|. w in
- 
-         -- Get next state based on surrogates.
--        let st
--              | u >= 0xd800 && u <= 0xdbff = -- High surrogate.
--                StateS0
--              | u >= 0xdc00 && u <= 0xdfff = -- Low surrogate.
--                throwDecodeError
--              | otherwise =
--                StateNone
--        in
--        writeAndReturn dest pos u st
-+        if u >= 0xd800 && u <= 0xdbff then -- High surrogate.
-+          return (pos, StateS0 u)
-+        else if u >= 0xdc00 && u <= 0xdfff then -- Low surrogate.
-+          throwDecodeError
-+        else do
-+#if MIN_VERSION_text(2,0,0)
-+          d <- unsafeWrite dest pos (unsafeChr16 u)
-+          return (pos + d, StateNone)
-+#else
-+          writeAndReturn dest pos u StateNone
-+#endif
- 
-       -- Handle surrogates.
--      f _ (pos, StateS0) 92 = return (pos, StateS1) -- Backslash
--      f _ (  _, StateS0)  _ = throwDecodeError
-+      f _ (pos, StateS0 hi) 92 = return (pos, StateS1 hi) -- Backslash
-+      f _ (  _, StateS0{})  _ = throwDecodeError
- 
--      f _ (pos, StateS1) 117 = return (pos, StateSU0) -- u
--      f _ (  _, StateS1)   _ = throwDecodeError
-+      f _ (pos, StateS1 hi) 117 = return (pos, StateSU0 hi) -- u
-+      f _ (  _, StateS1{})   _ = throwDecodeError
- 
--      f _ (pos, StateSU0) c =
-+      f _ (pos, StateSU0 hi) c =
-         let w = decodeHex c in
--        return (pos, StateSU1 (w `shiftL` 12))
-+        return (pos, StateSU1 hi (w `shiftL` 12))
- 
--      f _ (pos, StateSU1 w') c =
-+      f _ (pos, StateSU1 hi w') c =
-         let w = decodeHex c in
--        return (pos, StateSU2 (w' .|. (w `shiftL` 8)))
-+        return (pos, StateSU2 hi (w' .|. (w `shiftL` 8)))
- 
--      f _ (pos, StateSU2 w') c =
-+      f _ (pos, StateSU2 hi w') c =
-         let w = decodeHex c in
--        return (pos, StateSU3 (w' .|. (w `shiftL` 4)))
-+        return (pos, StateSU3 hi (w' .|. (w `shiftL` 4)))
- 
--      f dest (pos, StateSU3 w') c =
-+      f dest (pos, StateSU3 hi w') c =
-         let w = decodeHex c in
-         let u = w' .|. w in
- 
-         -- Check if not low surrogate.
-         if u < 0xdc00 || u > 0xdfff then
-           throwDecodeError
--        else
--          writeAndReturn dest pos u StateNone
--
--write :: A.MArray s -> Int -> Word16 -> ST s ()
--write dest pos char =
--    A.unsafeWrite dest pos char
--{-# INLINE write #-}
--
-+        else do
-+#if MIN_VERSION_text(2,0,0)
-+          d <- unsafeWrite dest pos (chr2 hi u)
-+          return (pos + d, StateNone)
-+#else
-+          A.unsafeWrite dest pos hi
-+          writeAndReturn dest (pos + 1) u StateNone
-+#endif
-+
-+#if MIN_VERSION_text(2,0,0)
-+writeAndReturn :: A.MArray s -> Int -> Word8 -> t -> ST s (Int, t)
-+#else
- writeAndReturn :: A.MArray s -> Int -> Word16 -> t -> ST s (Int, t)
-+#endif
- writeAndReturn dest pos char res = do
--    write dest pos char
-+    A.unsafeWrite dest pos char
-     return (pos + 1, res)
- {-# INLINE writeAndReturn #-}
- 
-diff --git a/src/Data/Aeson/Encoding/Builder.hs b/src/Data/Aeson/Encoding/Builder.hs
-index fb3696d..07e29b7 100644
---- a/src/Data/Aeson/Encoding/Builder.hs
-+++ b/src/Data/Aeson/Encoding/Builder.hs
-@@ -44,7 +44,7 @@ import Data.Aeson.Internal.Time
- import Data.Aeson.Types.Internal (Value (..), Key)
- import qualified Data.Aeson.Key as Key
- import qualified Data.Aeson.KeyMap as KM
--import Data.ByteString.Builder as B
-+import Data.ByteString.Builder as B hiding (scientific)
- import Data.ByteString.Builder.Prim as BP
- import Data.ByteString.Builder.Scientific (scientificBuilder)
- import Data.Char (chr, ord)
-diff --git a/src/Data/Aeson/Parser/Internal.hs b/src/Data/Aeson/Parser/Internal.hs
-index 5c75c3e..ab3d371 100644
---- a/src/Data/Aeson/Parser/Internal.hs
-+++ b/src/Data/Aeson/Parser/Internal.hs
-@@ -342,11 +342,16 @@ jstring_ = do
-     Just w | w < 0x20 -> fail "unescaped control character"
-     _                 -> jstringSlow s
- 
-+#if MIN_VERSION_text(2,0,0)
-+unsafeDecodeASCII :: B.ByteString -> Text
-+unsafeDecodeASCII = TE.decodeASCII
-+#else
- -- | The input is assumed to contain only 7bit ASCII characters (i.e. @< 0x80@).
- --   We use TE.decodeLatin1 here because TE.decodeASCII is currently (text-1.2.4.0)
- --   deprecated and equal to TE.decodeUtf8, which is slower than TE.decodeLatin1.
- unsafeDecodeASCII :: B.ByteString -> Text
- unsafeDecodeASCII = TE.decodeLatin1
-+#endif
- 
- jstringSlow :: B.ByteString -> Parser Text
- {-# INLINE jstringSlow #-}

patches/attoparsec-0.14.2.patch

-diff --git a/Data/Attoparsec/Text/Buffer.hs b/Data/Attoparsec/Text/Buffer.hs
-index 47e72c3..6a51dd9 100644
---- a/Data/Attoparsec/Text/Buffer.hs
-+++ b/Data/Attoparsec/Text/Buffer.hs
-@@ -34,7 +34,8 @@ module Data.Attoparsec.Text.Buffer
-     , iter
-     , iter_
-     , substring
--    , dropWord16
-+    , lengthCodeUnits
-+    , dropCodeUnits
-     ) where
- 
- import Control.Exception (assert)
-@@ -44,8 +45,14 @@ import Data.Monoid as Mon (Monoid(..))
- import Data.Semigroup (Semigroup(..))
- import Data.Text ()
- import Data.Text.Internal (Text(..))
-+#if MIN_VERSION_text(2,0,0)
-+import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)
-+import Data.Text.Unsafe (iterArray, lengthWord8)
-+#else
- import Data.Text.Internal.Encoding.Utf16 (chr2)
- import Data.Text.Internal.Unsafe.Char (unsafeChr)
-+import Data.Text.Unsafe (lengthWord16)
-+#endif
- import Data.Text.Unsafe (Iter(..))
- import Foreign.Storable (sizeOf)
- import GHC.Exts (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)
-@@ -108,7 +115,11 @@ append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do
-       let newgen = gen + 1
-       marr <- unsafeThaw arr0
-       writeGen marr newgen
-+#if MIN_VERSION_text(2,0,0)
-+      A.copyI newlen marr (off0+len0) arr1 off1
-+#else
-       A.copyI marr (off0+len0) arr1 off1 (off0+newlen)
-+#endif
-       arr2 <- A.unsafeFreeze marr
-       return (Buf arr2 off0 newlen cap0 newgen)
-     else do
-@@ -116,8 +127,13 @@ append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do
-           newgen = 1
-       marr <- A.new (newcap + woff)
-       writeGen marr newgen
-+#if MIN_VERSION_text(2,0,0)
-+      A.copyI len0 marr woff arr0 off0
-+      A.copyI newlen marr (woff+len0) arr1 off1
-+#else
-       A.copyI marr woff arr0 off0 (woff+len0)
-       A.copyI marr (woff+len0) arr1 off1 (woff+newlen)
-+#endif
-       arr2 <- A.unsafeFreeze marr
-       return (Buf arr2 woff newlen newcap newgen)
- 
-@@ -132,11 +148,52 @@ substring s l (Buf arr off len _ _) =
-   Text arr (off+s) l
- {-# INLINE substring #-}
- 
--dropWord16 :: Int -> Buffer -> Text
--dropWord16 s (Buf arr off len _ _) =
-+#if MIN_VERSION_text(2,0,0)
-+
-+lengthCodeUnits :: Text -> Int
-+lengthCodeUnits = lengthWord8
-+
-+dropCodeUnits :: Int -> Buffer -> Text
-+dropCodeUnits s (Buf arr off len _ _) =
-+  assert (s >= 0 && s <= len) $
-+  Text arr (off+s) (len-s)
-+{-# INLINE dropCodeUnits #-}
-+
-+-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-8
-+-- array, returning the current character and the delta to add to give
-+-- the next offset to iterate at.
-+iter :: Buffer -> Int -> Iter
-+iter (Buf arr off _ _ _) i = iterArray arr (off + i)
-+{-# INLINE iter #-}
-+
-+-- | /O(1)/ Iterate one step through a UTF-8 array, returning the
-+-- delta to add to give the next offset to iterate at.
-+iter_ :: Buffer -> Int -> Int
-+iter_ (Buf arr off _ _ _) i = utf8LengthByLeader $ A.unsafeIndex arr (off+i)
-+{-# INLINE iter_ #-}
-+
-+unsafeThaw :: A.Array -> ST s (A.MArray s)
-+unsafeThaw (A.ByteArray a) = ST $ \s# ->
-+                          (# s#, A.MutableByteArray (unsafeCoerce# a) #)
-+
-+readGen :: A.Array -> Int
-+readGen (A.ByteArray a) = case indexIntArray# a 0# of r# -> I# r#
-+
-+writeGen :: A.MArray s -> Int -> ST s ()
-+writeGen (A.MutableByteArray a) (I# gen#) = ST $ \s0# ->
-+  case writeIntArray# a 0# gen# s0# of
-+    s1# -> (# s1#, () #)
-+
-+#else
-+
-+lengthCodeUnits :: Text -> Int
-+lengthCodeUnits = lengthWord16
-+
-+dropCodeUnits :: Int -> Buffer -> Text
-+dropCodeUnits s (Buf arr off len _ _) =
-   assert (s >= 0 && s <= len) $
-   Text arr (off+s) (len-s)
--{-# INLINE dropWord16 #-}
-+{-# INLINE dropCodeUnits #-}
- 
- -- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
- -- array, returning the current character and the delta to add to give
-@@ -170,3 +227,5 @@ writeGen :: A.MArray s -> Int -> ST s ()
- writeGen a (I# gen#) = ST $ \s0# ->
-   case writeIntArray# (A.maBA a) 0# gen# s0# of
-     s1# -> (# s1#, () #)
-+
-+#endif
-diff --git a/Data/Attoparsec/Text/Internal.hs b/Data/Attoparsec/Text/Internal.hs
-index 710d23e..02f04fd 100644
---- a/Data/Attoparsec/Text/Internal.hs
-+++ b/Data/Attoparsec/Text/Internal.hs
-@@ -176,7 +176,7 @@ string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
-          | T.null ft         -> suspended s s t pos more lose succ
-          | otherwise         -> lose t pos more [] "string"
-        Just (pfx,ssfx,tsfx)
--         | T.null ssfx       -> let l = Pos (T.lengthWord16 pfx)
-+         | T.null ssfx       -> let l = Pos (Buf.lengthCodeUnits pfx)
-                                 in succ t (pos + l) more (substring pos l t)
-          | not (T.null tsfx) -> lose t pos more [] "string"
-          | otherwise         -> suspended s ssfx t pos more lose succ
-@@ -195,7 +195,7 @@ stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =
-       in case T.commonPrefixes s0 s of
-         Nothing         -> lose t pos more [] "string"
-         Just (_pfx,ssfx,tsfx)
--          | T.null ssfx -> let l = Pos (T.lengthWord16 s000)
-+          | T.null ssfx -> let l = Pos (Buf.lengthCodeUnits s000)
-                            in succ t (pos + l) more (substring pos l t)
-           | T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ
-           | otherwise   -> lose t pos more [] "string"
-@@ -445,12 +445,12 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
- 
- -- | Terminal failure continuation.
- failK :: Failure a
--failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg
-+failK t (Pos pos) _more stack msg = Fail (Buf.dropCodeUnits pos t) stack msg
- {-# INLINE failK #-}
- 
- -- | Terminal success continuation.
- successK :: Success a a
--successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a
-+successK t (Pos pos) _more a = Done (Buf.dropCodeUnits pos t) a
- {-# INLINE successK #-}
- 
- -- | Run a parser.
-@@ -477,7 +477,7 @@ parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
- 
- get :: Parser Text
- get = T.Parser $ \t pos more _lose succ ->
--  succ t pos more (Buf.dropWord16 (fromPos pos) t)
-+  succ t pos more (Buf.dropCodeUnits (fromPos pos) t)
- {-# INLINE get #-}
- 
- endOfChunk :: Parser Bool
-diff --git a/tests/QC/Buffer.hs b/tests/QC/Buffer.hs
-index 7227b72..277e093 100644
---- a/tests/QC/Buffer.hs
-+++ b/tests/QC/Buffer.hs
-@@ -51,7 +51,7 @@ b_length :: BPB -> Property
- b_length (BP _ts t buf) = B.length t === BB.length buf
- 
- t_length :: BPT -> Property
--t_length (BP _ts t buf) = T.lengthWord16 t === BT.length buf
-+t_length (BP _ts t buf) = BT.lengthCodeUnits t === BT.length buf
- 
- b_unsafeIndex :: BPB -> Gen Property
- b_unsafeIndex (BP _ts t buf) = do
-@@ -61,14 +61,14 @@ b_unsafeIndex (BP _ts t buf) = do
- 
- t_iter :: BPT -> Gen Property
- t_iter (BP _ts t buf) = do
--  let l = T.lengthWord16 t
-+  let l = BT.lengthCodeUnits t
-   i <- choose (0,l-1)
-   let it (T.Iter c q) = (c,q)
-   return $ l === 0 .||. it (T.iter t i) === it (BT.iter buf i)
- 
- t_iter_ :: BPT -> Gen Property
- t_iter_ (BP _ts t buf) = do
--  let l = T.lengthWord16 t
-+  let l = BT.lengthCodeUnits t
-   i <- choose (0,l-1)
-   return $ l === 0 .||. T.iter_ t i === BT.iter_ buf i
- 
-@@ -77,10 +77,16 @@ b_unsafeDrop (BP _ts t buf) = do
-   i <- choose (0, B.length t)
-   return $ B.unsafeDrop i t === BB.unsafeDrop i buf
- 
--t_dropWord16 :: BPT -> Gen Property
--t_dropWord16 (BP _ts t buf) = do
--  i <- choose (0, T.lengthWord16 t)
--  return $ T.dropWord16 i t === BT.dropWord16 i buf
-+t_dropCodeUnits :: BPT -> Gen Property
-+t_dropCodeUnits (BP _ts t buf) = do
-+  i <- choose (0, BT.lengthCodeUnits t)
-+  return $ dropCodeUnits i t === BT.dropCodeUnits i buf
-+  where
-+#if MIN_VERSION_text(2,0,0)
-+    dropCodeUnits = T.dropWord8
-+#else
-+    dropCodeUnits = T.dropWord16
-+#endif
- 
- tests :: [TestTree]
- tests = [
-@@ -92,5 +98,5 @@ tests = [
-   , testProperty "t_iter" t_iter
-   , testProperty "t_iter_" t_iter_
-   , testProperty "b_unsafeDrop" b_unsafeDrop
--  , testProperty "t_dropWord16" t_dropWord16
-+  , testProperty "t_dropCodeUnits" t_dropCodeUnits
-   ]

patches/constraints-extras-0.3.2.0.patch

-diff --git a/src/Data/Constraint/Extras/TH.hs b/src/Data/Constraint/Extras/TH.hs
-index 9259409..b22c80b 100644
---- a/src/Data/Constraint/Extras/TH.hs
-+++ b/src/Data/Constraint/Extras/TH.hs
-@@ -1,3 +1,4 @@
-+{-# LANGUAGE CPP #-}
- {-# LANGUAGE LambdaCase #-}
- {-# LANGUAGE QuasiQuotes #-}
- {-# LANGUAGE TemplateHaskell #-}
-@@ -52,7 +53,11 @@ matches c constrs argDictName = do
-                   Nothing -> WildP : rest done
-                   Just _ -> VarP v : rest True
-               pat = foldr patf (const []) ps False
--          in [Match (ConP name pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
-+            in [Match (ConP name
-+#if MIN_VERSION_template_haskell(2,18,0)
-+                            []
-+#endif
-+                            pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
-     ForallC _ _ (GadtC [name] _ _) -> return $
-       [Match (RecP name []) (NormalB $ ConE 'Dict) []]
-     a -> error $ "deriveArgDict matches: Unmatched 'Dec': " ++ show a

patches/critbit-0.2.0.0.patch

 diff --git a/Data/CritBit/Set.hs b/Data/CritBit/Set.hs
-index 0039925..eab81a5 100644
+index 0039925..4a4ffc4 100644
 --- a/Data/CritBit/Set.hs
 +++ b/Data/CritBit/Set.hs
-@@ -1,3 +1,4 @@
-+{-# LANGUAGE CPP #-}
- {-# OPTIONS_GHC -fno-warn-orphans #-}
- 
- -- |
-@@ -90,6 +91,9 @@ import Data.CritBit.Types.Internal (CritBit(..), Set(..), CritBitKey, Node(..))
+@@ -90,6 +90,7 @@ import Data.CritBit.Types.Internal (CritBit(..), Set(..), CritBitKey, Node(..))
  import Data.Foldable (Foldable, foldMap)
  import Data.Maybe (isJust)
  import Data.Monoid (Monoid(..))
-+#if MIN_VERSION_base(4,9,0)
 +import Data.Semigroup (Semigroup(..))
-+#endif
  import Prelude hiding (null, filter, map, foldl, foldr)
  import qualified Data.CritBit.Tree as T
  import qualified Data.List as List
-@@ -97,9 +101,16 @@ import qualified Data.List as List
+@@ -97,9 +98,12 @@ import qualified Data.List as List
  instance (Show a) => Show (Set a) where
      show s = "fromList " ++ show (toList s)
  
-+#if MIN_VERSION_base(4,9,0)
 +instance CritBitKey k => Semigroup (Set k) where
 +    (<>) = union
-+#endif
 +
  instance CritBitKey k => Monoid (Set k) where
      mempty  = empty
-+#if !(MIN_VERSION_base(4,11,0))
-     mappend = union
-+#endif
+-    mappend = union
++    mappend = (<>)
      mconcat = unions
  
  instance Foldable Set where
 diff --git a/Data/CritBit/Tree.hs b/Data/CritBit/Tree.hs
-index e50738b..9a3c3d4 100644
+index e50738b..5eb95fa 100644
 --- a/Data/CritBit/Tree.hs
 +++ b/Data/CritBit/Tree.hs
-@@ -1,4 +1,4 @@
--{-# LANGUAGE BangPatterns, RecordWildCards, ScopedTypeVariables #-}
-+{-# LANGUAGE CPP, BangPatterns, RecordWildCards, ScopedTypeVariables #-}
- {-# OPTIONS_GHC -fno-warn-orphans #-}
- 
- -- |
-@@ -153,21 +153,31 @@ import Data.CritBit.Core
+@@ -153,15 +153,19 @@ import Data.CritBit.Core
  import Data.CritBit.Types.Internal
  import Data.Maybe (fromMaybe)
  import Data.Monoid (Monoid(..))
-+#if MIN_VERSION_base(4,9,0)
 +import Data.Semigroup (Semigroup(..))
-+#endif
  import Data.Traversable (Traversable(traverse))
  import Prelude hiding (foldl, foldr, lookup, null, map, filter)
  import qualified Data.Array as A
  import qualified Data.Foldable as Foldable
  import qualified Data.List as List
  
-+#if MIN_VERSION_base(4,9,0)
 +instance CritBitKey k => Semigroup (CritBit k v) where
 +    (<>) = union
-+#endif
 +
  instance CritBitKey k => Monoid (CritBit k v) where
      mempty  = empty
-+#if !(MIN_VERSION_base(4,11,0))
-     mappend = union
-+#endif
+-    mappend = union
++    mappend = (<>)
      mconcat = unions
  
  instance CritBitKey k => Traversable (CritBit k) where
-     traverse f m = traverseWithKey (\_ v -> f v) m
- 
--infixl 9 !, \\
-+infixl 9 !, \\ -- Comment needed here to avoid CPP bug
- 
- -- | /O(k)/. Find the value at a key.
- -- Calls 'error' when the element can not be found.
-@@ -1248,8 +1258,7 @@ deleteMax m = updateMaxWithKey (\_ _ -> Nothing) m
- -- > deleteFindMin     Error: can not return the minimal element of an empty map
- deleteFindMin :: CritBit k v -> ((k, v), CritBit k v)
- deleteFindMin = fromMaybe (error msg) . minViewWithKey
--  where msg = "CritBit.deleteFindMin: cannot return the minimal \
--              \element of an empty map"
-+  where msg = "CritBit.deleteFindMin: cannot return the minimal element of an empty map"
- {-# INLINABLE deleteFindMin #-}
- 
- -- | /O(k)/. Delete and find the maximal element.
-@@ -1258,8 +1267,7 @@ deleteFindMin = fromMaybe (error msg) . minViewWithKey
- -- > deleteFindMax     Error: can not return the maximal element of an empty map
- deleteFindMax :: CritBit k v -> ((k, v), CritBit k v)
- deleteFindMax = fromMaybe (error msg) . maxViewWithKey
--  where msg = "CritBit.deleteFindMax: cannot return the minimal \
--              \element of an empty map"
-+  where msg = "CritBit.deleteFindMax: cannot return the minimal element of an empty map"
- {-# INLINABLE deleteFindMax #-}
- 
- -- | /O(k')/. Retrieves the value associated with minimal key of the
 diff --git a/Data/CritBit/Types/Internal.hs b/Data/CritBit/Types/Internal.hs
-index d278b5a..4008ec7 100644
+index d278b5a..d537ad6 100644
 --- a/Data/CritBit/Types/Internal.hs
 +++ b/Data/CritBit/Types/Internal.hs
-@@ -192,7 +192,11 @@ instance CritBitKey Text where
+@@ -185,15 +185,25 @@ instance CritBitKey ByteString where
+     {-# INLINE getByte #-}
+ 
+ instance CritBitKey Text where
++#if MIN_VERSION_text(2,0,0)
++    byteCount (Text _ _ len) = len
++#else
+     byteCount (Text _ _ len) = len `shiftL` 1
++#endif
+     {-# INLINE byteCount #-}
+ 
++#if MIN_VERSION_text(2,0,0)
++    getByte (Text arr off len) n
++        | n < len = fromIntegral (T.unsafeIndex arr (off + n)) .|. 256
++        | otherwise = 0
++#else
+     getByte (Text arr off len) n
          | n < len `shiftL` 1 =
              let word       = T.unsafeIndex arr (off + (n `shiftR` 1))
                  byteInWord = (word `shiftR` ((n .&. 1) `shiftL` 3)) .&. 0xff
-+#if MIN_VERSION_text(2,0,0)
-+            in fromIntegral (byteInWord .|. 256)
-+#else
              in byteInWord .|. 256
-+#endif
          | otherwise       = 0
++#endif
      {-# INLINE getByte #-}
  
+ #if WORD_SIZE_IN_BITS == 64

patches/data-dword-0.3.2.patch

-diff --git a/src/Data/DoubleWord/TH.hs b/src/Data/DoubleWord/TH.hs
-index 78bbfa9..24f93e1 100644
---- a/src/Data/DoubleWord/TH.hs
-+++ b/src/Data/DoubleWord/TH.hs
-@@ -157,7 +157,7 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
-         -}
-         [ funHiLo2 'compare $
-             CaseE (appVN 'compare [hi, hi'])
--              [ Match (ConP 'EQ []) (NormalB (appVN 'compare [lo, lo'])) []
-+              [ Match (conPCompat 'EQ []) (NormalB (appVN 'compare [lo, lo'])) []
-               , Match (VarP x) (NormalB (VarE x)) [] ]
-         , inlinable 'compare ]
-     , inst ''Bounded [tp]
-@@ -213,10 +213,10 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
-           fromEnum _           = ERROR
-         -}
-         , FunD 'fromEnum $
--            Clause [ConP cn [LitP $ IntegerL 0, VarP lo]]
-+            Clause [conPCompat cn [LitP $ IntegerL 0, VarP lo]]
-                    (NormalB $ appVN 'fromEnum [lo]) [] :
-             if signed
--            then [ Clause [ConP cn [LitP $ IntegerL (-1), VarP lo]]
-+            then [ Clause [conPCompat cn [LitP $ IntegerL (-1), VarP lo]]
-                           (NormalB $
-                              appV 'negate
-                                [appV 'fromEnum [appV 'negate [VarE lo]]])
-@@ -257,9 +257,9 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $