From 2d177619d54ca5d3173deccae8432a2b19a46a2f Mon Sep 17 00:00:00 2001
From: Matthew Craven <clyring@gmail.com>
Date: Wed, 14 Feb 2024 21:36:45 -0500
Subject: [PATCH] Move all endianness/byte-order CPP into one module (#659)

(cherry picked from commit 161780a31eafbb8627547126cc4129982ff20650)
---
 Data/ByteString/Builder/Prim/Binary.hs        | 42 ++++---------------
 Data/ByteString/Builder/RealFloat/Internal.hs | 29 ++++++-------
 Data/ByteString/Utils/ByteOrder.hs            | 42 +++++++++++++++++++
 bytestring.cabal                              |  3 +-
 4 files changed, 64 insertions(+), 52 deletions(-)
 create mode 100644 Data/ByteString/Utils/ByteOrder.hs

diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs
index 06fc77845..437f6ab90 100644
--- a/Data/ByteString/Builder/Prim/Binary.hs
+++ b/Data/ByteString/Builder/Prim/Binary.hs
@@ -1,12 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Trustworthy #-}
 
 {-# LANGUAGE TypeApplications #-}
 
-#include "MachDeps.h"
-#include "bytestring-cpp-macros.h"
-
-
 -- | Copyright   : (c) 2010-2011 Simon Meier
 -- License       : BSD3-style (see LICENSE)
 --
@@ -61,6 +56,7 @@ module Data.ByteString.Builder.Prim.Binary (
 
 import Data.ByteString.Builder.Prim.Internal
 import Data.ByteString.Builder.Prim.Internal.Floating
+import Data.ByteString.Utils.ByteOrder
 import Data.ByteString.Utils.UnalignedWrite
 
 import Foreign
@@ -86,38 +82,22 @@ word8 = fixedPrim 1 (flip poke) -- Word8 is always aligned
 -- | Encoding 'Word16's in big endian format.
 {-# INLINE word16BE #-}
 word16BE :: FixedPrim Word16
-#ifdef WORDS_BIGENDIAN
-word16BE = word16Host
-#else
-word16BE = byteSwap16 >$< word16Host
-#endif
+word16BE = whenLittleEndian byteSwap16 >$< word16Host
 
 -- | Encoding 'Word16's in little endian format.
 {-# INLINE word16LE #-}
 word16LE :: FixedPrim Word16
-#ifdef WORDS_BIGENDIAN
-word16LE = byteSwap16 >$< word16Host
-#else
-word16LE = word16Host
-#endif
+word16LE = whenBigEndian byteSwap16 >$< word16Host
 
 -- | Encoding 'Word32's in big endian format.
 {-# INLINE word32BE #-}
 word32BE :: FixedPrim Word32
-#ifdef WORDS_BIGENDIAN
-word32BE = word32Host
-#else
-word32BE = byteSwap32 >$< word32Host
-#endif
+word32BE = whenLittleEndian byteSwap32 >$< word32Host
 
 -- | Encoding 'Word32's in little endian format.
 {-# INLINE word32LE #-}
 word32LE :: FixedPrim Word32
-#ifdef WORDS_BIGENDIAN
-word32LE = byteSwap32 >$< word32Host
-#else
-word32LE = word32Host
-#endif
+word32LE = whenBigEndian byteSwap32 >$< word32Host
 
 -- on a little endian machine:
 -- word32LE w32 = fixedPrim 4 (\w p -> poke (castPtr p) w32)
@@ -125,20 +105,12 @@ word32LE = word32Host
 -- | Encoding 'Word64's in big endian format.
 {-# INLINE word64BE #-}
 word64BE :: FixedPrim Word64
-#ifdef WORDS_BIGENDIAN
-word64BE = word64Host
-#else
-word64BE = byteSwap64 >$< word64Host
-#endif
+word64BE = whenLittleEndian byteSwap64 >$< word64Host
 
 -- | Encoding 'Word64's in little endian format.
 {-# INLINE word64LE #-}
 word64LE :: FixedPrim Word64
-#ifdef WORDS_BIGENDIAN
-word64LE = byteSwap64 >$< word64Host
-#else
-word64LE = word64Host
-#endif
+word64LE = whenBigEndian byteSwap64 >$< word64Host
 
 
 -- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,
diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs
index 1b6b7f1d8..1d3ec08d4 100644
--- a/Data/ByteString/Builder/RealFloat/Internal.hs
+++ b/Data/ByteString/Builder/RealFloat/Internal.hs
@@ -72,6 +72,7 @@ import Data.Bits (Bits(..), FiniteBits(..))
 import Data.ByteString.Internal (c2w)
 import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim)
 import Data.ByteString.Builder.RealFloat.TableGenerator
+import Data.ByteString.Utils.ByteOrder
 import Data.ByteString.Utils.UnalignedWrite
 #if PURE_HASKELL
 import qualified Data.ByteString.Internal.Pure as Pure
@@ -408,25 +409,23 @@ wrapped f (I# w) = I# (f w)
 #if WORD_SIZE_IN_BITS == 32
 -- | Packs 2 32-bit system words (hi, lo) into a Word64
 packWord64 :: Word# -> Word# -> Word64#
-packWord64 hi lo =
-#if defined(WORDS_BIGENDIAN)
+packWord64 hi lo = case hostByteOrder of
+  BigEndian ->
     ((wordToWord64# lo) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# hi)
-#else
+  LittleEndian ->
     ((wordToWord64# hi) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# lo)
-#endif
 
 -- | Unpacks a Word64 into 2 32-bit words (hi, lo)
 unpackWord64 :: Word64# -> (# Word#, Word# #)
-unpackWord64 w =
-#if defined(WORDS_BIGENDIAN)
+unpackWord64 w = case hostByteOrder of
+  BigEndian ->
     (# word64ToWord# w
      , word64ToWord# (w `uncheckedShiftRL64#` 32#)
      #)
-#else
+  LittleEndian ->
     (# word64ToWord# (w `uncheckedShiftRL64#` 32#)
      , word64ToWord# w
      #)
-#endif
 
 -- | Adds 2 Word64's with 32-bit addition and manual carrying
 plusWord64 :: Word64# -> Word64# -> Word64#
@@ -731,21 +730,19 @@ getWord128At (Ptr arr) (I# i) = let
 
 -- | Packs 2 bytes [lsb, msb] into 16-bit word
 packWord16 :: Word# -> Word# -> Word#
-packWord16 l h =
-#if defined(WORDS_BIGENDIAN)
+packWord16 l h = case hostByteOrder of
+  BigEndian ->
     (h `uncheckedShiftL#` 8#) `or#` l
-#else
+  LittleEndian ->
     (l `uncheckedShiftL#` 8#) `or#` h
-#endif
 
 -- | Unpacks a 16-bit word into 2 bytes [lsb, msb]
 unpackWord16 :: Word# -> (# Word#, Word# #)
-unpackWord16 w =
-#if defined(WORDS_BIGENDIAN)
+unpackWord16 w = case hostByteOrder of
+  BigEndian ->
     (# w `and#` 0xff##, w `uncheckedShiftRL#` 8# #)
-#else
+  LittleEndian ->
     (# w `uncheckedShiftRL#` 8#, w `and#` 0xff## #)
-#endif
 
 
 -- | Static array of 2-digit pairs 00..99 for faster ascii rendering
diff --git a/Data/ByteString/Utils/ByteOrder.hs b/Data/ByteString/Utils/ByteOrder.hs
new file mode 100644
index 000000000..9248b7cad
--- /dev/null
+++ b/Data/ByteString/Utils/ByteOrder.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE CPP #-}
+
+-- | Why does this module exist? There is "GHC.ByteOrder" in base.
+-- But that module is /broken/ until base-4.14/ghc-8.10, so we
+-- can't rely on it until we drop support for older ghcs.
+-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20338
+-- and https://gitlab.haskell.org/ghc/ghc/-/issues/18445
+
+#include "MachDeps.h"
+
+module Data.ByteString.Utils.ByteOrder
+  ( ByteOrder(..)
+  , hostByteOrder
+  , whenLittleEndian
+  , whenBigEndian
+  ) where
+
+data ByteOrder
+  = LittleEndian
+  | BigEndian
+
+hostByteOrder :: ByteOrder
+hostByteOrder =
+#ifdef WORDS_BIGENDIAN
+  BigEndian
+#else
+  LittleEndian
+#endif
+
+-- | If the host is little-endian, applies the given function to the given arg.
+-- If the host is big-endian, returns the second argument unchanged.
+whenLittleEndian :: (a -> a) -> a -> a
+whenLittleEndian fun val = case hostByteOrder of
+  LittleEndian -> fun val
+  BigEndian    -> val
+
+-- | If the host is little-endian, returns the second argument unchanged.
+-- If the host is big-endian, applies the given function to the given arg.
+whenBigEndian :: (a -> a) -> a -> a
+whenBigEndian fun val = case hostByteOrder of
+  LittleEndian -> val
+  BigEndian    -> fun val
diff --git a/bytestring.cabal b/bytestring.cabal
index a680197ca..1de5c78b4 100644
--- a/bytestring.cabal
+++ b/bytestring.cabal
@@ -120,6 +120,7 @@ library
                      Data.ByteString.Lazy.ReadNat
                      Data.ByteString.ReadInt
                      Data.ByteString.ReadNat
+                     Data.ByteString.Utils.ByteOrder
                      Data.ByteString.Utils.UnalignedWrite
 
   default-language:  Haskell2010
@@ -140,7 +141,7 @@ library
                     -fmax-simplifier-iterations=10
                     -fdicts-cheap
                     -fspec-constr-count=6
-  
+
   if arch(javascript) || flag(pure-haskell)
     cpp-options: -DPURE_HASKELL=1
     other-modules: Data.ByteString.Internal.Pure