Commit 364c43c7 authored by Bas Lijnse's avatar Bas Lijnse

Added tasks for exporting data from workflows to the server's filesystem in various formats.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1119 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent d6cc754c
definition module ExportTasks
/**
* This module provides tasks for exporting data from a workflow to an external source
*/
import iTasks
/**
* Export a document to the server's filesystem.
*
* @param The path of the exported file
* @param The document to export
*
* @return The exported document
*/
exportDocument :: !String !Document -> Task Document
/**
* Export a string as text file to the server's filesystem.
*
* @param The path of the exported file
* @param The content to export
*
* @return The exported content
*/
exportTextFile :: !String !String -> Task String
/**
* Export a list of rows of fields to a comma separated vector (CSV) file on the server's filesystem.
*
* @param The path of the exported file
* @param The content to export as a list of rows of lists of fields
*
* @return The exported content
*/
exportCSVFile :: !String ![[String]] -> Task [[String]]
/**
* Export a list of rows of fields to a comma separated vector (CSV) file on the server's filesystem
* using custom separator characters.
*
* @param The field separator
* @param The string quote character
* @param The escape character
* @param The path of the exported file
* @param The content to export as a list of rows of lists of fields
*
* @return The exported content
*/
exportCSVFileWith :: !Char !Char !Char !String ![[String]] -> Task [[String]]
/**
* Encode and export a JSON datafile to the server's filesystem.
*
* @param The path of the exported file
* @param The content to encode as JSON using the generic JSON encoder
*
* @param The exported content
*/
exportJSONFile :: !String a -> Task a | JSONEncode{|*|} a
/**
* Encode and export a JSON datafile to the server's filesystem using a custom encode function.
*
* @param The JSON encoder function
* @param The path of the exported file
*
* @return The exported content
*/
exportJSONFileWith :: !(a -> JSONNode) !String a -> Task a
implementation module ExportTasks
import iTasks
import TSt, DocumentDB
import StdFile, CSV
exportDocument :: !String !Document -> Task Document
exportDocument filename document = mkInstantTask ("Export of document " +++ filename) (writeDocument filename document)
exportTextFile :: !String !String -> Task String
exportTextFile filename content = mkInstantTask ("Export of text file " +++ filename) (fileTask filename content writeAll)
exportCSVFile :: !String ![[String]] -> Task [[String]]
exportCSVFile filename content = mkInstantTask ("Export of CSV file " +++ filename) (fileTask filename content writeCSVFile)
exportCSVFileWith :: !Char !Char !Char !String ![[String]] -> Task [[String]]
exportCSVFileWith delimitChar quoteChar escapeChar filename content = mkInstantTask ("Export of CSV file " +++ filename) (fileTask filename content (writeCSVFileWith delimitChar quoteChar escapeChar))
exportJSONFile :: !String a -> Task a | JSONEncode{|*|} a
exportJSONFile filename content = exportJSONFileWith toJSON filename content
exportJSONFileWith :: !(a -> JSONNode) !String a -> Task a
exportJSONFileWith encoder filename content = mkInstantTask ("Export of JSON file " +++ filename) (fileTask filename content (writeJSON encoder))
fileTask filename content f tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (ok,file,world) = fopen filename FWriteData world
| not ok = (TaskException (openException filename),{TSt|tst & iworld={IWorld|iworld & world = world}})
# file = f content file
# (ok,world) = fclose file world
| not ok = (TaskException (closeException filename),{TSt|tst & iworld={IWorld|iworld & world = world}})
= (TaskFinished content, {TSt|tst & iworld={IWorld|iworld & world = world}})
writeAll content file
= fwrites content file
writeJSON encoder content file
= fwrites (toString (encoder content)) file
writeDocument filename document tst
# (mbContent,tst=:{TSt|iworld=iworld=:{IWorld|world}})
= getDocumentContent document.Document.documentId tst
| isNothing mbContent = (TaskException documentException, {TSt|tst & iworld={IWorld|iworld & world = world}})
# (ok,file,world) = fopen filename FWriteData world
| not ok = (TaskException (openException filename),{TSt|tst & iworld={IWorld|iworld & world = world}})
# file = fwrites (fromJust mbContent) file
# (ok,world) = fclose file world
| not ok = (TaskException (closeException filename),{TSt|tst & iworld={IWorld|iworld & world = world}})
= (TaskFinished document, {TSt|tst & iworld={IWorld|iworld & world = world}})
documentException = (dynamic "Could not read document content")
openException s = (dynamic ("Could not open file: " +++ s))
closeException s = (dynamic ("Could not close file: " +++ s))
\ No newline at end of file
......@@ -4,12 +4,57 @@ definition module ImportTasks
*
*/
import iTasks
/**
* Import a file on the server's filesystem as a Document
*
* @param The path of the file to import
*
* @return The imported document
*/
importDocument :: !String -> Task Document
/**
* Import the content of a text file on the server's filesystem.
*
* @param The path of the file to import
*
* @return The imported content
*/
importTextFile :: !String -> Task String
/**
* Import a comma separated vector (CSV) file on the server's filesystem.
*
* @param The path of the file to import
*
* @return The imported content
*/
importCSVFile :: !String -> Task [[String]]
/**
* Import a comma separated vector (CSV) file on the server's filesystem using
* custom separator characters.
*
* @param The field separator
* @param The string quote character
* @param The escape character
* @param The path of the file to import
*
* @return The imported content
*/
importCSVFileWith :: !Char !Char !Char !String -> Task [[String]]
importDocument :: !String -> Task Document
\ No newline at end of file
/**
* Import and parse a JSON datafile on the server's filesystem.
*
* @param The path of the file to import
*
* @return The imported content
*/
importJSONFile :: !String -> Task a | JSONDecode{|*|} a
/**
* Import and parse a JSON datafile on the server's filesystem using
* a custom parse function.
*
* @param The JSON decoder function
* @param The path of the file to import
*
* @return The imported content
*/
importJSONFileWith :: !(JSONNode -> Maybe a) !String -> Task a
\ No newline at end of file
......@@ -6,6 +6,9 @@ import TSt, DocumentDB, ExtToMime, Text, Util
CHUNK_SIZE :== 1024
importDocument :: !String -> Task Document
importDocument filename = mkInstantTask ("Import of document " +++ filename) (readDocument filename)
importTextFile :: !String -> Task String
importTextFile filename = mkInstantTask ("Import of text file " +++ filename) (fileTask filename readAll)
......@@ -15,8 +18,11 @@ importCSVFile filename = mkInstantTask ("Import of CSV file " +++ filename) (fil
importCSVFileWith :: !Char !Char !Char !String -> Task [[String]]
importCSVFileWith delimitChar quoteChar escapeChar filename = mkInstantTask ("Import of CSV file " +++ filename) (fileTask filename (readCSVFileWith delimitChar quoteChar escapeChar))
importDocument :: !String -> Task Document
importDocument filename = mkInstantTask ("Import of document " +++ filename) (readDocument filename)
importJSONFile :: !String -> Task a | JSONDecode{|*|} a
importJSONFile filename = mkInstantTask ("Import of JSON file " +++ filename) (readJSON filename fromJSON)
importJSONFileWith :: !(JSONNode -> Maybe a) !String -> Task a
importJSONFileWith parsefun filename = mkInstantTask ("Import of JSON file " +++ filename) (readJSON filename parsefun)
fileTask filename f tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (ok,file,world) = fopen filename FReadData world
......@@ -33,6 +39,16 @@ readAll file
| otherwise
# (rest,file) = readAll file
= (chunk +++ rest,file)
readJSON filename parsefun tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (ok,file,world) = fopen filename FReadData world
| not ok = (TaskException (openException filename),{TSt|tst & iworld={IWorld|iworld & world = world}})
# (content,file) = readAll file
# (ok,world) = fclose file world
| not ok = (TaskException (closeException filename),{TSt|tst & iworld={IWorld|iworld & world = world}})
= case (parsefun (fromString content)) of
Just a = (TaskFinished a, {TSt|tst & iworld={IWorld|iworld & world = world}})
Nothing = (TaskException (parseException filename), {TSt|tst & iworld={IWorld|iworld & world = world}})
readDocument filename tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (ok,file,world) = fopen filename FReadData world
......@@ -45,7 +61,6 @@ readDocument filename tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (document,tst) = createDocument name mime content {TSt|tst & iworld={IWorld|iworld & world = world}}
= (TaskFinished document, tst)
openException s = (dynamic ("Could not open file: " +++ s))
closeException s = (dynamic ("Could not close file: " +++ s))
parseException s = (dynamic ("Could not parse file: " +++ s))
......@@ -16,6 +16,7 @@ import Engine // basic iTask system creator
, ProcessDBTasks // tasks for accessing the process database
, ImportTasks // tasks for importing external data
, ExportTasks // tasks for exporting data
, DateTimeTasks // tasks triggered by date and time
, ChangeTasks // Tasks for changing existing workflows
......
......@@ -3,7 +3,6 @@ definition module CSV
* This module provides functions for reading and writing comma separated vector (CSV) files.
*/
import StdFile, StdMaybe
/**
* Read a single record from a CSV file
* A comma ',' is used as field separator, double quotes '"' may be used to enclose fields
......@@ -50,4 +49,52 @@ readCSVFile :: !*File -> (![[String]],!*File)
* @return The list of records which are lists of strings
* @return The file handle
*/
readCSVFileWith :: !Char !Char !Char !*File -> (![[String]],!*File)
\ No newline at end of file
readCSVFileWith :: !Char !Char !Char !*File -> (![[String]],!*File)
/**
* Write a single record to a CSV file
* A comma ',' is used as field separator, double quotes '"' may be used to enclose fields
* and the escape character is backslash '\'.
*
* @param The record as a list of strings
* @param The file handle to write to
*
* @return The file handle
*/
writeCSVRecord :: ![String] !*File -> *File
/**
* Write a single record to a CSV file with custom separator characters.
*
* @param The field separator character
* @param The field enclosure character
* @param The escape character
* @param The record as a list of strings
* @param The file handle to write to
*
* @return The file handle
*/
writeCSVRecordWith :: !Char !Char !Char ![String] !*File -> *File
/**
* Write an entire CSV file.
*
* A comma ',' is used as field separator, double quotes '"' may be used to enclose fields
* and the escape character is backslash '\'.
*
* @param The list of records which are lists of strings
* @param The file handle to write to
*
* @return The file handle
*/
writeCSVFile :: ![[String]] !*File -> *File
/**
* Write an entire CSV file with custom separator characters.
*
* @param The field separator character
* @param The field enclosure character
* @param The escape character
* @param The list of records which are lists of strings
* @param The file handle to write to
*
* @return The file handle
*/
writeCSVFileWith :: !Char !Char !Char ![[String]] !*File -> *File
\ No newline at end of file
......@@ -54,10 +54,20 @@ where
next = inc cur
field = if isQuoted quotedField normalField
isQuoted = buffer.[start] == quoteChar && buffer.[cur - 1] == quoteChar
normalField = buffer % (start,cur - 1)
quotedField = replaceSubString "\\\"" "\"" (replaceSubString "\\\\" "\\" (buffer % (start + 1, cur - 2)))
normalField = buffer % (start, cur - 1)
quotedField = unescape (buffer % (start + 1, cur - 2))
remain = size buffer - next
//Remove all {escapeChar,quoteChar} and {escapeChar,escapeChar} combinations from a string
unescape s = {c \\ c <- (unescape` [u \\ u <-: s])}
where
unescape` [char1,char2:rest]
| char1 == escapeChar = [char2:unescape` rest]
= unescape` [char2:rest]
unescape` [char:rest] = [char: unescape` rest]
unescape` [] = []
readCSVFile :: !*File -> (![[String]],!*File)
readCSVFile file = readCSVFileWith ',' '"' '\\' file
......@@ -70,8 +80,24 @@ readCSVFileWith delimitChar quoteChar escapeChar file
# (recs,file) = readCSVFileWith delimitChar quoteChar escapeChar file
= ([rec:recs],file)
writeCSVRecord :: ![String] !*File -> *File
writeCSVRecord fields file = file
writeCSVRecord fields file = writeCSVRecordWith ',' '"' '\\' fields file
writeCSVRecordWith :: !Char !Char !Char ![String] !*File -> *File
writeCSVRecordWith delimitChar quoteChar escapeChar fields file
= fwrites line file
where
line = (join {delimitChar} [{quoteChar} +++ escape field +++ {quoteChar} \\ field <- fields]) +++ "\r\n"
escape s = {c \\ c <- flatten [escape` u \\ u <-: s]}
where
escape` c
| c == escapeChar = [escapeChar,escapeChar]
| c == quoteChar = [escapeChar,quoteChar]
= [c]
writeCSVFile :: ![[String]] !*File -> *File
writeCSVFile records file = file
\ No newline at end of file
writeCSVFile fields file = writeCSVFileWith ',' '"' '\\' fields file
writeCSVFileWith :: !Char !Char !Char ![[String]] !*File -> *File
writeCSVFileWith delimitChar quoteChar escapeChar fields file = foldl (flip (writeCSVRecordWith delimitChar quoteChar escapeChar)) file fields
......@@ -16,8 +16,8 @@ from HttpServer import :: HTTPServerControl(..), :: HTTPServerOption(..)
import Setup
//import AuthenticationHandler, DeauthenticationHandler
//import NewListHandler, NewStartHandler, WorkListHandler
import WorkTabHandler, PropertyHandler, UserListHandler
//import NewListHandler, NewStartHandler, WorkListHandler, UserListHandler
import WorkTabHandler, PropertyHandler
import TaskTreeForestHandler, ProcessTableHandler
import RPCHandlers
......@@ -50,7 +50,7 @@ where
//,((==) (config.serverPath +++ "/work/list"), handleSessionRequest config flows handleWorkListRequest)
,((==) (config.serverPath +++ "/work/tab"), handleSessionRequest config flows handleWorkTabRequest)
,((==) (config.serverPath +++ "/work/property"), handleSessionRequest config flows handlePropertyRequest)
,((==) (config.serverPath +++ "/data/users"), handleSessionRequest config flows handleUserListRequest)
//,((==) (config.serverPath +++ "/data/users"), handleSessionRequest config flows handleUserListRequest)
,((==) (config.serverPath +++ "/rpc/request"), handleSessionRequest config flows handleRPCListRequest)
,((==) (config.serverPath +++ "/rpc/response"), handleSessionRequest config flows handleRPCUpdates)
,((==) (config.serverPath +++ "/debug/taskforest"), handleSessionRequest config flows handleTaskForestRequest)
......
module ExportTest
import iTasks
test1 :: Task Document
test1 = enterInformation "Upload please" >>= exportDocument "test.doc"
test2 :: Task String
test2 = enterInformation "Enter content" >>= exportTextFile "test.txt"
test3 :: Task [[String]]
test3 = enterInformation "Enter rows" >>= exportCSVFile "test.txt"
test4 :: Task [Int]
test4 = enterInformation "Enter numbers" >>= exportJSONFile "test.txt"
Start :: *World -> *World
Start world = startEngine [workflow "Test" test4] world
\ No newline at end of file
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