Commit fff82f69 authored by Bas Lijnse's avatar Bas Lijnse

Implemented more editor combinators.

parent e37ee74c
......@@ -2,14 +2,24 @@ definition module iTasks.UI.Editor.Combinators
/**
* This module provides combinator functions for combining editors
*/
import iTasks.UI.Editor
import iTasks.UI.Editor, iTasks.UI.Definition
import Data.Error
/**
* Adds UI attributes to an editor
*/
withAttributes :: UIAttributes (Editor a) -> Editor a
/**
* Adds hint attributes to an editor by checking the edit mask
*/
withHintAttributes :: String (Editor a) -> Editor a
/**
* Adds a label property
*/
withLabel :: String (Editor a) -> Editor a
/**
* Using an alternative editor when editing is disabled
*/
......@@ -26,7 +36,13 @@ liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b
*/
liftEditorAsymmetric :: (b -> a) (a -> MaybeErrorString b) (Editor a) -> Editor b
/**
* An editor with a constant model value
*/
constEditor :: a (Editor a) -> (Editor a)
/**
* Create a composition of two editors
*/
composeEditors :: UINodeType (Editor a) (Editor b) -> Editor (a,b)
......@@ -4,6 +4,14 @@ import iTasks.UI.Editor, iTasks.UI.Definition
import Data.Error, Text.JSON
import qualified Data.Map as DM
withAttributes :: UIAttributes (Editor a) -> Editor a
withAttributes extra editor = {Editor|editor & genUI = genUI}
where
genUI dp val vst=:{VSt|taskId,optional}
= case editor.Editor.genUI dp val vst of
(Ok (UI type attr items,mask),vst) = (Ok (UI type ('DM'.union attr extra) items,mask),vst)
(e,vst) = (e,vst)
withHintAttributes :: String (Editor a) -> Editor a
withHintAttributes typeDesc editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
......@@ -28,6 +36,9 @@ where
= (Ok (change,nmask),nval,vst)
addHintAttrChanges omask (e,val,vst) = (e,val,vst)
withLabel :: String (Editor a) -> Editor a
withLabel label editor = withAttributes (labelAttr label) editor
whenDisabled :: (Editor a) (Editor a) -> Editor a
whenDisabled disabledEditor enabledEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
......@@ -35,8 +46,8 @@ where
| mode =: View = disabledEditor.Editor.genUI dp val vst
= enabledEditor.Editor.genUI dp val vst
onEdit dp e val mask ust
= enabledEditor.Editor.onEdit dp e val mask ust
onEdit dp e val mask vst
= enabledEditor.Editor.onEdit dp e val mask vst
onRefresh dp new old mask vst=:{VSt|mode}
| mode =: View = disabledEditor.Editor.onRefresh dp new old mask vst
......@@ -46,9 +57,9 @@ liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b
liftEditor tof fromf editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst = editor.Editor.genUI dp (tof val) vst
onEdit dp e val mask ust
# (mask,val,ust) = editor.Editor.onEdit dp e (tof val) mask ust
= (mask,fromf val,ust)
onEdit dp e val mask vst
# (mask,val,vst) = editor.Editor.onEdit dp e (tof val) mask vst
= (mask,fromf val,vst)
onRefresh dp new old mask vst
# (change,val,vst) = editor.Editor.onRefresh dp (tof new) (tof old) mask vst
= (change,fromf val,vst)
......@@ -77,3 +88,33 @@ where
onEdit dp _ val mask vst = (Ok (NoChange,mask),val,vst)
onRefresh dp _ val mask vst = (Ok (NoChange,mask),val,vst)
composeEditors :: UINodeType (Editor a) (Editor b) -> Editor (a,b)
composeEditors type ex ey = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (x,y) vst
# (vizx, vst) = ex.Editor.genUI (dp ++ [0]) x vst
| vizx =: (Error _) = (vizx,vst)
# (vizy, vst) = ey.Editor.genUI (dp ++ [1]) y vst
| vizy =: (Error _) = (vizy,vst)
# ((vizx,maskx),(vizy,masky)) = (fromOk vizx,fromOk vizy)
= (Ok (uic type [vizx,vizy],CompoundMask {fields=[maskx,masky],state=JSONNull}),vst)
onEdit dp ([0:ds],e) (x,y) (CompoundMask {fields=[xmask,ymask],state}) vst
= case ex.Editor.onEdit (dp ++ [0]) (ds,e) x xmask vst of
(Ok (xchange,xmask),x,vst)
= (Ok (ChangeUI [] [(0,ChangeChild xchange)],CompoundMask {fields=[xmask,ymask],state=state}),(x,y),vst)
(Error e,x,vst) = (Error e,(x,y),vst)
onEdit dp ([1:ds],e) (x,y) (CompoundMask {fields=[xmask,ymask],state}) vst
= case ey.Editor.onEdit (dp ++ [1]) (ds,e) y ymask vst of
(Ok (ychange,ymask),y,vst)
= (Ok (ChangeUI [] [(1,ChangeChild ychange)],CompoundMask {fields=[xmask,ymask],state=state}),(x,y),vst)
(Error e,y,vst) = (Error e,(x,y),vst)
onEdit _ _ val mask vst = (Ok (NoChange,mask),val,vst)
onRefresh dp (newx,newy) (oldx,oldy) (CompoundMask {fields=[maskx,masky],state}) vst
# (changex,newx,vst) = ex.Editor.onRefresh (dp ++ [0]) newx oldx maskx vst
| changex=: (Error _) = (changex,(oldx,oldy),vst)
# (changey,newy,vst) = ey.Editor.onRefresh (dp ++ [1]) newy oldy masky vst
| changey =: (Error _) = (changey,(oldx,oldy),vst)
# ((changex,maskx),(changey,masky)) = (fromOk changex,fromOk changey)
= (Ok (ChangeUI [] [(0,ChangeChild changex),(1,ChangeChild changey)],CompoundMask {fields=[maskx,masky],state=state}),(newx,newy), vst)
......@@ -7,6 +7,7 @@ import iTasks, TestFramework
import Tests.Interactive.BuiltinEditors
import Tests.Interactive.GenericEditors
import Tests.Interactive.BuiltinContainers
import Tests.Interactive.CustomEditors
import Tests.Interactive.Layout
import Tests.Interactive.Editlets
......@@ -23,6 +24,7 @@ suites = [//Interactive tests
testBuiltinEditors
,testGenericEditors
,testBuiltinContainers
,testCustomEditors
,testLayoutI
,testEditletsI
//Unit tests
......
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