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 ...@@ -12,13 +12,14 @@ where
toString Icl = ".icl" toString Icl = ".icl"
moduleList :: SDSSource FilePath [(ModuleName,ModuleType)] () moduleList :: SDSSource FilePath [(ModuleName,ModuleType)] ()
moduleList = worldShare read write moduleList = worldShare read write notify
where where
read path world = case scanPaths [path] world of read path world = case scanPaths [path] world of
(Ok paths,world) = (Ok (determineModules path paths), world) (Ok paths,world) = (Ok (determineModules path paths), world)
(Error e,world) = (Error (snd e), world) (Error e,world) = (Error (snd e), world)
write path () world = (Ok (),world) write path () world = (Ok (),world)
notify p1 _ p2 = p1 == p2
scanPaths [] world = (Ok [],world) scanPaths [] world = (Ok [],world)
scanPaths [p:ps] world = case getFileInfo p world of scanPaths [p:ps] world = case getFileInfo p world of
......
...@@ -35,3 +35,6 @@ getIntContent :: String FileCollection -> Maybe Int ...@@ -35,3 +35,6 @@ getIntContent :: String FileCollection -> Maybe Int
setIntContent :: String Int FileCollection -> FileCollection setIntContent :: String Int FileCollection -> FileCollection
toPaths :: FileCollection -> [FilePath] toPaths :: FileCollection -> [FilePath]
//Filter to ignore all hidden files (e.g. starting with a '.')
ignoreHiddenFiles :: FileFilter
...@@ -11,7 +11,7 @@ import StdFile ...@@ -11,7 +11,7 @@ import StdFile
from Data.Map import :: Map from Data.Map import :: Map
import qualified Data.Map as DM import qualified Data.Map as DM
import Data.Map.GenJSON 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 import System.Directory, System.File, System.FilePath, System.OS
derive class iTask FileCollectionItem derive class iTask FileCollectionItem
...@@ -21,10 +21,11 @@ EXCLUDE_FILE :== "exclude.txt" ...@@ -21,10 +21,11 @@ EXCLUDE_FILE :== "exclude.txt"
//Writes a map of key/value pairs to a directory with one file per key/value //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 //It will ignore all files in the directory that don't match the filter
fileCollection :: FileFilter Bool -> SDSSource FilePath FileCollection FileCollection 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 where
read isFileInCollection dir world = case readDirectory dir world of 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 (Ok files,world) = case (if deleteRemovedFiles (Ok [],world) (readExcludeList dir world)) of
(Error e, world) = (Error e,world) (Error e, world) = (Error e,world)
(Ok excludes,world) = case readFiles isFileInCollection excludes dir files world of (Ok excludes,world) = case readFiles isFileInCollection excludes dir files world of
...@@ -60,10 +61,16 @@ where ...@@ -60,10 +61,16 @@ where
write isFileInCollection dir collection world = case readDirectory dir world of 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 //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 (Ok curfiles,world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
(Ok newfiles,world) = cleanupRemovedFiles curfiles newfiles dir 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 [] isFileInCollection dir world = (Ok [],world)
writeFiles [(name,FileContent content):fs] isFileInCollection dir world writeFiles [(name,FileContent content):fs] isFileInCollection dir world
...@@ -111,6 +118,9 @@ where ...@@ -111,6 +118,9 @@ where
(Ok (),world) = deleteFiles fs dir world (Ok (),world) = deleteFiles fs dir world
(Error (_,msg),world) = (Error msg,world) (Error (_,msg),world) = (Error msg,world)
notify writeParameter _ registeredParameter
= startsWith writeParameter registeredParameter || startsWith registeredParameter writeParameter
getStringContent :: String FileCollection -> Maybe String getStringContent :: String FileCollection -> Maybe String
getStringContent key collection = case 'DM'.get key collection of getStringContent key collection = case 'DM'.get key collection of
(Just (FileContent content)) = Just content (Just (FileContent content)) = Just content
...@@ -131,3 +141,6 @@ where ...@@ -131,3 +141,6 @@ where
toPath (name,FileContent _) = [name] toPath (name,FileContent _) = [name]
toPath (name,FileCollection collection) = [name:[name </> path \\ path <- toPaths collection]] 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 () ...@@ -24,7 +24,7 @@ randomInt :: SDSSource () Int ()
randomString :: SDSSource Int String () randomString :: SDSSource Int String ()
// world function share // 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) // memory share (essentially a global variable)
memoryShare :: SDSSource String (Maybe a) (Maybe a) | TC a memoryShare :: SDSSource String (Maybe a) (Maybe a) | TC a
......
...@@ -22,15 +22,15 @@ nullShare = createReadWriteSDS "_core_" "nullShare" (\_ env -> (Ok (), env)) (\_ ...@@ -22,15 +22,15 @@ nullShare = createReadWriteSDS "_core_" "nullShare" (\_ env -> (Ok (), env)) (\_
unitShare :: SimpleSDSSource () unitShare :: SimpleSDSSource ()
unitShare = nullShare unitShare = nullShare
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
worldShare read write = createReadWriteSDS "_core_" "worldShare" read` write` worldShare read write notify = createReadWriteSDS "_core_" "worldShare" read` write`
where where
read` p iworld=:{IWorld|world} = case read p world of read` p iworld=:{IWorld|world} = case read p world of
(Ok r,world) = (Ok r, {IWorld|iworld & world = world}) (Ok r,world) = (Ok r, {IWorld|iworld & world = world})
(Error e,world) = (Error (exception e), {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 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}) (Error e,world) = (Error (exception e), {IWorld|iworld & world = world})
// Random source // 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