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