1{-# LANGUAGE CPP #-}
2-- | Unlifted "System.Directory".
3--
4-- @since 0.2.6.0
5
6module UnliftIO.Directory (
7    -- * Actions on directories
8    createDirectory
9  , createDirectoryIfMissing
10  , removeDirectory
11  , removeDirectoryRecursive
12#if MIN_VERSION_directory(1,2,7)
13  , removePathForcibly
14#endif
15  , renameDirectory
16#if MIN_VERSION_directory(1,2,5)
17  , listDirectory
18#endif
19  , getDirectoryContents
20
21  -- ** Current working directory
22  , getCurrentDirectory
23  , setCurrentDirectory
24#if MIN_VERSION_directory(1,2,3)
25  , withCurrentDirectory
26#endif
27
28  -- * Pre-defined directories
29  , getHomeDirectory
30#if MIN_VERSION_directory(1,2,3)
31  , XdgDirectory(..)
32  , getXdgDirectory
33#endif
34  , getAppUserDataDirectory
35  , getUserDocumentsDirectory
36  , getTemporaryDirectory
37
38  -- * Actions on files
39  , removeFile
40  , renameFile
41#if MIN_VERSION_directory(1,2,7)
42  , renamePath
43#endif
44  , copyFile
45#if MIN_VERSION_directory(1,2,6)
46  , copyFileWithMetadata
47#endif
48  , canonicalizePath
49#if MIN_VERSION_directory(1,2,2)
50  , makeAbsolute
51#endif
52  , makeRelativeToCurrentDirectory
53  , findExecutable
54#if MIN_VERSION_directory(1,2,2)
55  , findExecutables
56#endif
57#if MIN_VERSION_directory(1,2,4)
58  , findExecutablesInDirectories
59#endif
60  , findFile
61#if MIN_VERSION_directory(1,2,1)
62  , findFiles
63#endif
64#if MIN_VERSION_directory(1,2,6)
65  , findFileWith
66#endif
67#if MIN_VERSION_directory(1,2,1)
68  , findFilesWith
69#endif
70#if MIN_VERSION_directory(1,2,4)
71  , exeExtension
72#endif
73#if MIN_VERSION_directory(1,2,7)
74  , getFileSize
75#endif
76
77  -- * Existence tests
78#if MIN_VERSION_directory(1,2,7)
79  , doesPathExist
80#endif
81  , doesFileExist
82  , doesDirectoryExist
83
84#if MIN_VERSION_directory(1,3,0)
85  -- * Symbolic links
86  , pathIsSymbolicLink
87#endif
88
89  -- * Permissions
90  , Permissions
91  , emptyPermissions
92  , readable
93  , writable
94  , executable
95  , searchable
96  , setOwnerReadable
97  , setOwnerWritable
98  , setOwnerExecutable
99  , setOwnerSearchable
100  , getPermissions
101  , setPermissions
102  , copyPermissions
103
104  -- * Timestamps
105#if MIN_VERSION_directory(1,2,3)
106  , getAccessTime
107#endif
108  , getModificationTime
109#if MIN_VERSION_directory(1,2,3)
110  , setAccessTime
111  , setModificationTime
112#endif
113  ) where
114
115import Control.Monad.IO.Unlift
116import Data.Time.Clock
117import qualified System.Directory as D
118import System.Directory
119  ( Permissions
120#if MIN_VERSION_directory(1,2,3)
121  , XdgDirectory(..)
122#endif
123  , emptyPermissions
124#if MIN_VERSION_directory(1,2,4)
125  , exeExtension
126#endif
127  , executable
128  , readable
129  , searchable
130  , setOwnerExecutable
131  , setOwnerReadable
132  , setOwnerSearchable
133  , setOwnerWritable
134  , writable
135  )
136
137-- | Lifted 'D.createDirectory'.
138--
139-- @since 0.2.6.0
140{-# INLINE createDirectory #-}
141createDirectory :: MonadIO m => FilePath -> m ()
142createDirectory = liftIO . D.createDirectory
143
144-- | Lifted 'D.createDirectoryIfMissing'.
145--
146-- @since 0.2.6.0
147{-# INLINE createDirectoryIfMissing #-}
148createDirectoryIfMissing :: MonadIO m => Bool -> FilePath -> m ()
149createDirectoryIfMissing create_parents path0 =
150  liftIO (D.createDirectoryIfMissing create_parents path0)
151
152-- | Lifted 'D.removeDirectory'.
153--
154-- @since 0.2.6.0
155{-# INLINE removeDirectory #-}
156removeDirectory :: MonadIO m => FilePath -> m ()
157removeDirectory = liftIO . D.removeDirectory
158
159-- | Lifted 'D.removeDirectoryRecursive'.
160--
161-- @since 0.2.6.0
162{-# INLINE removeDirectoryRecursive #-}
163removeDirectoryRecursive :: MonadIO m => FilePath -> m ()
164removeDirectoryRecursive = liftIO . D.removeDirectoryRecursive
165
166#if MIN_VERSION_directory(1,2,7)
167-- | Lifted 'D.removePathForcibly'.
168--
169-- @since 0.2.6.0
170{-# INLINE removePathForcibly #-}
171removePathForcibly :: MonadIO m => FilePath -> m ()
172removePathForcibly = liftIO . D.removePathForcibly
173#endif
174
175-- | Lifted 'D.renameDirectory'.
176--
177-- @since 0.2.6.0
178{-# INLINE renameDirectory #-}
179renameDirectory :: MonadIO m => FilePath -> FilePath -> m ()
180renameDirectory opath npath = liftIO (D.renameDirectory opath npath)
181
182#if MIN_VERSION_directory(1,2,5)
183-- | Lifted 'D.listDirectory'.
184--
185-- @since 0.2.6.0
186{-# INLINE listDirectory #-}
187listDirectory :: MonadIO m => FilePath -> m [FilePath]
188listDirectory = liftIO . D.listDirectory
189#endif
190
191-- | Lifted 'D.getDirectoryContents'.
192--
193-- @since 0.2.6.0
194{-# INLINE getDirectoryContents #-}
195getDirectoryContents :: MonadIO m => FilePath -> m [FilePath]
196getDirectoryContents = liftIO . D.getDirectoryContents
197
198-- | Lifted 'D.getCurrentDirectory'.
199--
200-- @since 0.2.6.0
201{-# INLINE getCurrentDirectory #-}
202getCurrentDirectory :: MonadIO m => m FilePath
203getCurrentDirectory = liftIO D.getCurrentDirectory
204
205-- | Lifted 'D.setCurrentDirectory'.
206--
207-- @since 0.2.6.0
208{-# INLINE setCurrentDirectory #-}
209setCurrentDirectory :: MonadIO m => FilePath -> m ()
210setCurrentDirectory = liftIO . D.setCurrentDirectory
211
212#if MIN_VERSION_directory(1,2,3)
213-- | Unlifted 'D.withCurrentDirectory'.
214--
215-- @since 0.2.6.0
216{-# INLINE withCurrentDirectory #-}
217withCurrentDirectory :: MonadUnliftIO m => FilePath -> m a -> m a
218withCurrentDirectory dir action =
219  withRunInIO (\u -> D.withCurrentDirectory dir (u action))
220#endif
221
222-- | Lifted 'D.getHomeDirectory'.
223--
224-- @since 0.2.6.0
225{-# INLINE getHomeDirectory #-}
226getHomeDirectory :: MonadIO m => m FilePath
227getHomeDirectory = liftIO D.getHomeDirectory
228
229#if MIN_VERSION_directory(1,2,3)
230-- | Lifted 'D.getXdgDirectory'.
231--
232-- @since 0.2.6.0
233{-# INLINE getXdgDirectory #-}
234getXdgDirectory :: MonadIO m => XdgDirectory -> FilePath -> m FilePath
235getXdgDirectory xdgDir suffix = liftIO (D.getXdgDirectory xdgDir suffix)
236#endif
237
238-- | Lifted 'D.getAppUserDataDirectory'.
239--
240-- @since 0.2.6.0
241{-# INLINE getAppUserDataDirectory #-}
242getAppUserDataDirectory :: MonadIO m => FilePath -> m FilePath
243getAppUserDataDirectory = liftIO . D.getAppUserDataDirectory
244
245-- | Lifted 'D.getUserDocumentsDirectory'.
246--
247-- @since 0.2.6.0
248{-# INLINE getUserDocumentsDirectory #-}
249getUserDocumentsDirectory :: MonadIO m => m FilePath
250getUserDocumentsDirectory = liftIO D.getUserDocumentsDirectory
251
252-- | Lifted 'D.getTemporaryDirectory'.
253--
254-- @since 0.2.6.0
255{-# INLINE getTemporaryDirectory #-}
256getTemporaryDirectory :: MonadIO m => m FilePath
257getTemporaryDirectory = liftIO D.getTemporaryDirectory
258
259-- | Lifted 'D.removeFile'.
260--
261-- @since 0.2.6.0
262{-# INLINE removeFile #-}
263removeFile :: MonadIO m => FilePath -> m ()
264removeFile = liftIO . D.removeFile
265
266-- | Lifted 'D.renameFile'.
267--
268-- @since 0.2.6.0
269{-# INLINE renameFile #-}
270renameFile :: MonadIO m => FilePath -> FilePath -> m ()
271renameFile opath npath = liftIO (D.renameFile opath npath)
272
273#if MIN_VERSION_directory(1,2,7)
274-- | Lifted 'D.renamePath'.
275--
276-- @since 0.2.6.0
277{-# INLINE renamePath #-}
278renamePath :: MonadIO m => FilePath -> FilePath -> m ()
279renamePath opath npath = liftIO (D.renamePath opath npath)
280#endif
281
282-- | Lifted 'D.copyFile'.
283--
284-- @since 0.2.6.0
285{-# INLINE copyFile #-}
286copyFile :: MonadIO m => FilePath -> FilePath -> m ()
287copyFile fromFPath toFPath = liftIO (D.copyFile fromFPath toFPath)
288
289#if MIN_VERSION_directory(1,2,6)
290-- | Lifted 'D.copyFileWithMetadata'.
291--
292-- @since 0.2.6.0
293{-# INLINE copyFileWithMetadata #-}
294copyFileWithMetadata :: MonadIO m => FilePath -> FilePath -> m ()
295copyFileWithMetadata src dst = liftIO (D.copyFileWithMetadata src dst)
296#endif
297
298-- | Lifted 'D.canonicalizePath'.
299--
300-- @since 0.2.6.0
301{-# INLINE canonicalizePath #-}
302canonicalizePath :: MonadIO m => FilePath -> m FilePath
303canonicalizePath = liftIO . D.canonicalizePath
304
305#if MIN_VERSION_directory(1,2,2)
306-- | Lifted 'D.makeAbsolute'.
307--
308-- @since 0.2.6.0
309{-# INLINE makeAbsolute #-}
310makeAbsolute :: MonadIO m => FilePath -> m FilePath
311makeAbsolute = liftIO . D.makeAbsolute
312#endif
313
314-- | Lifted 'D.makeRelativeToCurrentDirectory'.
315--
316-- @since 0.2.6.0
317{-# INLINE makeRelativeToCurrentDirectory #-}
318makeRelativeToCurrentDirectory :: MonadIO m => FilePath -> m FilePath
319makeRelativeToCurrentDirectory = liftIO . D.makeRelativeToCurrentDirectory
320
321-- | Lifted 'D.findExecutable'.
322--
323-- @since 0.2.6.0
324{-# INLINE findExecutable #-}
325findExecutable :: MonadIO m => String -> m (Maybe FilePath)
326findExecutable = liftIO . D.findExecutable
327
328#if MIN_VERSION_directory(1,2,2)
329-- | Lifted 'D.findExecutables'.
330--
331-- @since 0.2.6.0
332{-# INLINE findExecutables #-}
333findExecutables :: MonadIO m => String -> m [FilePath]
334findExecutables = liftIO . D.findExecutables
335#endif
336
337#if MIN_VERSION_directory(1,2,4)
338-- | Lifted 'D.findExecutablesInDirectories'.
339--
340-- @since 0.2.6.0
341{-# INLINE findExecutablesInDirectories #-}
342findExecutablesInDirectories ::
343     MonadIO m => [FilePath] -> String -> m [FilePath]
344findExecutablesInDirectories path binary =
345  liftIO (D.findExecutablesInDirectories path binary)
346#endif
347
348-- | Lifted 'D.findFile'.
349--
350-- @since 0.2.6.0
351{-# INLINE findFile #-}
352findFile :: MonadIO m => [FilePath] -> String -> m (Maybe FilePath)
353findFile ds name = liftIO (D.findFile ds name)
354
355#if MIN_VERSION_directory(1,2,1)
356-- | Lifted 'D.findFiles'.
357--
358-- @since 0.2.6.0
359{-# INLINE findFiles #-}
360findFiles :: MonadIO m => [FilePath] -> String -> m [FilePath]
361findFiles ds name = liftIO (D.findFiles ds name)
362#endif
363
364#if MIN_VERSION_directory(1,2,6)
365-- | Unlifted 'D.findFileWith'.
366--
367-- @since 0.2.6.0
368{-# INLINE findFileWith #-}
369findFileWith ::
370     MonadUnliftIO m
371  => (FilePath -> m Bool)
372  -> [FilePath]
373  -> String
374  -> m (Maybe FilePath)
375findFileWith f ds name = withRunInIO (\u -> D.findFileWith (u . f) ds name)
376#endif
377
378#if MIN_VERSION_directory(1,2,1)
379-- | Unlifted 'D.findFilesWith'.
380--
381-- @since 0.2.6.0
382{-# INLINE findFilesWith #-}
383findFilesWith ::
384     MonadUnliftIO m
385  => (FilePath -> m Bool)
386  -> [FilePath]
387  -> String
388  -> m [FilePath]
389findFilesWith f ds name = withRunInIO (\u -> D.findFilesWith (u . f) ds name)
390#endif
391
392#if MIN_VERSION_directory(1,2,7)
393-- | Lifted 'D.getFileSize'.
394--
395-- @since 0.2.6.0
396{-# INLINE getFileSize #-}
397getFileSize :: MonadIO m => FilePath -> m Integer
398getFileSize = liftIO . D.getFileSize
399#endif
400
401#if MIN_VERSION_directory(1,2,7)
402-- | Lifted 'D.doesPathExist'.
403--
404-- @since 0.2.6.0
405{-# INLINE doesPathExist #-}
406doesPathExist :: MonadIO m => FilePath -> m Bool
407doesPathExist = liftIO . D.doesPathExist
408#endif
409
410-- | Lifted 'D.doesFileExist'.
411--
412-- @since 0.2.6.0
413{-# INLINE doesFileExist #-}
414doesFileExist :: MonadIO m => FilePath -> m Bool
415doesFileExist = liftIO . D.doesFileExist
416
417-- | Lifted 'D.doesDirectoryExist'.
418--
419-- @since 0.2.6.0
420{-# INLINE doesDirectoryExist #-}
421doesDirectoryExist :: MonadIO m => FilePath -> m Bool
422doesDirectoryExist = liftIO . D.doesDirectoryExist
423
424#if MIN_VERSION_directory(1,3,0)
425-- | Lifted 'D.pathIsSymbolicLink'.
426--
427-- @since 0.2.6.0
428{-# INLINE pathIsSymbolicLink #-}
429pathIsSymbolicLink :: MonadIO m => FilePath -> m Bool
430pathIsSymbolicLink = liftIO . D.pathIsSymbolicLink
431#endif
432
433-- | Lifted 'D.getPermissions'.
434--
435-- @since 0.2.6.0
436{-# INLINE getPermissions #-}
437getPermissions :: MonadIO m => FilePath -> m Permissions
438getPermissions = liftIO . D.getPermissions
439
440-- | Lifted 'D.setPermissions'.
441--
442-- @since 0.2.6.0
443{-# INLINE setPermissions #-}
444setPermissions :: MonadIO m => FilePath -> Permissions -> m ()
445setPermissions name p = liftIO (D.setPermissions name p)
446
447-- | Lifted 'D.copyPermissions'.
448--
449-- @since 0.2.6.0
450{-# INLINE copyPermissions #-}
451copyPermissions :: MonadIO m => FilePath -> FilePath -> m ()
452copyPermissions source dest = liftIO (D.copyPermissions source dest)
453
454#if MIN_VERSION_directory(1,2,3)
455-- | Lifted 'D.getAccessTime'.
456--
457-- @since 0.2.6.0
458{-# INLINE getAccessTime #-}
459getAccessTime :: MonadIO m => FilePath -> m UTCTime
460getAccessTime = liftIO . D.getAccessTime
461#endif
462
463-- | Lifted 'D.getModificationTime'.
464--
465-- @since 0.2.6.0
466{-# INLINE getModificationTime #-}
467getModificationTime :: MonadIO m => FilePath -> m UTCTime
468getModificationTime = liftIO . D.getModificationTime
469
470#if MIN_VERSION_directory(1,2,3)
471-- | Lifted 'D.setAccessTime'.
472--
473-- @since 0.2.6.0
474{-# INLINE setAccessTime #-}
475setAccessTime :: MonadIO m => FilePath -> UTCTime -> m ()
476setAccessTime path atime = liftIO (D.setAccessTime path atime)
477
478-- | Lifted 'D.setModificationTime'.
479--
480-- @since 0.2.6.0
481setModificationTime :: MonadIO m => FilePath -> UTCTime -> m ()
482setModificationTime path mtime = liftIO (D.setModificationTime path mtime)
483#endif
484