FileCollection.icl 7.24 KB
Newer Older
1 2 3 4 5 6 7
implementation module iTasks.Extensions.FileCollection
/**
* This extension provides a set of SDS functions to map
* somewhat complex data structures to a directory tree structure with very simple
* plain text files on disk.
*/
import iTasks
8 9
import iTasks.Internal.Util

10 11 12
import StdFile
from Data.Map import :: Map
import qualified Data.Map as DM
13
import Data.Map.GenJSON
14
import Data.Error, Data.Functor, Data.Func, Data.Maybe, Text
15
import System.Directory, System.File, System.FilePath, System.OS
16 17 18

derive class iTask FileCollectionItem

19 20
EXCLUDE_FILE :== "exclude.txt"

21 22
//Writes a map of key/value pairs to a directory with one file per key/value
//It will ignore all files in the directory that don't match the filter
Haye Böhm's avatar
Fix CI  
Haye Böhm committed
23
fileCollection :: FileFilter Bool -> SDSSource FilePath FileCollection FileCollection
24
fileCollection isFileInCollection deleteRemovedFiles = worldShare (read isFileInCollection) (write isFileInCollection) notify
25 26
where
	read isFileInCollection dir world = case readDirectory dir world of
27 28
		(Error (2,msg),world) = (Ok 'DM'.newMap,world) //Directory does not exist yet
		(Error (errNo,msg),world) = (Error msg,world)
29
		(Ok files,world) = case (if deleteRemovedFiles (Ok [],world) (readExcludeList dir world)) of 
30
			(Error e, world) = (Error e,world)
31 32 33
			(Ok excludes,world) = case readFiles isFileInCollection excludes dir files world of
				(Error e, world) = (Error e,world)
				(Ok collection,world) = (Ok ('DM'.fromList collection), world)
34
	
35 36 37
	readFiles isFileInCollection excludes dir [] world = (Ok [],world)
	readFiles isFileIncollection excludes dir [f:fs] world
		| f == "." || f == ".." || (not deleteRemovedFiles && isMember f excludes) = readFiles isFileInCollection excludes dir fs world 
38 39 40 41 42
		| otherwise = case getFileInfo (dir </> f) world of
			(Error (_,msg),world) = (Error msg,world)
			(Ok {FileInfo|directory},world) 
				//Skip files that don't match the filter
				| not (isFileInCollection f directory)
43
					= readFiles isFileInCollection excludes dir fs world 
44 45 46
				//Read a subcollection
				| directory = case read (\x -> isFileInCollection (f </> x)) (dir </> f) world of 
					(Error e,world) = (Error e,world)
47
					(Ok fcollection,world) = case readFiles isFileInCollection excludes dir fs world of
48 49 50 51 52
						(Error e,world) = (Error e,world)
						(Ok collection,world) = (Ok [(f,FileCollection fcollection):collection], world)
				//Read the file content
				| otherwise = case readFile (dir </> f) world of
                    (Error e,world) = (Error (toString e),world)
53
					(Ok fcontent,world) = case readFiles isFileInCollection excludes dir fs world of
54 55 56
						(Error e,world) = (Error e,world)
						(Ok collection,world) = (Ok [(f,FileContent fcontent):collection], world)

57 58 59 60 61
	readExcludeList dir world = case readFileLines (dir </> EXCLUDE_FILE) world of
		(Ok lines,world)         = (Ok [EXCLUDE_FILE:lines],world) //the exclude file itself should also be excluded
		(Error CannotOpen,world) = (Ok [EXCLUDE_FILE],world)
		(Error e,world)          = (Error (toString e),world)

