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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE ViewPatterns #-} -- needed to quote a view pattern
module System.OsPath.Internal where
import {-# SOURCE #-} System.OsPath
( isValid )
import System.OsPath.Types
import qualified System.OsString.Internal as OS
import Control.Monad.Catch
( MonadThrow )
import Data.ByteString
( ByteString )
import Language.Haskell.TH.Quote
( QuasiQuoter (..) )
import Language.Haskell.TH.Syntax
( Lift (..), lift )
import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
import System.OsString.Internal.Types
import System.OsPath.Encoding
import Control.Monad (when)
import System.IO
( TextEncoding )
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
import qualified System.OsPath.Windows as PF
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
#else
import qualified System.OsPath.Posix as PF
import GHC.IO.Encoding.UTF8 ( mkUTF8 )
#endif
import GHC.Stack (HasCallStack)
-- | Partial unicode friendly encoding.
--
-- On windows this encodes as UTF16-LE (strictly), which is a pretty good guess.
-- On unix this encodes as UTF8 (strictly), which is a good guess.
--
-- Throws an 'EncodingException' if encoding fails. If the input does not
-- contain surrogate chars, you can use 'unsafeEncodeUtf'.
encodeUtf :: MonadThrow m => FilePath -> m OsPath
encodeUtf = OS.encodeUtf
-- | Unsafe unicode friendly encoding.
--
-- Like 'encodeUtf', except it crashes when the input contains
-- surrogate chars. For sanitized input, this can be useful.
unsafeEncodeUtf :: HasCallStack => String -> OsString
unsafeEncodeUtf = OS.unsafeEncodeUtf
-- | Encode a 'FilePath' with the specified encoding.
--
-- Note: on windows, we expect a "wide char" encoding (e.g. UCS-2 or UTF-16). Anything
-- that works with @Word16@ boundaries. Picking an incompatible encoding may crash
-- filepath operations.
encodeWith :: TextEncoding -- ^ unix text encoding
-> TextEncoding -- ^ windows text encoding (wide char)
-> FilePath
-> Either EncodingException OsPath
encodeWith = OS.encodeWith
-- | Like 'encodeUtf', except this mimics the behavior of the base library when doing filesystem
-- operations, which is:
--
-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,
-- but PEP 383 only works properly on UTF-8 encodings, so good luck)
-- 2. on windows does permissive UTF-16 encoding, where coding errors generate
-- Chars in the surrogate range
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
-- to deeply evaluate the result to catch exceptions).
encodeFS :: FilePath -> IO OsPath
encodeFS = OS.encodeFS
-- | Partial unicode friendly decoding.
--
-- On windows this decodes as UTF16-LE (strictly), which is a pretty good guess.
-- On unix this decodes as UTF8 (strictly), which is a good guess.
--
-- Throws a 'EncodingException' if decoding fails.
decodeUtf :: MonadThrow m => OsPath -> m FilePath
decodeUtf = OS.decodeUtf
-- | Decode an 'OsPath' with the specified encoding.
decodeWith :: TextEncoding -- ^ unix text encoding
-> TextEncoding -- ^ windows text encoding
-> OsPath
-> Either EncodingException FilePath
decodeWith = OS.decodeWith
-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem
-- operations, which is:
--
-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,
-- but PEP 383 only works properly on UTF-8 encodings, so good luck)
-- 2. on windows does permissive UTF-16 encoding, where coding errors generate
-- Chars in the surrogate range
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
-- to deeply evaluate the result to catch exceptions).
decodeFS :: OsPath -> IO FilePath
decodeFS = OS.decodeFS
-- | Constructs an @OsPath@ from a ByteString.
--
-- On windows, this ensures valid UCS-2LE, on unix it is passed unchanged/unchecked.
--
-- Throws 'EncodingException' on invalid UCS-2LE on windows (although unlikely).
fromBytes :: MonadThrow m
=> ByteString
-> m OsPath
fromBytes = OS.fromBytes
-- | QuasiQuote an 'OsPath'. This accepts Unicode characters
-- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid'
-- on the input. If used as a pattern, requires turning on the @ViewPatterns@
-- extension.
osp :: QuasiQuoter
osp = QuasiQuoter
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
{ quoteExp = \s -> do
osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
lift osp'
, quotePat = \s -> do
osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
[p|((==) osp' -> True)|]
, quoteType = \_ ->
fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"
, quoteDec = \_ ->
fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"
}
#else
{ quoteExp = \s -> do
osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
lift osp'
, quotePat = \s -> do
osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
[p|((==) osp' -> True)|]
, quoteType = \_ ->
fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"
, quoteDec = \_ ->
fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"
}
#endif
-- | Unpack an 'OsPath' to a list of 'OsChar'.
unpack :: OsPath -> [OsChar]
unpack = OS.unpack
-- | Pack a list of 'OsChar' to an 'OsPath'.
--
-- Note that using this in conjunction with 'unsafeFromChar' to
-- convert from @[Char]@ to 'OsPath' is probably not what
-- you want, because it will truncate unicode code points.
pack :: [OsChar] -> OsPath
pack = OS.pack
|
