Commit 6c563df9 authored by Bas Lijnse's avatar Bas Lijnse
Browse files

Generalized the tune combinators to make it applicable to editors too

parent add24c82
......@@ -28,6 +28,7 @@ import
, iTasks.WF.Combinators.Common
// Custom task GUI's
, iTasks.UI.Tune
, iTasks.UI.Editor.Controls
, iTasks.UI.Editor.Containers
, iTasks.UI.Editor.Modifiers
......
......@@ -12,7 +12,7 @@ import iTasks.Internal.IWorld, iTasks.Internal.WebService, iTasks.Internal.SDSSe
import qualified iTasks.Internal.SDS as SDS
import iTasks.UI.Layout, iTasks.UI.Layout.Default
from iTasks.WF.Combinators.Tune import class tune(..), instance tune ApplyLayout, :: ApplyLayout(..)
from iTasks.WF.Combinators.Tune import class tune(..), instance tune ApplyLayout Task, :: ApplyLayout(..)
from iTasks.SDS.Combinators.Common import sdsFocus
import StdInt, StdChar, StdString
......
......@@ -5,7 +5,7 @@ from iTasks.Internal.IWorld import :: IWorld, :: SystemClocks
from iTasks.Engine import :: PublishedTask
from iTasks.Internal.Task import :: TaskEvalOpts, :: TaskResult
from iTasks.WF.Definition import :: Task, :: InstanceNo, class iTask
from iTasks.WF.Combinators.Tune import class tune
from iTasks.UI.Tune import class tune
from iTasks.SDS.Definition import :: SDS
import iTasks.Internal.Tonic.AbsSyn
......
......@@ -81,3 +81,4 @@ withClientSideInit ::
((JSObj ()) *JSWorld -> *JSWorld)
(DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt))
DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt)
......@@ -2,7 +2,7 @@ definition module iTasks.UI.Editor.Modifiers
/**
* This module provides combinator functions for combining editors
*/
import iTasks.UI.Editor, iTasks.UI.Definition
import iTasks.UI.Editor, iTasks.UI.Definition, iTasks.UI.Tune
import Data.Error
//### Modifying atributes of editors ###
......@@ -11,6 +11,8 @@ import Data.Error
*/
withAttributes :: UIAttributes (Editor a) -> Editor a
instance tune UIAttributes Editor
/**
* Adds a label attribute
* This does not create the actual label ui component, that is normally done by a layout
......
implementation module iTasks.UI.Editor.Modifiers
import StdBool
import iTasks.UI.Editor, iTasks.UI.Definition
import iTasks.UI.Editor, iTasks.UI.Definition, iTasks.UI.Tune
import Data.Error, Text.JSON
import GenEq
import qualified Data.Map as DM
......@@ -14,6 +14,10 @@ where
(Ok (UI type attr items,mask),vst) = (Ok (UI type ('DM'.union attr extra) items,mask),vst)
(e,vst) = (e,vst)
instance tune UIAttributes Editor
where
tune attr editor = withAttributes attr editor
withLabelAttr :: String (Editor a) -> Editor a
withLabelAttr label editor = withAttributes (labelAttr label) editor
......
......@@ -7,7 +7,8 @@ definition module iTasks.UI.Layout.Common
import iTasks.UI.Layout
from iTasks.UI.Definition import :: UISide(..), :: UIDirection(..), :: UIWindowType(..), :: UIHAlign(..), :: UIVAlign(..)
from iTasks.UI.Prompt import :: Title, :: Label, :: Icon
from iTasks.WF.Combinators.Tune import class tune
from iTasks.UI.Tune import class tune
from iTasks.WF.Definition import :: Task
/**
* Create a tabset with all child items as separate tabs
......@@ -62,19 +63,19 @@ insertToolBar :: [String] -> Layout
//Convenient annotatation types
:: ArrangeWithTabs = ArrangeWithTabs
instance tune ArrangeWithTabs
instance tune ArrangeWithTabs Task
:: ArrangeWithSideBar = ArrangeWithSideBar !Int !UISide !Int !Bool
instance tune ArrangeWithSideBar
instance tune ArrangeWithSideBar Task
:: ArrangeSplit = ArrangeSplit !UIDirection !Bool
instance tune ArrangeSplit
instance tune ArrangeSplit Task
:: ArrangeVertical = ArrangeVertical
instance tune ArrangeVertical
instance tune ArrangeVertical Task
:: ArrangeHorizontal = ArrangeHorizontal
instance tune ArrangeHorizontal
instance tune ArrangeHorizontal Task
//Changing container types
......@@ -87,23 +88,23 @@ toEmpty :: Layout
InWindow :== InFloatingWindow
InFloatingWindow :== ToWindow FloatingWindow AlignMiddle AlignCenter
InNotificationBubble :== ToWindow NotificationBubble AlignTop AlignRight
instance tune ToWindow
instance tune ToWindow Task
:: InPanel = InPanel //Indicate that a task should be wrapped in a panel
instance tune InPanel
instance tune InPanel Task
:: InContainer = InContainer //Indicate that a task should be wrapped in a panel
instance tune InContainer
instance tune InContainer Task
:: NoUserInterface = NoUserInterface //Replace the UI by an empty UI
instance tune NoUserInterface
instance tune NoUserInterface Task
actionToButton :: Layout
setActionIcon :: (Map String String) -> Layout
//Setting attributes
instance tune Title
instance tune Label
instance tune Icon
instance tune Title Task
instance tune Label Task
instance tune Icon Task
......@@ -123,51 +123,51 @@ where
>>= \(JSONString actionId) -> 'DM'.get actionId icons
>>= \icon -> return (iconClsAttr ("icon-"+++icon)))
instance tune ArrangeWithTabs
instance tune ArrangeWithTabs Task
where tune ArrangeWithTabs t = tune (ApplyLayout arrangeWithTabs) t
instance tune ArrangeWithSideBar
instance tune ArrangeWithSideBar Task
where
tune (ArrangeWithSideBar index side size resize) t = tune (ApplyLayout (arrangeWithSideBar index side size resize)) t
instance tune ArrangeSplit
instance tune ArrangeSplit Task
where
tune (ArrangeSplit direction resize) t = tune (ApplyLayout (arrangeSplit direction resize)) t
instance tune ArrangeVertical
instance tune ArrangeVertical Task
where
tune ArrangeVertical t = tune (ApplyLayout arrangeVertical) t
instance tune ArrangeHorizontal
instance tune ArrangeHorizontal Task
where
tune ArrangeHorizontal t = tune (ApplyLayout arrangeHorizontal) t
instance tune ToWindow
instance tune ToWindow Task
where
tune (ToWindow windowType vpos hpos) t = tune (ApplyLayout (toWindow windowType vpos hpos)) t
instance tune InPanel
instance tune InPanel Task
where
tune InPanel t = tune (ApplyLayout toPanel) t
instance tune InContainer
instance tune InContainer Task
where
tune InContainer t = tune (ApplyLayout toContainer) t
instance tune NoUserInterface
instance tune NoUserInterface Task
where
tune NoUserInterface (Task eval) = Task eval`
where
eval` event repOpts state iworld = eval event {repOpts & noUI = True} state iworld
instance tune Title
instance tune Title Task
where
tune (Title title) t = tune (ApplyLayout (setUIAttributes (titleAttr title)) ) t
instance tune Icon
instance tune Icon Task
where
tune (Icon icon) t = tune (ApplyLayout (setUIAttributes ('DM'.fromList [(ICON_ATTRIBUTE,JSONString icon)]))) t
instance tune Label
instance tune Label Task
where
tune (Label label) t = tune (ApplyLayout (setUIAttributes ('DM'.fromList [(LABEL_ATTRIBUTE,JSONString label)]))) t
definition module iTasks.UI.Tune
/**
* It is common to fine-tune the user interfaces of tasks.
* This module provides an overloaded way of annotating tasks or editors with attributes that
* change the behavior of the UI.
*/
from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import generic gEditor, generic gEq, generic gDefault, generic gText, generic JSONEncode, generic JSONDecode
from Data.Maybe import :: Maybe
from Text.JSON import :: JSONNode
from iTasks.UI.Editor import :: Editor
from iTasks.Internal.Generic.Visualization import :: TextFormat
class tune b f :: !b !(f a) -> f a
class tunev b a f | iTask a :: !(b a) !(f a) -> f a
/**
* Infix shorthands for the (overloaded) tune combinator.
*/
(<<@) infixl 2 :: !(f a) !b -> f a | tune b f
(@>>) infixr 2 :: !b !(f a) -> f a | tune b f
(<@@) infixl 2 :: !(f a) !(b a) -> f a | tunev b a f & iTask a
(@@>) infixr 2 :: !(b a) !(f a) -> f a | tunev b a f & iTask a
implementation module iTasks.UI.Tune
import iTasks.WF.Definition
class tune b f :: !b !(f a) -> f a
class tunev b a f | iTask a :: !(b a) !(f a) -> f a
(<<@) infixl 2 :: !(f a) !b -> f a | tune b f
(<<@) t a = tune a t
(@>>) infixr 2 :: !b !(f a) -> f a | tune b f
(@>>) a t = tune a t
(<@@) infixl 2 :: !(f a) !(b a) -> f a | tunev b a f & iTask a
(<@@) t a = tunev a t
(@@>) infixr 2 :: !(b a) !(f a) -> f a | tunev b a f & iTask a
(@@>) a t = tunev a t
......@@ -4,7 +4,7 @@ definition module iTasks.WF.Combinators.Common
*/
import iTasks.SDS.Definition
import iTasks.WF.Combinators.Core
import iTasks.WF.Combinators.Tune
import iTasks.UI.Tune
from Data.Map import :: Map
from Data.Either import :: Either
......@@ -102,13 +102,6 @@ tbind :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
*/
(@!) infixl 1 :: !(Task a) !b -> Task b
/**
* Infix shorthands for the (overloaded) tune combinator.
*/
(<<@) infixl 2 :: !(Task a) !b -> Task a | tune b
(@>>) infixr 2 :: !b !(Task a) -> Task a | tune b
(<@@) infixl 2 :: !(Task a) !(b a) -> Task a | tunev b a & iTask a
(@@>) infixr 2 :: !(b a) !(Task a) -> Task a | tunev b a & iTask a
/**
* 'Sidestep' combinator. This combinator has a similar signature as the core 'step'
* combinator, but instead of moving forward to a next step, the selected step is executed
* in parallel with the first task. When the chosen task step becomes stable, it is removed
......
......@@ -18,6 +18,7 @@ import iTasks.WF.Tasks.SDS
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Core, iTasks.WF.Combinators.Tune, iTasks.WF.Combinators.Overloaded
import iTasks.UI.Prompt
import iTasks.UI.Tune
import iTasks.UI.Layout
import iTasks.UI.Layout.Common, iTasks.UI.Layout.Default
......@@ -48,18 +49,6 @@ tbind taska taskbf = step taska (const Nothing) [OnAction ActionContinue (hasVal
(@!) infixl 1 :: !(Task a) !b -> Task b
(@!) task b = transform (fmap (const b)) task
(<<@) infixl 2 :: !(Task a) !b -> Task a | tune b
(<<@) t a = tune a t
(@>>) infixr 2 :: !b !(Task a) -> Task a | tune b
(@>>) a t = tune a t
(<@@) infixl 2 :: !(Task a) !(b a) -> Task a | tunev b a & iTask a
(<@@) t a = tunev a t
(@@>) infixr 2 :: !(b a) !(Task a) -> Task a | tunev b a & iTask a
(@@>) a t = tunev a t
try :: !(Task a) (e -> Task a) -> Task a | iTask a & iTask, toString e
try task handler = step task id [OnValue (ifStable return), OnException handler]
......
definition module iTasks.WF.Combinators.Tune
import iTasks.WF.Definition
from iTasks.UI.Tune import class tune(..)
from iTasks.UI.Layout import :: Layout
from Text.JSON import :: JSONNode
......@@ -8,20 +9,18 @@ from Text.JSON import :: JSONNode
* Fine tune a task by specifying custom layouts, tweaking generic layouts,
* or add additional titles, hints and descriptions
*/
class tune b :: !b !(Task a) -> Task a
class tunev b a | iTask a :: !(b a) !(Task a) -> Task a
//* Fine tune evaluation behaviour
:: LazyRefresh = LazyRefresh
instance tune LazyRefresh
instance tune LazyRefresh Task
//* Apply a layout to a task
:: ApplyLayout = ApplyLayout Layout
instance tune ApplyLayout
instance tune ApplyLayout Task
:: ApplyAttribute a = ApplyAttribute String a
class toAttribute a where toAttribute :: a -> JSONNode
instance toAttribute String
instance tune (ApplyAttribute a) | toAttribute a
instance tune (ApplyAttribute a) Task | toAttribute a
......@@ -2,6 +2,7 @@ implementation module iTasks.WF.Combinators.Tune
import iTasks.WF.Definition
import iTasks.UI.Definition
import iTasks.UI.Tune
import iTasks.UI.Layout
import iTasks.Internal.TaskState
......@@ -16,10 +17,7 @@ derive JSONDecode LayoutState, LayoutTree, MvUI, MvUIChild
/*
* Tuning of tasks
*/
class tune b :: !b !(Task a) -> Task a
class tunev b a | iTask a :: !(b a) !(Task a) -> Task a
instance tune LazyRefresh
instance tune LazyRefresh Task
where
tune _ (Task eval) = Task eval`
where
......@@ -28,7 +26,7 @@ where
(ValueResult value info rep tree,iworld) = (ValueResult value {TaskEvalInfo|info&refreshSensitive=False} rep tree, iworld)
(res,iworld) = (res,iworld)
instance tune ApplyLayout
instance tune ApplyLayout Task
where
tune (ApplyLayout l) task=:(Task evala) = Task eval
where
......@@ -64,7 +62,7 @@ where
class toAttribute a where toAttribute :: a -> JSONNode
instance toAttribute String where toAttribute s = JSONString s
instance tune (ApplyAttribute a) | toAttribute a
instance tune (ApplyAttribute a) Task | toAttribute a
where
tune (ApplyAttribute k v) task = tune (ApplyLayout (setUIAttributes ('DM'.fromList [(k,toAttribute v)]))) task
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