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 ...@@ -2,14 +2,24 @@ definition module iTasks.UI.Editor.Combinators
/** /**
* This module provides combinator functions for combining editors * This module provides combinator functions for combining editors
*/ */
import iTasks.UI.Editor import iTasks.UI.Editor, iTasks.UI.Definition
import Data.Error 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 * Adds hint attributes to an editor by checking the edit mask
*/ */
withHintAttributes :: String (Editor a) -> Editor a withHintAttributes :: String (Editor a) -> Editor a
/**
* Adds a label property
*/
withLabel :: String (Editor a) -> Editor a
/** /**
* Using an alternative editor when editing is disabled * Using an alternative editor when editing is disabled
*/ */
...@@ -26,7 +36,13 @@ liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b ...@@ -26,7 +36,13 @@ liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b
*/ */
liftEditorAsymmetric :: (b -> a) (a -> MaybeErrorString b) (Editor a) -> Editor b liftEditorAsymmetric :: (b -> a) (a -> MaybeErrorString b) (Editor a) -> Editor b
/** /**
* An editor with a constant model value * An editor with a constant model value
*/ */
constEditor :: a (Editor a) -> (Editor a) 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 ...@@ -4,6 +4,14 @@ import iTasks.UI.Editor, iTasks.UI.Definition
import Data.Error, Text.JSON import Data.Error, Text.JSON
import qualified Data.Map as DM 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 :: String (Editor a) -> Editor a
withHintAttributes typeDesc editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh} withHintAttributes typeDesc editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where where
...@@ -28,6 +36,9 @@ where ...@@ -28,6 +36,9 @@ where
= (Ok (change,nmask),nval,vst) = (Ok (change,nmask),nval,vst)
addHintAttrChanges omask (e,val,vst) = (e,val,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 :: (Editor a) (Editor a) -> Editor a
whenDisabled disabledEditor enabledEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh} whenDisabled disabledEditor enabledEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where where
...@@ -35,8 +46,8 @@ where ...@@ -35,8 +46,8 @@ where
| mode =: View = disabledEditor.Editor.genUI dp val vst | mode =: View = disabledEditor.Editor.genUI dp val vst
= enabledEditor.Editor.genUI dp val vst = enabledEditor.Editor.genUI dp val vst
onEdit dp e val mask ust onEdit dp e val mask vst
= enabledEditor.Editor.onEdit dp e val mask ust = enabledEditor.Editor.onEdit dp e val mask vst
onRefresh dp new old mask vst=:{VSt|mode} onRefresh dp new old mask vst=:{VSt|mode}
| mode =: View = disabledEditor.Editor.onRefresh dp new old mask vst | mode =: View = disabledEditor.Editor.onRefresh dp new old mask vst
...@@ -46,9 +57,9 @@ liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b ...@@ -46,9 +57,9 @@ liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b
liftEditor tof fromf editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh} liftEditor tof fromf editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where where
genUI dp val vst = editor.Editor.genUI dp (tof val) vst genUI dp val vst = editor.Editor.genUI dp (tof val) vst
onEdit dp e val mask ust onEdit dp e val mask vst
# (mask,val,ust) = editor.Editor.onEdit dp e (tof val) mask ust # (mask,val,vst) = editor.Editor.onEdit dp e (tof val) mask vst
= (mask,fromf val,ust) = (mask,fromf val,vst)
onRefresh dp new old mask vst onRefresh dp new old mask vst
# (change,val,vst) = editor.Editor.onRefresh dp (tof new) (tof old) mask vst # (change,val,vst) = editor.Editor.onRefresh dp (tof new) (tof old) mask vst
= (change,fromf val,vst) = (change,fromf val,vst)
...@@ -77,3 +88,33 @@ where ...@@ -77,3 +88,33 @@ where
onEdit dp _ val mask vst = (Ok (NoChange,mask),val,vst) onEdit dp _ val mask vst = (Ok (NoChange,mask),val,vst)
onRefresh 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 ...@@ -7,6 +7,7 @@ import iTasks, TestFramework
import Tests.Interactive.BuiltinEditors import Tests.Interactive.BuiltinEditors
import Tests.Interactive.GenericEditors import Tests.Interactive.GenericEditors
import Tests.Interactive.BuiltinContainers import Tests.Interactive.BuiltinContainers
import Tests.Interactive.CustomEditors
import Tests.Interactive.Layout import Tests.Interactive.Layout
import Tests.Interactive.Editlets import Tests.Interactive.Editlets
...@@ -23,6 +24,7 @@ suites = [//Interactive tests ...@@ -23,6 +24,7 @@ suites = [//Interactive tests
testBuiltinEditors testBuiltinEditors
,testGenericEditors ,testGenericEditors
,testBuiltinContainers ,testBuiltinContainers
,testCustomEditors
,testLayoutI ,testLayoutI
,testEditletsI ,testEditletsI
//Unit tests //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