1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
{- OsPath utilities
-
- Copyright 2025 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.OsPath (
OsPath,
OsString,
literalOsPath,
stringToOsPath,
toOsPath,
fromOsPath,
module X,
getSearchPath,
unsafeFromChar,
) where
import Utility.FileSystemEncoding
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as S
import qualified Data.ByteString.Lazy as L
#ifdef WITH_OSPATH
import System.OsPath as X hiding (OsPath, OsString, pack, unpack, unsafeFromChar)
import System.OsPath
import "os-string" System.OsString.Internal.Types
import qualified System.FilePath as PS
#if defined(mingw32_HOST_OS)
import GHC.IO (unsafePerformIO)
import System.OsString.Encoding.Internal (cWcharsToChars_UCS2)
import qualified System.OsString.Data.ByteString.Short.Word16 as BS16
#endif
#else
import System.FilePath.ByteString as X hiding (RawFilePath, getSearchPath)
import System.FilePath.ByteString (getSearchPath)
import Data.ByteString (ByteString)
import Data.Char
import Data.Word
#endif
class OsPathConv t where
toOsPath :: t -> OsPath
fromOsPath :: OsPath -> t
instance OsPathConv FilePath where
toOsPath = toOsPath . toRawFilePath
fromOsPath = fromRawFilePath . fromOsPath
#ifdef WITH_OSPATH
instance OsPathConv RawFilePath where
#if defined(mingw32_HOST_OS)
toOsPath = bytesToOsPath
fromOsPath = bytesFromOsPath
#else
toOsPath = bytesToOsPath . S.toShort
fromOsPath = S.fromShort . bytesFromOsPath
#endif
instance OsPathConv ShortByteString where
#if defined(mingw32_HOST_OS)
toOsPath = bytesToOsPath . S.fromShort
fromOsPath = S.toShort . bytesFromOsPath
#else
toOsPath = bytesToOsPath
fromOsPath = bytesFromOsPath
#endif
instance OsPathConv L.ByteString where
toOsPath = toOsPath . L.toStrict
fromOsPath = L.fromStrict . fromOsPath
#if defined(mingw32_HOST_OS)
-- On Windows, OsString contains a ShortByteString that is
-- utf-16 encoded. But the input RawFilePath is assumed to
-- be utf-8. So this is a relatively expensive conversion.
bytesToOsPath :: RawFilePath -> OsPath
bytesToOsPath = unsafePerformIO . encodeFS . fromRawFilePath
#else
bytesToOsPath :: ShortByteString -> OsPath
bytesToOsPath = OsString . PosixString
#endif
#if defined(mingw32_HOST_OS)
bytesFromOsPath :: OsPath -> RawFilePath
-- On Windows, OsString contains a ShortByteString that is
-- utf-16 encoded, but RawFilePath is utf-8.
-- So this is relatively expensive conversion.
bytesFromOsPath = toRawFilePath . cWcharsToChars_UCS2 . BS16.unpack . getWindowsString . getOsString
#else
bytesFromOsPath :: OsPath -> ShortByteString
bytesFromOsPath = getPosixString . getOsString
#endif
{- For some reason not included in System.OsPath -}
getSearchPath :: IO [OsPath]
getSearchPath = map toOsPath <$> PS.getSearchPath
{- Used for string constants. Note that when using OverloadedStrings,
- the IsString instance for ShortByteString only works properly with
- ASCII characters. -}
literalOsPath :: ShortByteString -> OsPath
literalOsPath = toOsPath
#else
{- When not building with WITH_OSPATH, use RawFilePath.
-}
type OsPath = RawFilePath
type OsString = ByteString
instance OsPathConv RawFilePath where
toOsPath = id
fromOsPath = id
instance OsPathConv ShortByteString where
toOsPath = S.fromShort
fromOsPath = S.toShort
instance OsPathConv L.ByteString where
toOsPath = L.toStrict
fromOsPath = L.fromStrict
unsafeFromChar :: Char -> Word8
unsafeFromChar = fromIntegral . ord
literalOsPath :: RawFilePath -> OsPath
literalOsPath = id
#endif
stringToOsPath :: String -> OsPath
stringToOsPath = toOsPath
|
