Commit 515a7ffe authored by Steffen Michels's avatar Steffen Michels

Merge branch 'add-notification-world-sds' into 'master'

Added notification predicate to  SDS sources. This was needed to make...

See merge request clean-and-itasks/iTasks-SDK!285
parents 5df5a322 aad74b43
Pipeline #26134 passed with stage
in 5 minutes and 10 seconds
......@@ -12,13 +12,14 @@ where
toString Icl = ".icl"
moduleList :: SDSSource FilePath [(ModuleName,ModuleType)] ()
moduleList = worldShare read write
moduleList = worldShare read write notify
where
read path world = case scanPaths [path] world of
(Ok paths,world) = (Ok (determineModules path paths), world)
(Error e,world) = (Error (snd e), world)
write path () world = (Ok (),world)
notify p1 _ p2 = p1 == p2
scanPaths [] world = (Ok [],world)
scanPaths [p:ps] world = case getFileInfo p world of
......
......@@ -35,3 +35,6 @@ getIntContent :: String FileCollection -> Maybe Int
setIntContent :: String Int FileCollection -> FileCollection
toPaths :: FileCollection -> [FilePath]
//Filter to ignore all hidden files (e.g. starting with a '.')
ignoreHiddenFiles :: FileFilter
......@@ -11,7 +11,7 @@ import StdFile
from Data.Map import :: Map
import qualified Data.Map as DM
import Data.Map.GenJSON
import Data.Error, Data.Functor, Data.Maybe, Text
import Data.Error, Data.Functor, Data.Func, Data.Maybe, Text
import System.Directory, System.File, System.FilePath, System.OS
derive class iTask FileCollectionItem
......@@ -21,10 +21,11 @@ EXCLUDE_FILE :== "exclude.txt"
//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
fileCollection :: FileFilter Bool -> SDSSource FilePath FileCollection FileCollection
fileCollection isFileInCollection deleteRemovedFiles = worldShare (read isFileInCollection) (write isFileInCollection)
fileCollection isFileInCollection deleteRemovedFiles = worldShare (read isFileInCollection) (write isFileInCollection) notify
where
read isFileInCollection dir world = case readDirectory dir world of
(Error (_,msg),world) = (Error msg,world)
(Error (2,msg),world) = (Ok 'DM'.newMap,world) //Directory does not exist yet
(Error (errNo,msg),world) = (Error msg,world)
(Ok files,world) = case (if deleteRemovedFiles (Ok [],world) (readExcludeList dir world)) of
(Error e, world) = (Error e,world)
(Ok excludes,world) = case readFiles isFileInCollection excludes dir files world of
......@@ -60,10 +61,16 @@ where
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
(Error (_,msg),world) = (Error msg,world)
(Ok curfiles,world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of
(Error e,world) = (Error e,world)
(Ok newfiles,world) = cleanupRemovedFiles curfiles newfiles dir world
//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)
writeFiles [] isFileInCollection dir world = (Ok [],world)
writeFiles [(name,FileContent content):fs] isFileInCollection dir world
......@@ -111,6 +118,9 @@ where
(Ok (),world) = deleteFiles fs dir world
(Error (_,msg),world) = (Error msg,world)
notify writeParameter _ registeredParameter
= startsWith writeParameter registeredParameter || startsWith registeredParameter writeParameter
getStringContent :: String FileCollection -> Maybe String
getStringContent key collection = case 'DM'.get key collection of
(Just (FileContent content)) = Just content
......@@ -131,3 +141,6 @@ where
toPath (name,FileContent _) = [name]
toPath (name,FileCollection collection) = [name:[name </> path \\ path <- toPaths collection]]
ignoreHiddenFiles :: FileFilter
ignoreHiddenFiles = \path isDir -> not (startsWith "." $ dropDirectory path)
......@@ -24,7 +24,7 @@ randomInt :: SDSSource () Int ()
randomString :: SDSSource Int String ()
// world function share
worldShare :: (p *World -> *(MaybeErrorString r,*World)) (p w *World -> *(MaybeErrorString (),*World)) -> SDSSource p r w
worldShare :: (p *World -> *(MaybeErrorString r,*World)) (p w *World -> *(MaybeErrorString (),*World)) (p Timespec p -> Bool) -> SDSSource p r w
// memory share (essentially a global variable)
memoryShare :: SDSSource String (Maybe a) (Maybe a) | TC a
......
......@@ -22,15 +22,15 @@ nullShare = createReadWriteSDS "_core_" "nullShare" (\_ env -> (Ok (), env)) (\_
unitShare :: SimpleSDSSource ()
unitShare = nullShare
worldShare :: (p *World -> *(MaybeErrorString r,*World)) (p w *World -> *(MaybeErrorString (),*World)) -> SDSSource p r w
worldShare read write = createReadWriteSDS "_core_" "worldShare" read` write`
worldShare :: (p *World -> *(MaybeErrorString r,*World)) (p w *World -> *(MaybeErrorString (),*World)) (p Timespec p -> Bool) -> SDSSource p r w
worldShare read write notify = createReadWriteSDS "_core_" "worldShare" read` write`
where
read` p iworld=:{IWorld|world} = case read p world of
(Ok r,world) = (Ok r, {IWorld|iworld & world = world})
(Error e,world) = (Error (exception e), {IWorld|iworld & world = world})
write` p w iworld=:{IWorld|world} = case write p w world of
(Ok (),world) = (Ok (const (const False)), {IWorld|iworld & world = world})
(Ok (),world) = (Ok (notify p), {IWorld|iworld & world = world})
(Error e,world) = (Error (exception e), {IWorld|iworld & world = world})
// Random source
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment