Implement coercionToPlatformTypes

System/OsString.hs

@@ -123,6 +123,9 @@ module System.OsString
   , count
   , findIndex
   , findIndices
+
+  -- * Coercions
+  , coercionToPlatformTypes
   )
 where
 
@@ -202,5 +205,5 @@ import System.OsString.Internal
     , findIndices
     )
 import System.OsString.Internal.Types
-    ( OsString, OsChar )
+    ( OsString, OsChar, coercionToPlatformTypes )
 import Prelude ()

System/OsString/Internal.hs

@@ -33,6 +33,7 @@ import qualified System.OsString.Posix as PF
 #endif
 import GHC.Stack (HasCallStack)
 import Data.Coerce (coerce)
+import Data.Type.Coercion (coerceWith)
 
 
 
@@ -181,11 +182,9 @@ unsafeFromChar = coerce PF.unsafeFromChar
 
 -- | Converts back to a unicode codepoint (total).
 toChar :: OsChar -> Char
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-toChar (OsChar (WindowsChar w)) = chr $ fromIntegral w
-#else
-toChar (OsChar (PosixChar w)) = chr $ fromIntegral w
-#endif
+toChar = case coercionToPlatformTypes of
+  Left (co, _) -> chr . fromIntegral . getWindowsChar . coerceWith co
+  Right (co, _) -> chr . fromIntegral . getPosixChar . coerceWith co
 
 -- | /O(n)/ Append a byte to the end of a 'OsString'
 --
@@ -723,4 +722,3 @@ findIndex = coerce PF.findIndex
 -- @since 1.4.200.0
 findIndices :: (OsChar -> Bool) -> OsString -> [Int]
 findIndices = coerce PF.findIndices
-

System/OsString/Internal/Types.hs

@@ -26,12 +26,15 @@ module System.OsString.Internal.Types
   , PlatformChar
   , OsString(..)
   , OsChar(..)
+  , coercionToPlatformTypes
   )
 where
 
 
 import Control.DeepSeq
+import Data.Coerce (coerce)
 import Data.Data
+import Data.Type.Coercion (Coercion(..), coerceWith)
 import Data.Word
 import Language.Haskell.TH.Syntax
     ( Lift (..), lift )
@@ -178,47 +181,25 @@ instance Ord OsString where
 -- | \"String-Concatenation\" for 'OsString'. This is __not__ the same
 -- as '(</>)'.
 instance Monoid OsString where
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-    mempty      = OsString (WindowsString BS.empty)
-#if MIN_VERSION_base(4,16,0)
-    mappend = (<>)
-#else
-    mappend (OsString (WindowsString a)) (OsString (WindowsString b))
-      = OsString (WindowsString (mappend a b))
-#endif
-#else
-    mempty      = OsString (PosixString BS.empty)
-#if MIN_VERSION_base(4,16,0)
+    mempty  = coerce BS.empty
+#if MIN_VERSION_base(4,11,0)
     mappend = (<>)
 #else
-    mappend (OsString (PosixString a)) (OsString (PosixString b))
-      = OsString (PosixString (mappend a b))
-#endif
+    mappend = coerce (mappend :: BS.ShortByteString -> BS.ShortByteString -> BS.ShortByteString))
 #endif
+
 #if MIN_VERSION_base(4,11,0)
 instance Semigroup OsString where
-#if MIN_VERSION_base(4,16,0)
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-    (<>) (OsString (WindowsString a)) (OsString (WindowsString b))
-      = OsString (WindowsString (mappend a b))
-#else
-    (<>) (OsString (PosixString a)) (OsString (PosixString b))
-      = OsString (PosixString (mappend a b))
-#endif
-#else
-    (<>) = mappend
-#endif
+    (<>) = coerce (mappend :: BS.ShortByteString -> BS.ShortByteString -> BS.ShortByteString)
 #endif
 
 
 instance Lift OsString where
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-  lift (OsString (WindowsString bs))
-    = [| OsString (WindowsString (BS.pack $(lift $ BS.unpack bs))) :: OsString |]
-#else
-  lift (OsString (PosixString bs))
-    = [| OsString (PosixString (BS.pack $(lift $ BS.unpack bs))) :: OsString |]
-#endif
+  lift xs = case coercionToPlatformTypes of
+    Left (_, co) ->
+      [| OsString (WindowsString (BS.pack $(lift $ BS.unpack $ coerce $ coerceWith co xs))) :: OsString |]
+    Right (_, co) ->
+      [| OsString (PosixString (BS.pack $(lift $ BS.unpack $ coerce $ coerceWith co xs))) :: OsString |]
 #if MIN_VERSION_template_haskell(2,17,0)
   liftTyped = TH.unsafeCodeCoerce . TH.lift
 #elif MIN_VERSION_template_haskell(2,16,0)
@@ -244,3 +225,17 @@ instance Eq OsChar where
 instance Ord OsChar where
   compare (OsChar a) (OsChar b) = compare a b
 
