Skip to content

Commit def6d63

Browse files
committed
Remove the usage of IsPath from the Path modules
1 parent 299e241 commit def6d63

File tree

5 files changed

+66
-71
lines changed

5 files changed

+66
-71
lines changed

core/src/Streamly/Internal/FileSystem/PosixPath.hs

Lines changed: 20 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -615,10 +615,10 @@ isValidPath = isJust . validatePath
615615
-- per 'validatePath'.
616616
--
617617
{-# INLINE unsafeFromArray #-}
618-
unsafeFromArray :: IsPath OS_PATH_TYPE a => Array OS_WORD_TYPE -> a
618+
unsafeFromArray :: Array OS_WORD_TYPE -> OS_PATH_TYPE
619619
unsafeFromArray =
620620
#ifndef DEBUG
621-
unsafeFromPath . OS_PATH . Common.unsafeFromArray
621+
OS_PATH . Common.unsafeFromArray
622622
#else
623623
fromJust . fromArray
624624
#endif
@@ -655,8 +655,8 @@ unsafeFromArray =
655655
-- Throws 'InvalidPath' if 'validatePath' fails on the resulting path.
656656
--
657657
#endif
658-
fromArray :: (MonadThrow m, IsPath OS_PATH_TYPE a) => Array OS_WORD_TYPE -> m a
659-
fromArray arr = Common.fromArray Common.OS_NAME arr >>= fromPath . OS_PATH
658+
fromArray :: MonadThrow m => Array OS_WORD_TYPE -> m OS_PATH_TYPE
659+
fromArray arr = OS_PATH <$> Common.fromArray Common.OS_NAME arr
660660

661661
-- XXX Should be a Fold instead?
662662

@@ -673,10 +673,9 @@ fromArray arr = Common.fromArray Common.OS_NAME arr >>= fromPath . OS_PATH
673673
-- Unicode normalization is not done. If normalization is needed the user can
674674
-- normalize it and then use the 'fromArray' API.
675675
{-# INLINE fromChars #-}
676-
fromChars :: (MonadThrow m, IsPath OS_PATH_TYPE a) => Stream Identity Char -> m a
676+
fromChars :: MonadThrow m => Stream Identity Char -> m OS_PATH_TYPE
677677
fromChars s =
678-
Common.fromChars Common.OS_NAME Unicode.UNICODE_ENCODER s
679-
>>= fromPath . OS_PATH
678+
OS_PATH <$> Common.fromChars Common.OS_NAME Unicode.UNICODE_ENCODER s
680679

681680
-- | Create an array from a path string using strict CODEC_NAME encoding. The
682681
-- path is not validated, therefore, it may not be valid according to
@@ -690,11 +689,10 @@ encodeString =
690689

691690
-- | Like 'fromString' but does not perform any validations mentioned under
692691
-- 'validatePath'. Fails only if unicode encoding fails.
693-
unsafeFromString :: IsPath OS_PATH_TYPE a => [Char] -> a
692+
unsafeFromString :: [Char] -> OS_PATH_TYPE
694693
unsafeFromString =
695694
#ifndef DEBUG
696-
unsafeFromPath
697-
. OS_PATH
695+
OS_PATH
698696
. encodeString
699697
#else
700698
fromJust . fromString
@@ -706,7 +704,7 @@ unsafeFromString =
706704
-- * Throws 'InvalidPath' if 'validatePath' fails on the path
707705
-- * Fails if the stream contains invalid unicode characters
708706
--
709-
fromString :: (MonadThrow m, IsPath OS_PATH_TYPE a) => [Char] -> m a
707+
fromString :: MonadThrow m => [Char] -> m OS_PATH_TYPE
710708
fromString = fromChars . Stream.fromList
711709

712710
-- | Like fromString but a pure and partial function that throws an
@@ -773,40 +771,34 @@ path = mkQ pathE
773771
------------------------------------------------------------------------------
774772

775773
-- | Convert the path to an array.
776-
toArray :: IsPath OS_PATH_TYPE a => a -> Array OS_WORD_TYPE
777-
toArray p = let OS_PATH arr = toPath p in arr
774+
toArray :: OS_PATH_TYPE -> Array OS_WORD_TYPE
775+
toArray (OS_PATH arr) = arr
778776

779777
-- | Decode the path to a stream of Unicode chars using strict CODEC_NAME decoding.
780778
{-# INLINE toChars #-}
781-
toChars :: (Monad m, IsPath OS_PATH_TYPE a) => a -> Stream m Char
782-
toChars p =
783-
let (OS_PATH arr) =
784-
toPath p in Common.toChars Unicode.UNICODE_DECODER arr
779+
toChars :: Monad m => OS_PATH_TYPE -> Stream m Char
780+
toChars (OS_PATH arr) = Common.toChars Unicode.UNICODE_DECODER arr
785781

786782
-- | Decode the path to a stream of Unicode chars using lax CODEC_NAME decoding.
787-
toChars_ :: (Monad m, IsPath OS_PATH_TYPE a) => a -> Stream m Char
788-
toChars_ p =
789-
let (OS_PATH arr) =
790-
toPath p in Common.toChars Unicode.UNICODE_DECODER_LAX arr
783+
toChars_ :: Monad m => OS_PATH_TYPE -> Stream m Char
784+
toChars_ (OS_PATH arr) = Common.toChars Unicode.UNICODE_DECODER_LAX arr
791785

792786
-- XXX When showing, append a "/" to dir types?
793787

794788
-- | Decode the path to a Unicode string using strict CODEC_NAME decoding.
795-
toString :: IsPath OS_PATH_TYPE a => a -> [Char]
789+
toString :: OS_PATH_TYPE -> [Char]
796790
toString = runIdentity . Stream.toList . toChars
797791

798792
-- | Decode the path to a Unicode string using lax CODEC_NAME decoding.
799-
toString_ :: IsPath OS_PATH_TYPE a => a -> [Char]
793+
toString_ :: OS_PATH_TYPE -> [Char]
800794
toString_ = runIdentity . Stream.toList . toChars_
801795

802796
-- | Show the path as raw characters without any specific decoding.
803797
--
804798
-- See also: 'readArray'.
805799
--
806-
showArray :: IsPath OS_PATH_TYPE a => a -> [Char]
807-
showArray p =
808-
let (OS_PATH arr) =
809-
toPath p in show arr
800+
showArray :: OS_PATH_TYPE -> [Char]
801+
showArray (OS_PATH arr) = show arr
810802

811803
#ifndef IS_WINDOWS
812804
#ifdef IS_PORTABLE
@@ -820,7 +812,7 @@ showArray p =
820812
--
821813
-- See also: 'showArray'.
822814
#endif
823-
readArray :: IsPath OS_PATH_TYPE a => [Char] -> a
815+
readArray :: [Char] -> OS_PATH_TYPE
824816
readArray = fromJust . fromArray . read
825817
#endif
826818

core/src/Streamly/Internal/FileSystem/PosixPath/Node.hs

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ module Streamly.Internal.FileSystem.OS_PATH.Node
4646
)
4747
where
4848

49+
import Control.Monad ((>=>))
4950
import Language.Haskell.TH (Q, Exp)
5051
import Language.Haskell.TH.Syntax (lift)
5152
import Language.Haskell.TH.Quote (QuasiQuoter)
@@ -101,21 +102,21 @@ instance IsPath OS_PATH (Dir OS_PATH) where
101102

102103
liftDir :: Dir OS_PATH -> Q Exp
103104
liftDir (Dir p) =
104-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Dir OS_PATH |]
105+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Dir OS_PATH |]
105106

