Skip to content

Commit

Permalink
Implement coercionToPlatformTypes
Browse files Browse the repository at this point in the history
  • Loading branch information
Bodigrim committed Dec 13, 2023
1 parent f47ab7a commit 525a6bd
Show file tree
Hide file tree
Showing 5 changed files with 63 additions and 75 deletions.
5 changes: 4 additions & 1 deletion System/OsString.hs
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,9 @@ module System.OsString
, count
, findIndex
, findIndices

-- * Coercions
, coercionToPlatformTypes
)
where

Expand Down Expand Up @@ -202,5 +205,5 @@ import System.OsString.Internal
, findIndices
)
import System.OsString.Internal.Types
( OsString, OsChar )
( OsString, OsChar, coercionToPlatformTypes )
import Prelude ()
10 changes: 4 additions & 6 deletions System/OsString/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)



Expand Down Expand Up @@ -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'
--
Expand Down Expand Up @@ -723,4 +722,3 @@ findIndex = coerce PF.findIndex
-- @since 1.4.200.0
findIndices :: (OsChar -> Bool) -> OsString -> [Int]
findIndices = coerce PF.findIndices

59 changes: 27 additions & 32 deletions System/OsString/Internal/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand Down Expand Up @@ -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)
Expand All @@ -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
30 changes: 14 additions & 16 deletions bench/BenchOsString.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..))
Expand All @@ -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
34 changes: 14 additions & 20 deletions tests/bytestring-tests/Properties/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down

0 comments on commit 525a6bd

Please sign in to comment.