Commit 1c8b75d5 authored by Bas Lijnse's avatar Bas Lijnse

Moved common SDS combinators to iTasks.SDS.Combinators.Common

parent 9c99751f
......@@ -7,6 +7,7 @@ import iTasks._Framework.Engine // iTasks engine
// iTasks API
, iTasks.SDS.Definition
, iTasks.SDS.Combinators.Core
, iTasks.SDS.Combinators.Common
, iTasks.SDS.Sources.Core
, iTasks.SDS.Sources.Store
, iTasks.SDS.Sources.System
......
......@@ -17,8 +17,5 @@ import
, iTasks.API.Core.TaskCombinators // The core iTask combinators
, iTasks.API.Common.TaskCombinators // Set of derived useful iTask combinators
// Shared data sources
, iTasks.API.Common.SDSCombinators
// Layout tuning
, iTasks.UI.Layout
......@@ -9,8 +9,8 @@ from Data.Map import qualified get, put
import StdBool, StdList, StdMisc, StdTuple, Data.Functor
import iTasks.API.Core.Tasks, iTasks.API.Core.TaskCombinators
import iTasks.API.Common.TaskCombinators
import iTasks.API.Common.SDSCombinators
import iTasks.SDS.Sources.Core, iTasks.SDS.Sources.System
import iTasks.SDS.Combinators.Common
import iTasks._Framework.Util
import iTasks.UI.Layout, iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Prompt, iTasks.UI.Editor.Builtin
import Text.HTML
......
definition module iTasks.API.Common.SDSCombinators
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ROShared, :: SDSNotifyPred, :: Shared, :: ReadOnlyShared, :: ReadWriteShared
from iTasks._Framework.Task import :: TaskException, :: TaskValue, :: TaskId
from iTasks._Framework.Generic import class iTask, generic gEditor, generic gEq, generic gDefault, generic gText
from iTasks._Framework.Generic.Visualization import :: TextFormat
from iTasks.UI.Editor import :: Editor, :: EditMask, :: Masked
from iTasks.API.Core.Types import :: TaskList, :: TaskListFilter, :: TaskListItem, :: SharedTaskList, :: TaskAttributes, :: InstanceProgress
from Data.Maybe import :: Maybe
from Data.Either import :: Either
from Data.Error import :: MaybeError, :: MaybeErrorString
from Data.Map import :: Map
from Data.IntMap.Strict import :: IntMap
from StdOverloaded import class <
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
:: SDSReadProjection rs rt
= SDSLensRead (rs -> MaybeError TaskException rt) //Read lens-like
| SDSConstRead rt //No need to read the original source
:: SDSWriteProjection rs ws wt
= SDSLensWrite (rs wt -> MaybeError TaskException (Maybe ws)) //Write lens-like
| SDSBlindWrite (wt -> MaybeError TaskException (Maybe ws)) //No-need to read the original source
| SDSNoWrite
// Fix a focus parameter
sdsFocus :: !p !(RWShared p r w) -> (RWShared p` r w) | iTask p
// Projection of the domain with a lens
sdsProject :: !(SDSReadProjection rs r) !(SDSWriteProjection rs ws w) !(RWShared p rs ws) -> RWShared p r w | iTask p
// Translate the parameter space
sdsTranslate :: !String !(p -> ps) !(RWShared ps r w) -> RWShared p r w | iTask ps
// Introduce a new parameter
sdsSplit :: !String !(p -> (ps,pn)) !(pn rs -> r) !(pn rs w -> (ws,SDSNotifyPred pn)) !(RWShared ps rs ws) -> RWShared p r w | iTask ps & iTask pn
/**
* Maps the read type, the write type or both of a shared reference to another one using a functional mapping.
* The function for mapping the write type also gets the current read-value as input
* making it possible to change only parts of the datastructure.
*
* @param A functional mapping
* @param A reference to shared data
* @return A reference to shared data of another type
*/
mapRead :: !(r -> r`) !(RWShared p r w) -> RWShared p r` w | iTask p
mapWrite :: !(w` r -> Maybe w) !(RWShared p r w) -> RWShared p r w` | iTask p
mapReadWrite :: !(!r -> r`,!w` r -> Maybe w) !(RWShared p r w) -> RWShared p r` w` | iTask p
mapReadError :: !(r -> MaybeError TaskException r`) !(RWShared p r w) -> RWShared p r` w | iTask p
mapWriteError :: !(w` r -> MaybeError TaskException (Maybe w)) !(RWShared p r w) -> RWShared p r w` | iTask p
mapReadWriteError :: !(!r -> MaybeError TaskException r`,!w` r -> MaybeError TaskException (Maybe w)) !(RWShared p r w) -> RWShared p r` w` | iTask p
toReadOnly :: !(RWShared p r w) -> ROShared p r | iTask p
toDynamic :: !(RWShared p r w) -> (RWShared p Dynamic Dynamic) | iTask p & TC r & TC w
//Map a list SDS of one element to the element itsel
mapSingle :: !(RWShared p [r] [w]) -> (RWShared p r w) | iTask p
// Composition of two shared references.
// The read type is a tuple of both types.
// The write type can either be a tuple of both write types, only one of them or it is written to none of them (result is a read-only shared).
// START DEPRECATED
(>+<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) (wx,wy) | iTask p
(>+|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wx | iTask p
(|+<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wy | iTask p
(|+|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) () | iTask p
// END DEPRECATED
(>*<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) (wx,wy) | iTask p
(>*|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wx | iTask p
(|*<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wy | iTask p
(|*|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) () | iTask p
/**
* Puts a symmetric lens between two symmetric shared data sources.
* Changes of one also affects the other one.
*
* @param putr: used to map changes of shared a to shared b
* @param putl: used to map changes of shared b to shared a
* @param SymmetricShared a
* @param SymmetricShared b
* @param RWShared references of the same type with symmetric lens between them
*/
symmetricLens :: !(a b -> b) !(b a -> a) !(RWShared p a a) !(RWShared p b b) -> (!RWShared p a a, !RWShared p b b) | iTask p
//Derived versions of tasks lists
/**
* Get the shared state of a task list
*/
taskListState :: !(SharedTaskList a) -> ReadOnlyShared [TaskValue a]
/**
* Get the meta data sds of a task list
*/
taskListMeta :: !(SharedTaskList a) -> ReadWriteShared [TaskListItem a] [(TaskId,TaskAttributes)]
/**
* Get the list of task id's in a task list
*/
taskListIds :: !(SharedTaskList a) -> ROShared () [TaskId]
/**
* Get the meta data sds for a specific entry in a task list
*/
taskListEntryMeta :: !(SharedTaskList a) -> RWShared TaskId (TaskListItem a) TaskAttributes
/*
* Get the id of the entry in the list the current task is part of
*/
taskListSelfId :: !(SharedTaskList a) -> ReadOnlyShared TaskId
/**
* Get the current tasks management meta data share
*/
taskListSelfManagement :: !(SharedTaskList a) -> Shared TaskAttributes
/**
* Get the value of a specific task in the list
* The paramater is either the index in the list or a specific task id
*/
taskListItemValue :: !(SharedTaskList a) -> ROShared (Either Int TaskId) (TaskValue a)
/**
* Get the progress of a specific task in the list
* The paramater is either the index in the list or a specific task id
*/
taskListItemProgress :: !(SharedTaskList a) -> ROShared (Either Int TaskId) InstanceProgress
/**
* Convenience lens for lookups in Maps. Returns Nothing on a missing key.
*/
mapMaybeLens :: !String !(RWShared () (Map a b) (Map a b)) -> RWShared a (Maybe b) b | < a & == a
/**
* Convenience lens for lookups in Maps. Can use a default value on a missing key, gives an error if no default is supplied.
*/
mapLens :: !String !(RWShared () (Map a b) (Map a b)) !(Maybe b) -> RWShared a b b | < a & == a
/**
* Convenience lens for lookups in IntMaps. Can use a default value on a missing key, gives an error if no default is supplied.
*/
intMapLens :: !String !(RWShared () (IntMap a) (IntMap a)) !(Maybe a) -> RWShared Int a a
This diff is collapsed.
......@@ -8,11 +8,11 @@ import iTasks._Framework.Util
from StdFunc import id, const, o
from iTasks.SDS.Sources.Core import randomInt
from iTasks.SDS.Sources.System import currentDateTime, topLevelTasks
import iTasks.SDS.Combinators.Common
from iTasks._Framework.TaskState import :: TaskTree(..), :: DeferredJSON
import qualified Data.Map as DM
import iTasks.API.Core.Tasks, iTasks.API.Core.TaskCombinators, iTasks.API.Common.InteractionTasks, iTasks.UI.Layout, iTasks.UI.Prompt
import iTasks.API.Common.SDSCombinators
import iTasks.UI.Layout.Common, iTasks.UI.Layout.Default
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
......
......@@ -18,7 +18,7 @@ from iTasks._Framework.Serialization import JSONEncode, JSONDecode, dynamicJSONE
from iTasks._Framework.TaskStore import localShare, parallelTaskList, topLevelTaskList
from iTasks._Framework.SDS import write, read, readRegister
import iTasks.API.Core.Types
from iTasks.API.Common.SDSCombinators import sdsFocus, sdsSplit, sdsTranslate, toReadOnly, mapRead, mapReadWriteError, mapSingle
from iTasks.SDS.Combinators.Common import sdsFocus, sdsSplit, sdsTranslate, toReadOnly, mapRead, mapReadWriteError, mapSingle
derive class iTask ParallelTaskType, AttachmentStatus
derive gEq ParallelTaskChange
......
......@@ -6,7 +6,7 @@ import iTasks._Framework.Util, iTasks._Framework.HtmlUtil, iTasks._Framework.Tas
import iTasks._Framework.Generic, iTasks._Framework.Task, iTasks._Framework.TaskState
import iTasks._Framework.TaskEval, iTasks._Framework.TaskStore, iTasks.UI.Definition, iTasks._Framework.IWorld
import iTasks.UI.Layout, iTasks.UI.Editor, iTasks.UI.Prompt
import iTasks.API.Common.SDSCombinators
import iTasks.SDS.Combinators.Common
from iTasks._Framework.SDS as SDS import qualified read, readRegister, write, modify
from StdFunc import o, id
......
......@@ -2,3 +2,140 @@ definition module iTasks.SDS.Combinators.Common
/**
* This module provides common patterns for composing shared sources defined on top of the core set
*/
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ROShared, :: SDSNotifyPred, :: Shared, :: ReadOnlyShared, :: ReadWriteShared
from iTasks._Framework.Task import :: TaskException, :: TaskValue, :: TaskId
from iTasks._Framework.Generic import class iTask, generic gEditor, generic gEq, generic gDefault, generic gText
from iTasks._Framework.Generic.Visualization import :: TextFormat
from iTasks.UI.Editor import :: Editor, :: EditMask, :: Masked
from iTasks.API.Core.Types import :: TaskList, :: TaskListFilter, :: TaskListItem, :: SharedTaskList, :: TaskAttributes, :: InstanceProgress
from Data.Maybe import :: Maybe
from Data.Either import :: Either
from Data.Error import :: MaybeError, :: MaybeErrorString
from Data.Map import :: Map
from Data.IntMap.Strict import :: IntMap
from StdOverloaded import class <
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
:: SDSReadProjection rs rt
= SDSLensRead (rs -> MaybeError TaskException rt) //Read lens-like
| SDSConstRead rt //No need to read the original source
:: SDSWriteProjection rs ws wt
= SDSLensWrite (rs wt -> MaybeError TaskException (Maybe ws)) //Write lens-like
| SDSBlindWrite (wt -> MaybeError TaskException (Maybe ws)) //No-need to read the original source
| SDSNoWrite
// Fix a focus parameter
sdsFocus :: !p !(RWShared p r w) -> (RWShared p` r w) | iTask p
// Projection of the domain with a lens
sdsProject :: !(SDSReadProjection rs r) !(SDSWriteProjection rs ws w) !(RWShared p rs ws) -> RWShared p r w | iTask p
// Translate the parameter space
sdsTranslate :: !String !(p -> ps) !(RWShared ps r w) -> RWShared p r w | iTask ps
// Introduce a new parameter
sdsSplit :: !String !(p -> (ps,pn)) !(pn rs -> r) !(pn rs w -> (ws,SDSNotifyPred pn)) !(RWShared ps rs ws) -> RWShared p r w | iTask ps & iTask pn
/**
* Maps the read type, the write type or both of a shared reference to another one using a functional mapping.
* The function for mapping the write type also gets the current read-value as input
* making it possible to change only parts of the datastructure.
*
* @param A functional mapping
* @param A reference to shared data
* @return A reference to shared data of another type
*/
mapRead :: !(r -> r`) !(RWShared p r w) -> RWShared p r` w | iTask p
mapWrite :: !(w` r -> Maybe w) !(RWShared p r w) -> RWShared p r w` | iTask p
mapReadWrite :: !(!r -> r`,!w` r -> Maybe w) !(RWShared p r w) -> RWShared p r` w` | iTask p
mapReadError :: !(r -> MaybeError TaskException r`) !(RWShared p r w) -> RWShared p r` w | iTask p
mapWriteError :: !(w` r -> MaybeError TaskException (Maybe w)) !(RWShared p r w) -> RWShared p r w` | iTask p
mapReadWriteError :: !(!r -> MaybeError TaskException r`,!w` r -> MaybeError TaskException (Maybe w)) !(RWShared p r w) -> RWShared p r` w` | iTask p
toReadOnly :: !(RWShared p r w) -> ROShared p r | iTask p
toDynamic :: !(RWShared p r w) -> (RWShared p Dynamic Dynamic) | iTask p & TC r & TC w
//Map a list SDS of one element to the element itsel
mapSingle :: !(RWShared p [r] [w]) -> (RWShared p r w) | iTask p
// Composition of two shared references.
// The read type is a tuple of both types.
// The write type can either be a tuple of both write types, only one of them or it is written to none of them (result is a read-only shared).
// START DEPRECATED
(>+<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) (wx,wy) | iTask p
(>+|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wx | iTask p
(|+<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wy | iTask p
(|+|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) () | iTask p
// END DEPRECATED
(>*<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) (wx,wy) | iTask p
(>*|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wx | iTask p
(|*<) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) wy | iTask p
(|*|) infixl 6 :: !(RWShared p rx wx) !(RWShared p ry wy) -> RWShared p (rx,ry) () | iTask p
/**
* Puts a symmetric lens between two symmetric shared data sources.
* Changes of one also affects the other one.
*
* @param putr: used to map changes of shared a to shared b
* @param putl: used to map changes of shared b to shared a
* @param SymmetricShared a
* @param SymmetricShared b
* @param RWShared references of the same type with symmetric lens between them
*/
symmetricLens :: !(a b -> b) !(b a -> a) !(RWShared p a a) !(RWShared p b b) -> (!RWShared p a a, !RWShared p b b) | iTask p
//Derived versions of tasks lists
/**
* Get the shared state of a task list
*/
taskListState :: !(SharedTaskList a) -> ReadOnlyShared [TaskValue a]
/**
* Get the meta data sds of a task list
*/
taskListMeta :: !(SharedTaskList a) -> ReadWriteShared [TaskListItem a] [(TaskId,TaskAttributes)]
/**
* Get the list of task id's in a task list
*/
taskListIds :: !(SharedTaskList a) -> ROShared () [TaskId]
/**
* Get the meta data sds for a specific entry in a task list
*/
taskListEntryMeta :: !(SharedTaskList a) -> RWShared TaskId (TaskListItem a) TaskAttributes
/*
* Get the id of the entry in the list the current task is part of
*/
taskListSelfId :: !(SharedTaskList a) -> ReadOnlyShared TaskId
/**
* Get the current tasks management meta data share
*/
taskListSelfManagement :: !(SharedTaskList a) -> Shared TaskAttributes
/**
* Get the value of a specific task in the list
* The paramater is either the index in the list or a specific task id
*/
taskListItemValue :: !(SharedTaskList a) -> ROShared (Either Int TaskId) (TaskValue a)
/**
* Get the progress of a specific task in the list
* The paramater is either the index in the list or a specific task id
*/
taskListItemProgress :: !(SharedTaskList a) -> ROShared (Either Int TaskId) InstanceProgress
/**
* Convenience lens for lookups in Maps. Returns Nothing on a missing key.
*/
mapMaybeLens :: !String !(RWShared () (Map a b) (Map a b)) -> RWShared a (Maybe b) b | < a & == a
/**
* Convenience lens for lookups in Maps. Can use a default value on a missing key, gives an error if no default is supplied.
*/
mapLens :: !String !(RWShared () (Map a b) (Map a b)) !(Maybe b) -> RWShared a b b | < a & == a
/**
* Convenience lens for lookups in IntMaps. Can use a default value on a missing key, gives an error if no default is supplied.
*/
intMapLens :: !String !(RWShared () (IntMap a) (IntMap a)) !(Maybe a) -> RWShared Int a a
This diff is collapsed.
......@@ -2,7 +2,7 @@ implementation module iTasks.SDS.Sources.Store
import iTasks.SDS.Definition
import iTasks.SDS.Combinators.Core
import iTasks.API.Common.SDSCombinators
import iTasks.SDS.Combinators.Common
import iTasks._Framework.SDS
import iTasks._Framework.Store
......
......@@ -2,7 +2,7 @@ implementation module iTasks.SDS.Sources.System
import iTasks.SDS.Definition
import iTasks.SDS.Combinators.Core
import iTasks.API.Common.SDSCombinators
import iTasks.SDS.Combinators.Common
import iTasks.API.Core.Types
import System.Time
......
......@@ -9,11 +9,11 @@ import Data.List, Data.Error, Data.Func, Data.Tuple, Math.Random, Text
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
import iTasks._Framework.Util, iTasks._Framework.HtmlUtil
import iTasks._Framework.IWorld, iTasks._Framework.WebService, iTasks._Framework.SDSService
import iTasks.API.Common.SDSCombinators
import qualified iTasks._Framework.SDS as SDS
import iTasks.UI.Layout, iTasks.UI.Layout.Default
from iTasks.API.Core.TaskCombinators import class tune(..)
from iTasks.UI.Layout import instance tune ApplyLayout
from iTasks.SDS.Combinators.Common import sdsFocus
import StdInt, StdChar, StdString
......
......@@ -20,7 +20,7 @@ from iTasks._Framework.Serialization import serialize, deserialize, functionFree
from iTasks.UI.Editor.Generic import generic gEditor
from iTasks.API.Core.Types import :: DateTime, :: Config, :: TaskId, :: TaskNo, :: InstanceNo, :: TaskListItem, :: TaskTime, :: SessionId
from iTasks.SDS.Combinators.Core import sdsLens
from iTasks.API.Common.SDSCombinators import >+<, sdsFocus
from iTasks.SDS.Combinators.Common import >+<, sdsFocus
from System.Time import :: Timestamp(..), instance < Timestamp, instance toInt Timestamp
from GenEq import generic gEq
......
......@@ -13,7 +13,7 @@ from System.OSError import :: MaybeOSError
import iTasks.UI.Editor, iTasks.UI.Editor.Common
from iTasks._Framework.TaskState import :: TaskTree(..), :: DeferredJSON(..), :: TIMeta(..)
from iTasks.API.Common.SDSCombinators import toDynamic
from iTasks.SDS.Combinators.Common import toDynamic
from iTasks._Framework.Serialization import JSONEncode, JSONDecode, dynamicJSONEncode, dynamicJSONDecode
import qualified Data.CircularStack as DCS
from Data.CircularStack import :: CircularStack
......
......@@ -13,7 +13,7 @@ from Data.Map as DM import qualified newMap, fromList, toList, get, p
from Data.Queue import :: Queue (..)
from Data.Queue as DQ import qualified newQueue, enqueue, dequeue, empty
from iTasks._Framework.SDS as SDS import qualified read, write, modify
from iTasks.API.Common.SDSCombinators import sdsFocus, >+|, mapReadWrite, mapReadWriteError
from iTasks.SDS.Combinators.Common import sdsFocus, >+|, mapReadWrite, mapReadWriteError
from StdFunc import const
derive gEq TIMeta
......
......@@ -17,7 +17,7 @@ import iTasks._Framework.IWorld
import iTasks._Framework.Task
import iTasks._Framework.TaskEval
from iTasks._Framework.TaskStore import queueRefresh
import iTasks.API.Common.SDSCombinators
import iTasks.SDS.Combinators.Common
//Helper type that holds the mainloop instances during a select call
//in these mainloop instances the unique listeners and read channels
......
......@@ -10,7 +10,7 @@ import iTasks._Framework.Serialization
import qualified iTasks._Framework.SDS as SDS
from iTasks.SDS.Definition import :: SDSLensRead(..), :: SDSLensWrite(..), :: SDSLensNotify(..), :: SDS(SDSDynamic)
import iTasks.SDS.Combinators.Core, iTasks.API.Common.SDSCombinators
import iTasks.SDS.Combinators.Core, iTasks.SDS.Combinators.Common
import iTasks._Framework.SDSService
import iTasks._Framework.Client.Override
......
......@@ -13,7 +13,7 @@ import System.Time, Text, Text.JSON, Internet.HTTP, Data.Error
import System.File, System.FilePath, System.Directory
import iTasks._Framework.Task, iTasks._Framework.TaskState, iTasks._Framework.TaskEval, iTasks._Framework.TaskStore
import iTasks.UI.Definition, iTasks._Framework.Util, iTasks._Framework.HtmlUtil, iTasks._Framework.Engine, iTasks._Framework.IWorld
import iTasks.API.Common.SDSCombinators
import iTasks.SDS.Combinators.Common
import iTasks.API.Core.Types
import Crypto.Hash.SHA1, Text.Encodings.Base64, Text.Encodings.MIME
import Text.HTML
......
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