106107
liftFile :: File OS_PATH -> Q Exp
107108
liftFile (File p) =
108-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: File OS_PATH |]
109+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: File OS_PATH |]
109110

110111
-- | Generates a Haskell expression of type @Dir OS_PATH@.
111112
--
112113
dirE :: String -> Q Exp
113-
dirE = either (error . show) liftDir . OsPath.fromString
114+
dirE = either (error . show) liftDir . (OsPath.fromString >=> fromPath)
114115

115116
-- | Generates a Haskell expression of type @File OS_PATH@.
116117
--
117118
fileE :: String -> Q Exp
118-
fileE = either (error . show) liftFile . OsPath.fromString
119+
fileE = either (error . show) liftFile . (OsPath.fromString >=> fromPath)
119120

120121
------------------------------------------------------------------------------
121122
-- Statically Verified Literals
@@ -128,15 +129,15 @@ fileE = either (error . show) liftFile . OsPath.fromString
128129

129130
-- | Generates a @Dir OS_PATH@ type from a quoted literal.
130131
--
131-
-- >>> Path.toString ([dir|usr|] :: Dir PosixPath)
132+
-- >>> Path.toString (Path.toPath ([dir|usr|] :: Dir PosixPath))
132133
-- "usr"
133134
--
134135
dir :: QuasiQuoter
135136
dir = mkQ dirE
136137

137138
-- | Generates a @File OS_PATH@ type from a quoted literal.
138139
--
139-
-- >>> Path.toString ([file|usr|] :: File PosixPath)
140+
-- >>> Path.toString (Path.toPath ([file|usr|] :: File PosixPath))
140141
-- "usr"
141142
--
142143
file :: QuasiQuoter
@@ -147,9 +148,9 @@ file = mkQ fileE
147148

