Commit 06c6dd7f authored by Bas Lijnse's avatar Bas Lijnse

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

Added notification predicate to  SDS sources. This was needed to make notification work properly in FileCollection sources.
parent 5df5a322
Pipeline #26130 failed with stage
in 2 minutes and 31 seconds
......@@ -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