Directory.icl 2.99 KB
Newer Older
1 2
implementation module System.Directory

Mart Lubbers's avatar
Mart Lubbers committed
3
import StdEnv
4 5

import Data.Error
6 7 8
import Data.Func
import Data.Functor
import Data.List
Mart Lubbers's avatar
Mart Lubbers committed
9
import Data.Maybe
10 11 12 13
import Data.Tree
import Data.Tuple
import Control.Monad
import qualified System._Directory
14 15 16
import System.File
import System.FilePath

Camil Staps's avatar
Camil Staps committed
17 18 19 20 21 22 23 24 25 26 27
ensureDirectoryExists :: !FilePath !*World -> (!MaybeOSError (), !*World)
ensureDirectoryExists fp w
# (err,w) = case takeDirectory fp of
	""     -> (Ok (), w)
	parent -> ensureDirectoryExists parent w
| isError err = (err,w)
# (exi,w) = fileExists fp w
| exi
	= (Ok (), w)
	= createDirectory fp w

Camil Staps's avatar
Camil Staps committed
28 29 30 31 32 33 34 35 36 37 38 39 40 41
recursiveDelete :: !FilePath !*World -> *(!MaybeOSError (), !*World)
recursiveDelete fp w
	# (mfi, w) = getFileInfo fp w
	| isError mfi = (liftError mfi, w)
	| (fromOk mfi).directory
		# (mdir, w) = readDirectory fp w
		| isError mdir = (liftError mdir, w)
		# (merr, w) = mapSt (\c->recursiveDelete (fp </> c))
			(filter (\r->r <> "." && r <> "..") (fromOk mdir)) w
		# merr = sequence merr
		| isError merr = (liftError merr, w)
		= removeDirectory fp w
	= deleteFile fp w

42 43
scanDirectory ::
	!(FilePath FileInfo .st -> *(*World -> *(.st, *World))) !.st !FilePath !*World -> *(![OSError], !.st, !*World)
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
scanDirectory upd st dir w = scan dir [] st w
where
	scan dir errs st w
	# (fi,w) = getFileInfo dir w
	# (errs,st,w) = case fi of
		Error e -> ([e:errs], st, w)
		Ok fi   -> (\(st,w) -> (errs,st,w)) $ upd dir fi st w
	| isError fi = (errs, st, w)
	# fi = fromOk fi
	| not fi.directory = (errs, st, w)
	# (contents,w) = readDirectory dir w
	| isError contents = ([fromError contents:errs], st, w)
	# contents = [dir </> fp \\ fp <- fromOk contents | fp <> "." && fp <> ".."]
	= seqSt3 scan contents errs st w

	seqSt3 f [] s1 s2 s3 = (s1, s2, s3)
	seqSt3 f [x:xs] s1 s2 s3
	# (s1,s2,s3) = f x s1 s2 s3
	= seqSt3 f xs s1 s2 s3
63

64 65
readDirectoryTree :: !FilePath !(Maybe Int) !*World -> *(RTree (FilePath, MaybeOSError FileInfo), !*World)
readDirectoryTree fp md w = scan (maybe -1 id md) fp "" w
66
where
Mart Lubbers's avatar
Mart Lubbers committed
67
	scan md acc fp w
68
	# fp = if (size fp==0) acc (acc </> fp)
69 70
	# (mfi, w) = getFileInfo fp w
	| isError mfi = (RNode (fp, liftError mfi) [], w)
Mart Lubbers's avatar
Mart Lubbers committed
71
	| md == 0 = (RNode (fp, mfi) [], w)
72 73 74 75
	# (Ok fi) = mfi
	| not fi.directory = (RNode (fp, mfi) [], w)
	# (mcs, w) = readDirectory fp w
	| isError mfi = (RNode (fp, liftError mcs) [], w)
Mart Lubbers's avatar
Mart Lubbers committed
76
	# (cs, w) = mapSt (scan (dec md) fp) (filter (\c->not (elem c [".", ".."])) (fromOk mcs)) w
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
	= (RNode (fp, Ok fi) cs, w)

createDirectory :: !FilePath !*w -> (!MaybeOSError (), !*w)
createDirectory f w = 'System._Directory'.createDirectory f w

removeDirectory :: !FilePath !*w -> (!MaybeOSError (), !*w)
removeDirectory f w = 'System._Directory'.removeDirectory f w

readDirectory :: !FilePath !*w -> (!MaybeOSError [FilePath], !*w)
readDirectory f w = 'System._Directory'.readDirectory f w

getCurrentDirectory :: !*w -> (!MaybeOSError FilePath, !*w)
getCurrentDirectory w = 'System._Directory'.getCurrentDirectory w

setCurrentDirectory :: !FilePath !*w -> (!MaybeOSError (), !*w)
setCurrentDirectory f w = 'System._Directory'.setCurrentDirectory f w