148149
-- | Append a 'Dir' or 'File' path to a 'Dir' path.
149150
--
150-
-- >>> Path.toString (Node.join [dir|/usr|] [dir|bin|] :: Dir PosixPath)
151+
-- >>> Path.toString (Path.toPath (Node.join [dir|/usr|] [dir|bin|] :: Dir PosixPath))
151152
-- "/usr/bin"
152-
-- >>> Path.toString (Node.join [dir|/usr|] [file|bin|] :: File PosixPath)
153+
-- >>> Path.toString (Path.toPath (Node.join [dir|/usr|] [file|bin|] :: File PosixPath))
153154
-- "/usr/bin"
154155
--
155156
-- Fails if the second path is a specific location and not a path segment.

core/src/Streamly/Internal/FileSystem/PosixPath/Seg.hs

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ module Streamly.Internal.FileSystem.OS_PATH.Seg
5151
)
5252
where
5353

54+
import Control.Monad ((>=>))
5455
import Control.Monad.Catch (MonadThrow(..))
5556
import Language.Haskell.TH (Q, Exp)
5657
import Language.Haskell.TH.Syntax (lift)
@@ -110,21 +111,21 @@ instance IsSeg (Unrooted a)
110111

111112
liftRooted :: Rooted OS_PATH -> Q Exp
112113
liftRooted (Rooted p) =
113-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Rooted OS_PATH |]
114+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Rooted OS_PATH |]
114115

115-
lifUntooted :: Unrooted OS_PATH -> Q Exp
116-
lifUntooted (Unrooted p) =
117-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Unrooted OS_PATH |]
116+
liftUnrooted :: Unrooted OS_PATH -> Q Exp
117+
liftUnrooted (Unrooted p) =
118+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Unrooted OS_PATH |]
118119

119120
-- | Generates a Haskell expression of type @Rooted OS_PATH@.
120121
--
121122
rtE :: String -> Q Exp
122-
rtE = either (error . show) liftRooted . OsPath.fromString
123+
rtE = either (error . show) liftRooted . (OsPath.fromString >=> fromPath)
123124

124125
-- | Generates a Haskell expression of type @Unrooted OS_PATH@.
125126
--
126127
urE :: String -> Q Exp
127-
urE = either (error . show) lifUntooted . OsPath.fromString
128+
urE = either (error . show) liftUnrooted . (OsPath.fromString >=> fromPath)
128129

129130
------------------------------------------------------------------------------
130131
-- Statically Verified Literals
@@ -137,15 +138,15 @@ urE = either (error . show) lifUntooted . OsPath.fromString
137138

138139
-- | Generates a @Rooted Path@ type from a quoted literal.
139140
--
140-
-- >>> Path.toString ([rt|/usr|] :: Rooted PosixPath)
141+
-- >>> Path.toString (Path.toPath ([rt|/usr|] :: Rooted PosixPath))
141142
-- "/usr"
142143
--
143144
rt :: QuasiQuoter
144145
rt = mkQ rtE
145146

146147
-- | Generates a @Unrooted Path@ type from a quoted literal.
147148
--
148-
-- >>> Path.toString ([ur|usr|] :: Unrooted PosixPath)
149+
-- >>> Path.toString (Path.toPath ([ur|usr|] :: Unrooted PosixPath))
149150
-- "usr"
150151
--
151152
ur :: QuasiQuoter
@@ -156,9 +157,9 @@ ur = mkQ urE
156157

157158
-- | Append a 'Unrooted' type path to a 'Rooted' path or 'Unrooted' path.
158159
--
159-
-- >>> Path.toString (Seg.join [rt|/usr|] [ur|bin|] :: Rooted PosixPath)
160+
-- >>> Path.toString (Path.toPath (Seg.join [rt|/usr|] [ur|bin|] :: Rooted PosixPath))
160161
-- "/usr/bin"
161-
-- >>> Path.toString (Seg.join [ur|usr|] [ur|bin|] :: Unrooted PosixPath)
162+
-- >>> Path.toString (Path.toPath (Seg.join [ur|usr|] [ur|bin|] :: Unrooted PosixPath))
162163
-- "usr/bin"
163164
--
164165
{-# INLINE join #-}

core/src/Streamly/Internal/FileSystem/PosixPath/SegNode.hs

Lines changed: 25 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@ module Streamly.Internal.FileSystem.OS_PATH.SegNode
4444
)
4545
where
4646

