Commit 4662a3a6 authored by Steffen Michels's avatar Steffen Michels

- first attempt of a Table type (not editable yet)

- example demonstrating table
- fixed bug in CSV module

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1287 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent ebe273f2
......@@ -29,6 +29,7 @@
,{"text":"FormButtonControl.js","path":"src/js/tui/"}
,{"text":"ChoiceControl.js","path":"src/js/tui/"}
,{"text":"AppletControl.js","path":"src/js/tui/"}
,{"text":"GridControl.js","path":"src/js/tui/"}
,{"text":"TUICommon.js","path":"src/js/tui/"}
,{"text":"ListContainer.js","path":"src/js/tui/"}
......
Ext.ns("itasks.tui");
itasks.tui.GridControl = Ext.extend(Ext.grid.EditorGridPanel,{
autoHeight: true,
viewConfig: {
forceFit: true
},
initComponent: function() {
var fields = [];
for(var i = 0; i < this.columns.length; i++){
fields[i] = this.columns[i].dataIndex;
}
console.log(this.columns);
console.log(this.gridData);
var store = new Ext.data.JsonStore({
// store configs
autoDestroy: true,
root: 'data',
//idProperty: 'name',
fields: fields,
data: {data: this.gridData}
});
this.store = store;
itasks.tui.GridControl.superclass.initComponent.apply(this,arguments);
//this.addEvents('tuichange');
//this.enableBubble('tuichange');
},
});
Ext.reg("itasks.tui.Grid",itasks.tui.GridControl);
\ No newline at end of file
......@@ -89,6 +89,7 @@
<script type="text/javascript" src="../js/tui/FormButtonControl.js"></script>
<script type="text/javascript" src="../js/tui/ChoiceControl.js"></script>
<script type="text/javascript" src="../js/tui/AppletControl.js"></script>
<script type="text/javascript" src="../js/tui/GridControl.js"></script>
<script type="text/javascript" src="../js/tui/ListContainer.js"></script>
<script type="text/javascript" src="../js/tui/RecordContainer.js"></script>
......
......@@ -21,6 +21,7 @@ import Newsgroups
import ChangeHandling
import textEditor
import CoffeeTime
import TableExamples
//Crisis response examples
import AmbulanceDispatch
......@@ -55,6 +56,7 @@ where
, coffeemachineExample
, textEditor
, coffeeTimeExample
, tableExamples
, newsgroupsExample
, exceptionHandlingExample
, changeHandlingExample
......
definition module TableExamples
import iTasks
tableExamples :: [Workflow]
implementation module TableExamples
import iTasks, Table, Text, StdInt
tableExamples :: [Workflow]
tableExamples = [workflow "Examples/Miscellaneous/Plant dataset table" "Uses the Table type to represent a simple plant dataset." plantExample]
plantExample = try plantExample` showError
plantExample` =
readDataset
>>= transform toTable
>>= updateInformation ("Plant Dataset",description)
>>| stop
where
description = RawText
("This example demonstrates how the table type is used to edit a dataset. "
+++
"The dataset is taken from an <a href=http://dev.sencha.com/deploy/dev/examples/grid/edit-grid.html>Ext JS Grid Example</a>.")
showError dyn = case dyn of
(str :: String) = showMessage ("Error",str) Void
_ = showMessage "Unknown error" Void
readDataset :: Task [Plant]
readDataset =
importCSVFile ".\\Miscellaneous\\plants.csv"
>>= \csvData. toPlant csvData []
where
toPlant [] acc = return (reverse acc)
toPlant [plant:rest] acc = case plant of
[common,botanical,zone,light,price,availability,indoor]
= toPlant rest
[{ name =
{ common = common
, botanical = botanical
}
, light = light
, price = USD (toInt ((toReal price) * 100.0))
, availability = s2Date availability
,indoor = indoor == "true"
}:acc]
_
= throw "invalid CSV row!"
s2Date str = case split "/" str of
[m,d,y] = {day = toInt d, mon = toInt m, year = toInt y}
_ = {day = 0, mon = 0, year = 0}
:: Plant = { name :: PlantName
, light :: String
, price :: Currency
, availability :: Date
, indoor :: Bool
}
:: PlantName = { common :: String
, botanical :: String
}
derive class iTask Plant, PlantName
derive class tableRow Plant, PlantName
derive bimap Maybe, (,)
Bloodroot,Sanguinaria canadensis,4,Mostly Shady,2.44,03/15/2006,true
Columbine,Aquilegia canadensis,3,Mostly Shady,9.37,03/06/2006,true
Marsh Marigold,Caltha palustris,4,Mostly Sunny,6.81,05/17/2006,false
Cowslip,Caltha palustris,4,Mostly Shady,9.90,03/06/2006,true
Dutchman's-Breeches,Dicentra cucullaria,3,Mostly Shady,6.44,01/20/2006,true
"Ginger, Wild",Asarum canadense,3,Mostly Shady,9.03,04/18/2006,true
Hepatica,Hepatica americana,4,Mostly Shady,4.45,01/26/2006,true
Liverleaf,Hepatica americana,4,Mostly Shady,3.99,01/02/2006,true
Jack-In-The-Pulpit,Arisaema triphyllum,4,Mostly Shady,3.23,02/01/2006,true
Mayapple,Podophyllum peltatum,3,Mostly Shady,2.98,06/05/2006,true
"Phlox, Woodland",Phlox divaricata,3,Sun or Shade,2.80,01/22/2006,false
"Phlox, Blue",Phlox divaricata,3,Sun or Shade,5.59,02/16/2006,false
Spring-Beauty,Claytonia Virginica,7,Mostly Shady,6.59,02/01/2006,true
Trillium,Trillium grandiflorum,5,Sun or Shade,3.90,04/29/2006,false
Wake Robin,Trillium grandiflorum,5,Sun or Shade,3.20,02/21/2006,false
"Violet, Dog-Tooth",Erythronium americanum,4,Shade,9.04,02/01/2006,true
Trout Lily,Erythronium americanum,4,Shade,6.94,03/24/2006,true
Adder's-Tongue,Erythronium americanum,4,Shade,9.58,04/13/2006,true
Anemone,Anemone blanda,6,Mostly Shady,8.86,12/26/2006,true
Grecian Windflower,Anemone blanda,6,Mostly Shady,9.16,07/10/2006,true
Bee Balm,Monarda didyma,4,Shade,4.59,05/03/2006,true
Bergamot,Monarda didyma,4,Shade,7.16,04/27/2006,true
Black-Eyed Susan,Rudbeckia hirta,Annual,Sunny,9.80,06/18/2006,false
Buttercup,Ranunculus,4,Shade,2.57,06/10/2006,true
Crowfoot,Ranunculus,4,Shade,9.34,04/03/2006,true
Butterfly Weed,Asclepias tuberosa,Annual,Sunny,2.78,06/30/2006,false
Cinquefoil,Potentilla,Annual,Shade,7.06,05/25/2006,true
Primrose,Oenothera,3 - 5,Sunny,6.56,01/30/2006,false
Gentian,Gentiana,4,Sun or Shade,7.81,05/18/2006,false
Blue Gentian,Gentiana,4,Sun or Shade,8.56,05/02/2006,false
Jacob's Ladder,Polemonium caeruleum,Annual,Shade,9.26,02/21/2006,true
Greek Valerian,Polemonium caeruleum,Annual,Shade,4.36,07/14/2006,true
California Poppy,Eschscholzia californica,Annual,Sunny,7.89,03/27/2006,false
Shooting Star,Dodecatheon,Annual,Mostly Shady,8.60,05/13/2006,true
Snakeroot,Cimicifuga,Annual,Shade,5.63,07/11/2006,true
Cardinal Flower,Lobelia cardinalis,2,Shade,3.02,02/22/2006,true
\ No newline at end of file
......@@ -306,21 +306,20 @@ makeInformationTaskAV mbContext (bimapGet,initView) bimapPutback actions informa
# tst = setTaskStore "mask" numask tst
# (nvmask,tst) = accIWorldTSt (verifyValue nvalue numask) tst
# (conflict,tst) = accIWorldTSt (isSharedChanged shared localTimestamp) tst
= case isValidValue nvmask && not enterMode of
True // if view is valid (and not in enter mode) also try to update model
// check if the task causes an editing conflict
= case conflict of
False // no conflict, update model
# ((oldModelValue,_),tst) = readModelValue tst
# newModelValue = bimapPutback nvalue oldModelValue
# tst = appIWorldTSt (writeShared shared newModelValue) tst
// rebuild value from model after also other possible changes are done
= (True,(nvalue,numask,nvmask),[],tst)
True
// don't update model, rebuild view based on current value of model and set errors
= (True,old,[(p,ErrorMessage "An edit conflict occurred. The field was reset to the most recent value.") \\ (p,_) <- edits],tst)
False // edited invalid views (or if in enter mode) are not rebuilt, updates are based on current value
= (False,(nvalue,numask,nvmask),[],tst)
| isValidValue nvmask && not enterMode
// if view is valid (and not in enter mode) also try to update model
| not conflict
# ((oldModelValue,_),tst) = readModelValue tst
# newModelValue = bimapPutback nvalue oldModelValue
# tst = appIWorldTSt (writeShared shared newModelValue) tst
// task causes an edit conflict
// rebuild value from model after also other possible changes are done
= (True,(nvalue,numask,nvmask),[],tst)
| otherwise
// don't update model, rebuild view based on current value of model and set errors
= (True,old,[(p,ErrorMessage "An edit conflict occurred. The field was reset to the most recent value.") \\ (p,_) <- edits],tst)
| otherwise // edited invalid views (or if in enter mode) are not rebuilt, updates are based on current value
= (False,(nvalue,numask,nvmask),[],tst)
// check for action event
# mbActionEvent = actionEvent events actions
= case mbActionEvent of
......
definition module Table
import GenVisualize
derive gVisualize Table
derive gUpdate Table
derive gVerify Table
derive JSONEncode Table
derive JSONDecode Table
derive gMakeColumns OBJECT, CONS, FIELD, PAIR, Int, String, Bool, Real, Date, Currency
derive gMakeRow OBJECT, CONS, FIELD, PAIR, Int, String, Bool, Real, Date, Currency
:: Table = Table ![TUIGridColumn] ![JSONNode]
toTable :: ![a] -> Table | tableRow a
class tableRow a
| gMakeColumns{|*|}
, gMakeRow{|*|} a
generic gMakeColumns a :: !a ![String] !(Maybe Int) !DataPath -> (![TUIGridColumn],!DataPath)
generic gMakeRow a :: !a !DataPath -> (![(!String,!String)],!DataPath)
implementation module Table
import StdTuple, StdList, StdMisc, StdBool, StdFunc, Text, Types
derive JSONEncode Table, TUIGridColumn
derive JSONDecode Table, TUIGridColumn
derive bimap Maybe, (,)
gUpdate{|Table|} _ ust=:{USt|mode=UDCreate,newMask}
= (Table [] [], {USt | ust & newMask = appendToMask newMask Untouched})
gUpdate{|Table|} table ust=:{USt|mode=UDSearch,searchPath,currentPath,update,oldMask,newMask}
# (cm,om) = popMask oldMask
# ust = {ust & currentPath = stepDataPath currentPath, oldMask = om}
| currentPath == searchPath
= (table,ust)
| otherwise
= (table,{ust & newMask = appendToMask newMask (cleanUpdMask cm)})
gUpdate{|Table|} table ust=:{USt|mode=UDMask,currentPath,newMask}
# mask = Touched True []
= (table,{USt|ust & currentPath = stepDataPath currentPath, newMask = appendToMask newMask mask})
gVerify{|Table|} v vst = customVerify Nothing (const True) (const "") v vst
gVisualize{|Table|} val vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,renderAsStatic,verifyMask,updateMask,updates}
# (cmu,um) = popMask updateMask
# (cmv,vm) = popMask verifyMask
# vst = {VSt|vst & updateMask = um, verifyMask = vm}
= case val of
Nothing
= ([TextFragment "Empty table"],{VSt|vst & currentPath = stepDataPath currentPath})
Just (Table columns data)
= case vizType of
VEditorDefinition
# (err,hnt) = verifyElementStr cmu cmv
# id = dp2id idPrefix currentPath
= ([TUIFragment (TUIGridControl { TUIGridControl
| name = id
, id = id
, columns = columns
, gridData = data
})]
, {VSt|vst & currentPath = stepDataPath currentPath})
_
= abort "not implemented yet!"
toTable :: ![a] -> Table | tableRow a
toTable [] = Table [] []
toTable l=:[v:_] = Table cols data
where
cols = fst (gMakeColumns{|*|} v [] Nothing startDataPath)
data = map (\row -> mkObj (gMakeRow{|*|} row startDataPath)) l
where
mkObj = JSONObject o map (app2 (id,JSONString)) o fst
generic gMakeColumns a :: !a ![String] !(Maybe Int) !DataPath -> (![TUIGridColumn],!DataPath)
gMakeColumns{|OBJECT|} fx (OBJECT o) labels mbIdx dp
# (res,_) = fx o (maybeToList (mapMaybe toString mbIdx) ++ labels) Nothing (shiftDataPath dp)
= (res,stepDataPath dp)
gMakeColumns{|CONS of d|} fx (CONS c) labels mbIdx dp
= fx c nLabels nMbIdx dp
where
// for records labels are determined by FIELDs
nLabels = if notRecord [d.gcd_name:labels] labels
nMbIdx = if (notRecord && d.gcd_arity > 1) (Just 1) Nothing
notRecord = isEmpty d.gcd_fields
gMakeColumns{|FIELD of d|} fx (FIELD f) labels mbIdx dp
= fx f [d.gfd_name:labels] mbIdx dp
gMakeColumns{|PAIR|} fx fy (PAIR x y) labels mbIdx dp
# (colsx,dp) = fx x labels mbIdx dp
# (colsy,dp) = fy y labels (mapMaybe inc mbIdx) dp
= (colsx ++ colsy,dp)
gMakeColumns{|Int|} v labels mbIdx dp = basicMakeColumn labels mbIdx dp
gMakeColumns{|String|} v labels mbIdx dp = basicMakeColumn labels mbIdx dp
gMakeColumns{|Bool|} v labels mbIdx dp = basicMakeColumn labels mbIdx dp
gMakeColumns{|Real|} v labels mbIdx dp = basicMakeColumn labels mbIdx dp
gMakeColumns{|Date|} v labels mbIdx dp = basicMakeColumn labels mbIdx dp
gMakeColumns{|Currency|} v labels mbIdx dp = basicMakeColumn labels mbIdx dp
basicMakeColumn labels mbIdx dp = ([col],stepDataPath dp)
where
col = { header = join " " (map formatLabel (reverse labels ++ maybeToList (mapMaybe toString mbIdx)))
, dataIndex = dp2s dp
}
generic gMakeRow a :: !a !DataPath -> (![(!String,!String)],!DataPath)
gMakeRow{|OBJECT|} fx (OBJECT o) dp
# (res,_) = fx o (shiftDataPath dp)
= (res,stepDataPath dp)
gMakeRow{|CONS|} fx (CONS c) dp
= fx c dp
gMakeRow{|FIELD|} fx (FIELD f) dp
= fx f dp
gMakeRow{|PAIR|} fx fy (PAIR x y) dp
# (colsx,dp) = fx x dp
# (colsy,dp) = fy y dp
= (colsx ++ colsy,dp)
gMakeRow{|Int|} v dp = basicMakeRow v dp
gMakeRow{|String|} v dp = basicMakeRow v dp
gMakeRow{|Bool|} v dp = basicMakeRow v dp
gMakeRow{|Real|} v dp = basicMakeRow v dp
gMakeRow{|Date|} v dp = basicMakeRow v dp
gMakeRow{|Currency|} v dp = basicMakeRow v dp
basicMakeRow v dp = ([(dp2s dp,toString v)],stepDataPath dp)
......@@ -13,7 +13,7 @@ defaultValue iworld
defaultMask :: a !*IWorld -> (!UpdateMask,!*IWorld) | gUpdate{|*|} a
defaultMask a iworld
# (_,ust=:{newMask,iworld}) = gUpdate{|*|} a {USt| mode = UDMask, searchPath = emptyDataPath, currentPath = shiftDataPath emptyDataPath, consPath = [], update = "", oldMask = [], newMask = [], iworld = iworld}
# (_,ust=:{newMask,iworld}) = gUpdate{|*|} a {USt| mode = UDMask, searchPath = emptyDataPath, currentPath = startDataPath, consPath = [], update = "", oldMask = [], newMask = [], iworld = iworld}
= (hd newMask,iworld)
updateValue :: DataPath String a !*IWorld -> (a,!*IWorld) | gUpdate{|*|} a
......@@ -23,7 +23,7 @@ updateValue path update a iworld
updateValueAndMask :: DataPath String a UpdateMask !*IWorld -> (a,UpdateMask,!*IWorld) | gUpdate{|*|} a
updateValueAndMask path update a oldMask iworld
# (a,ust=:{newMask,iworld}) = gUpdate{|*|} a {USt| mode = UDSearch, searchPath = path, currentPath = shiftDataPath emptyDataPath, consPath = [], update = update, oldMask = [oldMask], newMask = [], iworld = iworld}
# (a,ust=:{newMask,iworld}) = gUpdate{|*|} a {USt| mode = UDSearch, searchPath = path, currentPath = startDataPath, consPath = [], update = update, oldMask = [oldMask], newMask = [], iworld = iworld}
= (a,hd newMask,iworld)
appIWorldUSt :: !.(*IWorld -> *IWorld)!*USt -> *USt
......
......@@ -85,5 +85,6 @@ visualizeBasicControl :: !(Maybe a) !*VSt -> (!TUIBasicControl, !*VSt) | toStrin
verifyElementStr :: !UpdateMask !VerifyMask -> (!String, !String)
value2s :: !UpdateMask !(Maybe a) -> String | toString a
labelAttr :: !Bool !(Maybe String) -> Maybe String
\ No newline at end of file
value2s :: !UpdateMask !(Maybe a) -> String | toString a
labelAttr :: !Bool !(Maybe String) -> Maybe String
formatLabel :: !String -> String
\ No newline at end of file
......@@ -301,7 +301,7 @@ gVisualize{|OBJECT of d|} fx val vst=:{vizType,idPrefix,label,currentPath,select
| otherwise
= case val of
Just (OBJECT x) = fx (Just x) vst
Nothing = fx Nothing vst
Nothing = fx Nothing vst
where
id = dp2id idPrefix currentPath
cId = (dp2id idPrefix currentPath) +++ "c"
......@@ -931,7 +931,7 @@ labelAttr False _ = Nothing
labelAttr True Nothing = Just ""
labelAttr True l = l
formatLabel :: String -> String
formatLabel :: !String -> String
formatLabel label = {c \\ c <- [toUpper lname : addspace lnames]}
where
[lname:lnames] = [c \\ c <-: label]
......
......@@ -58,6 +58,7 @@ instance == TUIDef
| TUIFormButtonControl TUIButtonControl
| TUIListItemControl TUIListItemControl
| TUIAppletControl TUIAppletControl
| TUIGridControl TUIGridControl
| TUITupleContainer TUITupleContainer
| TUIRecordContainer TUIRecordContainer
......@@ -231,4 +232,15 @@ instance == TUIDef
, iconCls :: !Maybe String
, hotkey :: !Maybe Hotkey
, actionData :: !Maybe String
}
\ No newline at end of file
}
:: TUIGridControl =
{ name :: !String
, id :: !TUIId
, columns :: ![TUIGridColumn]
, gridData :: ![JSONNode]
}
:: TUIGridColumn =
{ header :: !String
, dataIndex :: !DataIndex
}
:: DataIndex :== String
\ No newline at end of file
......@@ -4,7 +4,7 @@ import JSON,StdList,StdBool,GenEq
from Types import :: Document, :: DocumentId, :: Hotkey, :: Key
derive gEq TUIDef, TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl, TUIButtonControl, TUIListItemControl
derive gEq TUIDef, TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl, TUIButtonControl, TUIListItemControl, TUIGridControl, TUIGridColumn
derive gEq TUIAppletControl, TUITupleContainer, TUIRecordContainer, TUIListContainer, TUIHtmlContainer, JSONNode, Maybe, Document
derive gEq TUIButton, TUIUpdate, TUIChoiceControl, TUIMenuButton, TUIMenu, TUIMenuItem, Hotkey, Key
......@@ -12,7 +12,7 @@ derive gEq TUIButton, TUIUpdate, TUIChoiceControl, TUIMenuButton, TUIMenu, TUIMe
derive JSONEncode TUIButton, TUIUpdate, TUIMenuButton, TUIMenu, TUIMenuItem, Key, Hotkey
derive JSONEncode TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl
derive JSONEncode TUIButtonControl, TUIListItemControl, TUIChoiceControl, TUIAppletControl
derive JSONEncode TUITupleContainer, TUIRecordContainer, TUIListContainer, TUIHtmlContainer
derive JSONEncode TUITupleContainer, TUIRecordContainer, TUIListContainer, TUIHtmlContainer, TUIGridControl, TUIGridColumn
//TODO: Separate control elements from form-widgets
JSONEncode{|TUIDef|} (TUIButton r) = addXType "itasks.ttc.Button" (JSONEncode{|*|} r)
......@@ -40,6 +40,7 @@ JSONEncode{|TUIDef|} (TUIDocumentControl r) = addXType "itasks.tui.Document" (
JSONEncode{|TUIDef|} (TUIConstructorControl r) = addXType "itasks.tui.Constructor" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIListItemControl r) = addXType "itasks.tui.list.Item" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIAppletControl r) = addXType "itasks.tui.Applet" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIGridControl r) = addXType "itasks.tui.Grid" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUITupleContainer r) = addXType "itasks.tui.Tuple" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIRecordContainer r) = addXType "itasks.tui.Record" (JSONEncode{|*|} r)
......
......@@ -33,7 +33,7 @@ where
| otherwise
= read (buffer +++ chunk) start cur quoted escape fields file
//End of field
| buffer.[cur] == delimitChar && not quoted
| buffer.[cur] == delimitChar && not quoted && not escape
= read buffer next next quoted False [field:fields] file
//End of line
| (buffer.[cur] == '\n' || buffer.[cur] == '\r') && not quoted
......@@ -54,7 +54,7 @@ where
next = inc cur
field = if isQuoted quotedField normalField
isQuoted = buffer.[start] == quoteChar && buffer.[cur - 1] == quoteChar
normalField = buffer % (start, cur - 1)
normalField = unescape (buffer % (start, cur - 1))
quotedField = unescape (buffer % (start + 1, cur - 2))
remain = size buffer - next
......@@ -63,10 +63,10 @@ where
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` [] = []
| char1 == escapeChar = unescape` [char2:rest]
= [char1:unescape` [char2:rest]]
unescape` [char] = [char]
unescape` [] = []
readCSVFile :: !*File -> (![[String]],!*File)
readCSVFile file = readCSVFileWith ',' '"' '\\' 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