+-- | This is a type-level evidence that 'OsChar' is a newtype wrapper
+-- over 'WindowsChar' or 'PosixChar' and 'OsString' is a newtype wrapper
+-- over 'WindowsString' or 'PosixString'. If you pattern match on
+-- 'coercionToPlatformTypes', GHC will know that relevant types
+-- are coercible to each other. This helps to avoid CPP in certain scenarios.
+coercionToPlatformTypes
+  :: Either
+  (Coercion OsChar WindowsChar, Coercion OsString WindowsString)
+  (Coercion OsChar PosixChar, Coercion OsString PosixString)
+#if defined(mingw32_HOST_OS)
+coercionToPlatformTypes = Left (Coercion, Coercion)
+#else
+coercionToPlatformTypes = Right (Coercion, Coercion)
+#endif

bench/BenchOsString.hs

@@ -14,6 +14,7 @@
 
 module BenchOsString (benchMark) where
 
+import           Data.Type.Coercion                    (coerceWith, sym)
 import           System.OsString                       (osstr)
 import qualified System.OsString                       as S
 import           System.OsString.Internal.Types        (OsString(..), OsChar(..), PosixChar(..), WindowsChar(..))
@@ -24,23 +25,20 @@ benchStr :: String
 benchStr = "OsString"
 
 w :: Int -> OsChar
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-w i = OsChar (WindowsChar (fromIntegral i))
-#else
-w i = OsChar (PosixChar (fromIntegral i))
-#endif
+w = case S.coercionToPlatformTypes of
+  Left (co, _) -> coerceWith (sym co) . WindowsChar . fromIntegral
+  Right (co, _) -> coerceWith (sym co) . PosixChar . fromIntegral
 
 hashWord8 :: OsChar -> OsChar
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-hashWord8 (OsChar (WindowsChar w)) = OsChar . WindowsChar . fromIntegral . hashInt . fromIntegral $ w
-#else
-hashWord8 (OsChar (PosixChar w)) = OsChar . PosixChar . fromIntegral . hashInt . fromIntegral $ w
-#endif
+hashWord8 = case S.coercionToPlatformTypes of
+  Left (co, _) ->
+    coerceWith (sym co) . WindowsChar . fromIntegral . hashInt . fromIntegral .
+      getWindowsChar . coerceWith co
+  Right (co, _) ->
+    coerceWith (sym co) . PosixChar . fromIntegral . hashInt . fromIntegral .
+      getPosixChar . coerceWith co
 
 iw :: OsChar -> Int
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-iw (OsChar (WindowsChar w)) = fromIntegral w
-#else
-iw (OsChar (PosixChar w)) = fromIntegral w
-#endif
-
+iw = case S.coercionToPlatformTypes of
+  Left (co, _) -> fromIntegral . getWindowsChar . coerceWith co
+  Right (co, _) -> fromIntegral . getPosixChar . coerceWith co

tests/bytestring-tests/Properties/Common.hs

@@ -62,6 +62,8 @@ import qualified System.OsString.Data.ByteString.Short as B8
 import Data.Word
 
 import Control.Arrow
+import Data.Coerce (coerce)
+import Data.Type.Coercion (Coercion(..), coerceWith, sym)
 import Data.Foldable
 import Data.List as L
 import Data.Semigroup
@@ -145,28 +147,22 @@ swapWPosix = id
 
 #ifdef OSWORD
 isSpace :: OsChar -> Bool
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-isSpace = isSpaceWin . getOsChar
-#else
-isSpace = isSpacePosix . getOsChar
-#endif
+isSpace = case OBS.coercionToPlatformTypes of
+  Left (co, _) -> isSpaceWin . coerceWith co
+  Right (co, _) -> isSpacePosix . coerceWith co
 
 numWord :: OsString -> Int
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-numWord = numWordWin . getOsString
-#else
-numWord = numWordPosix . getOsString
-#endif
+numWord = case OBS.coercionToPlatformTypes of
+  Left (_, co) -> numWordWin . coerceWith co
+  Right (_, co) -> numWordPosix . coerceWith co
 
 toElem :: OsChar -> OsChar
 toElem = id
 
 swapW :: OsChar -> OsChar
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-swapW = OsChar . swapWWin . getOsChar
-#else
-swapW = OsChar . swapWPosix . getOsChar
-#endif
+swapW = case OBS.coercionToPlatformTypes of
+  Left (co, _) -> coerceWith (sym co) . swapWWin . coerceWith co
+  Right (co, _) -> coerceWith (sym co) . swapWPosix . coerceWith co
 
 instance Arbitrary OsString where
   arbitrary = OsString <$> arbitrary
@@ -184,11 +180,9 @@ deriving instance Num OsChar
 deriving instance Bounded OsChar
 
 instance Arbitrary ShortByteString where
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-  arbitrary = getWindowsString <$> arbitrary
-#else
-  arbitrary = getPosixString <$> arbitrary
-#endif
+  arbitrary = case OBS.coercionToPlatformTypes of
+    Left (_, _) -> getWindowsString <$> arbitrary
+    Right (_, _) -> getPosixString <$> arbitrary
 
 #else