47+
import Control.Monad ((>=>))
4748
import Language.Haskell.TH.Syntax (lift)
4849
import Streamly.Internal.FileSystem.Path.Common (mkQ)
4950
import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))
@@ -161,39 +162,39 @@ instance IsPath OS_PATH (Unrooted (Dir OS_PATH)) where
161162

162163
liftRootedDir :: Rooted (Dir OS_PATH) -> Q Exp
163164
liftRootedDir (Rooted (Dir p)) =
164-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Rooted (Dir OS_PATH)|]
165+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Rooted (Dir OS_PATH)|]
165166

166167
liftUnrootedDir :: Unrooted (Dir OS_PATH) -> Q Exp
167168
liftUnrootedDir (Unrooted (Dir p)) =
168-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Unrooted (Dir OS_PATH) |]
169+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Unrooted (Dir OS_PATH) |]
169170

170171
liftRootedFile :: Rooted (File OS_PATH) -> Q Exp
171172
liftRootedFile (Rooted (File p)) =
172-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Rooted (File OS_PATH)|]
173+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Rooted (File OS_PATH)|]
173174

174175
liftUnrootedFile :: Unrooted (File OS_PATH) -> Q Exp
175176
liftUnrootedFile (Unrooted (File p)) =
176-
[| OsPath.unsafeFromString $(lift $ OsPath.toString p) :: Unrooted (File OS_PATH)|]
177+
[| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Unrooted (File OS_PATH)|]
177178

178179
-- | Generates a Haskell expression of type @Rooted (Dir OS_PATH)@.
179180
--
180181
rtdirE :: String -> Q Exp
181-
rtdirE = either (error . show) liftRootedDir . OsPath.fromString
182+
rtdirE = either (error . show) liftRootedDir . (OsPath.fromString >=> fromPath)
182183

183184
-- | Generates a Haskell expression of type @Unrooted (Dir OS_PATH)@.
184185
--
185186
urdirE :: String -> Q Exp
186-
urdirE = either (error . show) liftUnrootedDir . OsPath.fromString
187+
urdirE = either (error . show) liftUnrootedDir . (OsPath.fromString >=> fromPath)
187188

188189
-- | Generates a Haskell expression of type @Rooted (File OS_PATH)@.
189190
--
190191
rtfileE :: String -> Q Exp
191-
rtfileE = either (error . show) liftRootedFile . OsPath.fromString
192+
rtfileE = either (error . show) liftRootedFile . (OsPath.fromString >=> fromPath)
192193

193194
-- | Generates a Haskell expression of type @Unrooted (File OS_PATH)@.
194195
--
195196
urfileE :: String -> Q Exp
196-
urfileE = either (error . show) liftUnrootedFile . OsPath.fromString
197+
urfileE = either (error . show) liftUnrootedFile . (OsPath.fromString >=> fromPath)
197198

198199
------------------------------------------------------------------------------
199200
-- Statically Verified Literals
@@ -206,31 +207,31 @@ urfileE = either (error . show) liftUnrootedFile . OsPath.fromString
206207

207208
-- | Generates a @Rooted (Dir OS_PATH)@ type from a quoted literal.
208209
--
209-
-- >>> Path.toString ([rtdir|/usr|] :: Rooted (Dir PosixPath))
210+
-- >>> Path.toString (Path.toPath ([rtdir|/usr|] :: Rooted (Dir PosixPath)))
210211
-- "/usr"
211212
--
212213
rtdir :: QuasiQuoter
213214
rtdir = mkQ rtdirE
214215

215216
-- | Generates a @Unrooted (Dir OS_PATH)@ type from a quoted literal.
216217
--
217-
-- >>> Path.toString ([urdir|usr|] :: Unrooted (Dir PosixPath))
218+
-- >>> Path.toString (Path.toPath ([urdir|usr|] :: Unrooted (Dir PosixPath)))
218219
-- "usr"
219220
--
220221
urdir :: QuasiQuoter
221222
urdir = mkQ urdirE
222223

223224
-- | Generates a @Rooted (File OS_PATH)@ type from a quoted literal.
224225
--
225-
-- >>> Path.toString ([rtfile|/x.txt|] :: Rooted (File PosixPath))
226+
-- >>> Path.toString (Path.toPath ([rtfile|/x.txt|] :: Rooted (File PosixPath)))
226227
-- "/x.txt"
227228
--
228229
rtfile :: QuasiQuoter
229230
rtfile = mkQ rtfileE
230231

