Skip to content

Commit 0552854

Browse files
committed
Fix build with GHC >= 9.6
1 parent 31438b4 commit 0552854

File tree

3 files changed

+100
-9
lines changed

3 files changed

+100
-9
lines changed

System/File/OsPath/Internal.hs

Lines changed: 36 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE TypeApplications #-}
23
{-# LANGUAGE BangPatterns #-}
34
{-# LANGUAGE ViewPatterns #-}
@@ -8,7 +9,7 @@ module System.File.OsPath.Internal where
89

910
import qualified System.File.Platform as P
1011

11-
import Prelude ((.), ($), String, IO, ioError, pure, either, const, flip, Maybe(..), fmap, (<$>), id, Bool(..), FilePath, (++), return, show, (>>=), (==), otherwise, errorWithoutStackTrace, userError)
12+
import Prelude ((.), ($), String, IO, ioError, pure, either, const, flip, Maybe(..), fmap, (<$>), id, Bool(..), FilePath, (++), return, show, (>>=), (==), otherwise, errorWithoutStackTrace, userError, mempty)
1213
import GHC.IO (catchException)
1314
import GHC.IO.Exception (IOException(..))
1415
import GHC.IO.Handle (hClose_help)
@@ -20,14 +21,16 @@ import Control.DeepSeq (force)
2021
import Control.Exception (SomeException, try, evaluate, mask, onException, throwIO)
2122
import System.IO (IOMode(..), hSetBinaryMode, hClose)
2223
import System.IO.Unsafe (unsafePerformIO)
23-
import System.OsString (osstr)
2424
import System.OsPath as OSP
2525
import System.OsString.Internal.Types
2626

2727
import qualified Data.ByteString as BS
2828
import qualified Data.ByteString.Lazy as BSL
2929
import qualified System.OsString as OSS
3030
import System.Posix.Types (CMode)
31+
#if !MIN_VERSION_filepath(1, 5, 0)
32+
import Data.Coerce
33+
#endif
3134

3235
-- | Like 'openFile', but open the file in binary mode.
3336
-- On Windows, reading a file in text mode (which is the default)
@@ -232,7 +235,7 @@ augmentError str osfp = flip catchException (ioError . addFilePathToIOError str
232235
openTempFile' :: String -> OsPath -> OsString -> Bool -> CMode
233236
-> IO (OsPath, Handle)
234237
openTempFile' loc (OsString tmp_dir) template@(OsString tmpl) binary mode
235-
| OSS.any (== OSP.pathSeparator) template
238+
| any_ (== OSP.pathSeparator) template
236239
= throwIO $ userError $ "openTempFile': Template string must not contain path separator characters: " ++ P.lenientDecode tmpl
237240
| otherwise = do
238241
(fp, hdl) <- P.findTempName (prefix, suffix) loc tmp_dir mode
@@ -243,18 +246,45 @@ openTempFile' loc (OsString tmp_dir) template@(OsString tmpl) binary mode
243246
-- for temporary files (hidden on Unix OSes). Unfortunately we're
244247
-- below filepath in the hierarchy here.
245248
(OsString prefix, OsString suffix) =
246-
case OSS.break (== OSS.unsafeFromChar '.') $ OSS.reverse template of
249+
case break_ (== OSS.unsafeFromChar '.') $ reverse_ template of
247250
-- First case: template contains no '.'s. Just re-reverse it.
248-
(rev_suffix, [osstr||]) -> (OSS.reverse rev_suffix, OSS.empty)
251+
(rev_suffix, xs)
252+
| xs == mempty -> (reverse_ rev_suffix, mempty)
249253
-- Second case: template contains at least one '.'. Strip the
250254
-- dot from the prefix and prepend it to the suffix (if we don't
251255
-- do this, the unique number will get added after the '.' and
252256
-- thus be part of the extension, which is wrong.)
253257
(rev_suffix, xs)
254258
| (h:rest) <- OSS.unpack xs
255-
, h == unsafeFromChar '.' -> (OSS.reverse (OSS.pack rest), OSS.cons (unsafeFromChar '.') $ OSS.reverse rev_suffix)
259+
, h == unsafeFromChar '.' -> (reverse_ (OSS.pack rest), cons_ (unsafeFromChar '.') $ reverse_ rev_suffix)
256260
-- Otherwise, something is wrong, because (break (== '.')) should
257261
-- always return a pair with either the empty string or a string
258262
-- beginning with '.' as the second component.
259263
_ -> errorWithoutStackTrace "bug in System.IO.openTempFile"
260264

265+
#if MIN_VERSION_filepath(1, 5, 0)
266+
any_ :: (OsChar -> Bool) -> OsString -> Bool
267+
any_ = OSS.any
268+
269+
cons_ :: OsChar -> OsString -> OsString
270+
cons_ = OSS.cons
271+
272+
break_ :: (OsChar -> Bool) -> OsString -> (OsString, OsString)
273+
break_ = OSS.break
274+
275+
reverse_ :: OsString -> OsString
276+
reverse_ = OSS.reverse
277+
#else
278+
any_ :: (OsChar -> Bool) -> OsString -> Bool
279+
any_ = coerce P.any_
280+
281+
cons_ :: OsChar -> OsString -> OsString
282+
cons_ = coerce P.cons_
283+
284+
break_ :: (OsChar -> Bool) -> OsString -> (OsString, OsString)
285+
break_ = coerce P.break_
286+
287+
reverse_ :: OsString -> OsString
288+
reverse_ = coerce P.reverse_
289+
#endif
290+

posix/System/File/Platform.hs

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE TupleSections #-}
23
{-# LANGUAGE TypeApplications #-}
4+
{-# LANGUAGE PackageImports #-}
35

46
module System.File.Platform where
57

@@ -24,6 +26,15 @@ import System.Posix.Internals (c_getpid)
2426
import GHC.IORef (atomicModifyIORef'_)
2527
import Foreign.C (getErrno, eEXIST, errnoToIOError)
2628

29+
#if MIN_VERSION_filepath(1, 5, 0)
30+
import "os-string" System.OsString.Internal.Types (PosixString(..), PosixChar(..))
31+
import qualified "os-string" System.OsString.Data.ByteString.Short as BC
32+
#else
33+
import Data.Coerce (coerce)
34+
import "filepath" System.OsString.Internal.Types (PosixString(..), PosixChar(..))
35+
import qualified "filepath" System.OsPath.Data.ByteString.Short as BC
36+
#endif
37+
2738
-- | Open a file and return the 'Handle'.
2839
openFile :: PosixPath -> IOMode -> IO Handle
2940
openFile = openFile_ defaultFileFlags'
@@ -111,3 +122,19 @@ lenientDecode ps = let utf8' = PS.decodeWith utf8 ps
111122
(_, Right s) -> s
112123
(Left _, Left _) -> error "lenientDecode: failed to decode"
113124

125+
#if !MIN_VERSION_filepath(1, 5, 0)
126+
127+
break_ :: (PosixChar -> Bool) -> PosixString -> (PosixString, PosixString)
128+
break_ = coerce BC.break
129+
130+
reverse_ :: PosixString -> PosixString
131+
reverse_ = coerce BC.reverse
132+
133+
any_ :: (PosixChar -> Bool) -> PosixString -> Bool
134+
any_ = coerce BC.any
135+
136+
cons_ :: PosixChar -> PosixString -> PosixString
137+
cons_ = coerce BC.cons
138+
139+
#endif
140+

windows/System/File/Platform.hsc

Lines changed: 37 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE TypeApplications #-}
33
{-# LANGUAGE QuasiQuotes #-}
4+
{-# LANGUAGE PackageImports #-}
45

56
module System.File.Platform where
67

@@ -11,12 +12,14 @@ import System.OsPath.Windows ( WindowsPath )
1112
import qualified System.OsPath.Windows as WS
1213
import Foreign.C.Types
1314

14-
import System.OsString.Encoding
1515
import qualified System.OsString.Windows as WS hiding (decodeFS)
1616
import System.OsString.Windows ( pstr, WindowsString )
1717
import qualified System.Win32 as Win32
1818
import qualified System.Win32.WindowsString.File as WS
19-
import System.Win32.WindowsString.Types (withTString, withFilePath, peekTString)
19+
import System.Win32.WindowsString.Types (withTString, peekTString)
20+
#if MIN_VERSION_Win32(2, 14, 0)
21+
import System.Win32.WindowsString.Types (withFilePath)
22+
#endif
2023
import Control.Monad (when, void)
2124
#if defined(__IO_MANAGER_WINIO__)
2225
import GHC.IO.SubSystem
@@ -36,6 +39,17 @@ import System.Posix.Types (CMode)
3639
import System.IO.Unsafe (unsafePerformIO)
3740
import System.Posix.Internals (c_getpid, o_EXCL)
3841

42+
#if MIN_VERSION_filepath(1, 5, 0)
43+
import System.OsString.Encoding
44+
import "os-string" System.OsString.Internal.Types (WindowsString(..), WindowsChar(..))
45+
import qualified "os-string" System.OsString.Data.ByteString.Short as BC
46+
#else
47+
import Data.Coerce (coerce)
48+
import System.OsPath.Encoding
49+
import "filepath" System.OsString.Internal.Types (WindowsString(..), WindowsChar(..))
50+
import qualified "filepath" System.OsPath.Data.ByteString.Short.Word16 as BC
51+
#endif
52+
3953
-- | Open a file and return the 'Handle'.
4054
openFile :: WindowsPath -> IOMode -> IO Handle
4155
openFile fp iomode = bracketOnError
@@ -144,8 +158,12 @@ findTempName :: (WindowsString, WindowsString)
144158
findTempName (prefix, suffix) loc tmp_dir mode = go
145159
where
146160
go = do
147-
let label = if WS.null prefix then [pstr|ghc|] else prefix
161+
let label = if prefix == mempty then [pstr|ghc|] else prefix
162+
#if MIN_VERSION_Win32(2, 14, 0)
148163
withFilePath tmp_dir $ \c_tmp_dir ->
164+
#else
165+
withTString tmp_dir $ \c_tmp_dir ->
166+
#endif
149167
withTString label $ \c_template ->
150168
withTString suffix $ \c_suffix ->
151169
with nullPtr $ \c_ptr -> do
@@ -201,3 +219,19 @@ toHandle fp iomode h = (`onException` Win32.closeHandle h) $ do
201219
fdToHandle' fd Nothing False fp' iomode True
202220
#endif
203221

222+
#if !MIN_VERSION_filepath(1, 5, 0)
223+
224+
break_ :: (WindowsChar -> Bool) -> WindowsString -> (WindowsString, WindowsString)
225+
break_ = coerce BC.break
226+
227+
reverse_ :: WindowsString -> WindowsString
228+
reverse_ = coerce BC.reverse
229+
230+
any_ :: (WindowsChar -> Bool) -> WindowsString -> Bool
231+
any_ = coerce BC.any
232+
233+
cons_ :: WindowsChar -> WindowsString -> WindowsString
234+
cons_ = coerce BC.cons
235+
236+
#endif
237+

0 commit comments

Comments
 (0)