diff --git a/System/OsString.hs b/System/OsString.hs index 14b294c..ed88756 100644 --- a/System/OsString.hs +++ b/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 () diff --git a/System/OsString/Internal.hs b/System/OsString/Internal.hs index e0d5254..2a0326a 100644 --- a/System/OsString/Internal.hs +++ b/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 - diff --git a/System/OsString/Internal/Types.hs b/System/OsString/Internal/Types.hs index fd08b77..5cb00b3 100644 --- a/System/OsString/Internal/Types.hs +++ b/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 diff --git a/bench/BenchOsString.hs b/bench/BenchOsString.hs index b7e98a7..ad5c324 100644 --- a/bench/BenchOsString.hs +++ b/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 diff --git a/tests/bytestring-tests/Properties/Common.hs b/tests/bytestring-tests/Properties/Common.hs index f400a57..bb4dcac 100644 --- a/tests/bytestring-tests/Properties/Common.hs +++ b/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