231232
-- | Generates a @Unrooted (File OS_PATH)@ type from a quoted literal.
232233
--
233-
-- >>> Path.toString ([urfile|x.txt|] :: Unrooted (File PosixPath))
234+
-- >>> Path.toString (Path.toPath ([urfile|x.txt|] :: Unrooted (File PosixPath)))
234235
-- "x.txt"
235236
--
236237
urfile :: QuasiQuoter
@@ -245,26 +246,26 @@ urfile = mkQ urfileE
245246
-- If the second path does not have 'File' or 'Dir' information then the return
246247
-- type too cannot have it.
247248
--
248-
-- >> Path.toString (SegNode.join [rtdir|/usr|] [br|bin|] :: Rooted PosixPath)
249+
-- >> Path.toString (Path.toPath (SegNode.join [rtdir|/usr|] [br|bin|] :: Rooted PosixPath))
249250
-- "/usr/bin"
250-
-- >> Path.toString (SegNode.join [urdir|usr|] [br|bin|] :: Unrooted PosixPath)
251+
-- >> Path.toString (Path.toPath (SegNode.join [urdir|usr|] [br|bin|] :: Unrooted PosixPath))
251252
-- "usr/bin"
252253
--
253-
-- >> Path.toString (SegNode.join [rt|/usr|] [br|bin|] :: Rooted PosixPath)
254+
-- >> Path.toString (Path.toPath (SegNode.join [rt|/usr|] [br|bin|] :: Rooted PosixPath))
254255
-- "/usr/bin"
255-
-- >> Path.toString (SegNode.join [br|usr|] [br|bin|] :: Unrooted PosixPath)
256+
-- >> Path.toString (Path.toPath (SegNode.join [br|usr|] [br|bin|] :: Unrooted PosixPath))
256257
-- "usr/bin"
257258
--
258259
-- If the second path has 'File' or 'Dir' information then the return type
259260
-- also has it.
260261
--
261-
-- >> Path.toString (SegNode.join [rt|/usr|] [urdir|bin|] :: Rooted (Dir PosixPath))
262+
-- >> Path.toString (Path.toPath (SegNode.join [rt|/usr|] [urdir|bin|] :: Rooted (Dir PosixPath)))
262263
-- "/usr/bin"
263-
-- >> Path.toString (SegNode.join [rt|/usr|] [urfile|bin|] :: Rooted (File PosixPath))
264+
-- >> Path.toString (Path.toPath (SegNode.join [rt|/usr|] [urfile|bin|] :: Rooted (File PosixPath)))
264265
-- "/usr/bin"
265-
-- >> Path.toString (SegNode.join [br|usr|] [urdir|bin|] :: Unrooted (Dir PosixPath))
266+
-- >> Path.toString (Path.toPath (SegNode.join [br|usr|] [urdir|bin|] :: Unrooted (Dir PosixPath)))
266267
-- "usr/bin"
267-
-- >> Path.toString (SegNode.join [br|usr|] [urfile|bin|] :: Unrooted (File PosixPath))
268+
-- >> Path.toString (Path.toPath (SegNode.join [br|usr|] [urfile|bin|] :: Unrooted (File PosixPath)))
268269
-- "usr/bin"
269270
--
270271
-- Type error cases:
@@ -290,13 +291,13 @@ join a (Unrooted c) = unsafeFromPath $ OS_NAME.unsafeJoin (toPath a) (toPath c)
290291

291292
-- | Append a branch type path to a directory.
292293
--
293-
-- >>> Path.toString (SegNode.join [rtdir|/usr|] [urdir|bin|] :: Rooted (Dir PosixPath))
294+
-- >>> Path.toString (Path.toPath (SegNode.join [rtdir|/usr|] [urdir|bin|] :: Rooted (Dir PosixPath)))
294295
-- "/usr/bin"
295-
-- >>> Path.toString (SegNode.join [rtdir|/usr|] [urfile|bin|] :: Rooted (File PosixPath))
296+
-- >>> Path.toString (Path.toPath (SegNode.join [rtdir|/usr|] [urfile|bin|] :: Rooted (File PosixPath)))
296297
-- "/usr/bin"
297-
-- >>> Path.toString (SegNode.join [urdir|usr|] [urdir|bin|] :: Unrooted (Dir PosixPath))
298+
-- >>> Path.toString (Path.toPath (SegNode.join [urdir|usr|] [urdir|bin|] :: Unrooted (Dir PosixPath)))
298299
-- "usr/bin"
299-
-- >>> Path.toString (SegNode.join [urdir|usr|] [urfile|bin|] :: Unrooted (File PosixPath))
300+
-- >>> Path.toString (Path.toPath (SegNode.join [urdir|usr|] [urfile|bin|] :: Unrooted (File PosixPath)))
300301
-- "usr/bin"
301302
--
302303
{-# INLINE join #-}

0 commit comments

Comments
 (0)