62 63 64 65
	write isFileInCollection dir collection world = case readDirectory dir world of 
		//We need to know the current content of the directory to be able to delete removed entries
		(Ok curfiles,world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of
			(Error e,world) = (Error e,world)
66
			(Ok newfiles,world) = cleanupRemovedFiles curfiles newfiles dir world
67 68 69 70 71 72 73
		//The direcrory does not exist yet, create it first and then write the collection
		(Error (2,_),world) = case ensureDirectory dir world of
			(Error e,world) = (Error e,world)
			(Ok (),world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of
				(Error e,world) = (Error e,world)
				(Ok newfiles,world) = cleanupRemovedFiles [] newfiles dir world
		(Error (_,msg),world) = (Error msg,world)
74 75 76 77 78 79 80 81 82 83 84 85
		
	writeFiles [] isFileInCollection dir world = (Ok [],world)
	writeFiles [(name,FileContent content):fs] isFileInCollection dir world
		| not (isFileInCollection name False) = writeFiles fs isFileInCollection dir world //Don't write files that don't match the filter
		| otherwise = case writeFile (dir </> name) content world of
			(Error e,world) = (Error (toString e),world)	
			(Ok (),world) = case writeFiles fs isFileInCollection dir world of
				(Error e,world) = (Error e,world)
				(Ok curfiles,world) = (Ok [name:curfiles],world)

	writeFiles [(name,FileCollection collection):fs] isFileInCollection dir world 
		| not (isFileInCollection name True) = writeFiles fs isFileInCollection dir world //Don't write files that don't match the filter
86
		| otherwise = case ensureDirectory (dir </> name) world of
87
			(Error e,world) = (Error e,world)
88
			(Ok (),world) = case write (\x -> isFileInCollection (name </> x)) (dir </> name) collection world  of
89
				(Error e,world) = (Error e,world)
90 91 92 93 94 95 96 97 98 99 100 101
				(Ok (),world) = case writeFiles fs isFileInCollection dir world of
					(Error e,world) = (Error e,world)
					(Ok curfiles,world) = (Ok [name:curfiles],world)
			
	ensureDirectory path world = case getFileInfo path world of
		(Ok {FileInfo|directory},world) 
			| directory = (Ok (),world)
			| otherwise = (Error ("Can't create directory " +++ path), world)
		(Error _, world)
			= case createDirectory path world of	
				(Ok (),world) = (Ok (),world)
				(Error (_,msg),world) = (Error msg,world)
102 103 104 105

	//Check if files that existed before, are not in the newly written set.
	//If they match the filter they 'belong' to the collection and should be removed.
	//Otherwise they will be included on the next read of the collection
106 107 108 109 110 111 112 113 114 115 116 117 118 119
	cleanupRemovedFiles filesInDirectory filesInCollection dir world
		| deleteRemovedFiles = deleteFiles filesToRemove dir world
		| otherwise          = excludeFiles filesToRemove dir world
	where
		filesToRemove = [f \\ f <- filesInDirectory | f <> "." && f <> ".." && f <> EXCLUDE_FILE && not (isMember f filesInCollection)]

		excludeFiles files dir world = case writeFile (dir </> EXCLUDE_FILE) (join OS_NEWLINE files) world of
			(Error e, world) = (Error (toString e),world)
			(Ok (),world)    = (Ok (),world)

		deleteFiles [] dir world = (Ok (),world) 
		deleteFiles [f:fs] dir world = case recursiveDelete (dir </> f) world of
			(Ok (),world) = deleteFiles fs dir world
			(Error (_,msg),world) = (Error msg,world)
120

121 122 123
	notify writeParameter _ registeredParameter
		= startsWith writeParameter registeredParameter || startsWith registeredParameter writeParameter

124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
getStringContent :: String FileCollection -> Maybe String
getStringContent key collection = case 'DM'.get key collection of
	(Just (FileContent content)) = Just content
	_							 = Nothing

setStringContent:: String String FileCollection -> FileCollection
setStringContent key value collection = 'DM'.put key (FileContent value) collection

getIntContent :: String FileCollection -> Maybe Int
getIntContent key collection = fmap (toInt o trim) (getStringContent key collection)

setIntContent :: String Int FileCollection -> FileCollection
setIntContent key value collection = 'DM'.put key (FileContent (toString value)) collection

toPaths :: FileCollection -> [FilePath]
toPaths collection = flatten (map toPath ('DM'.toList collection)) 
where
	toPath (name,FileContent _) = [name]
	toPath (name,FileCollection collection) = [name:[name </> path \\ path <- toPaths collection]]

144 145 146
ignoreHiddenFiles :: FileFilter
ignoreHiddenFiles = \path isDir -> not (startsWith "." $ dropDirectory path)