--- /dev/null
+\e[?25l\e[J\e[J\e[J\e[J\e[J\e[J\e[34h\e[?25h\e[?1049h\e[?1h\e=\e[1;54r\e[23m\e[24m\e[0m\e[H\e[J\e[?25l\e[54;1H"Clean System Files" is a directory\e[2;1H\e[1m\e[34m~ \e[3;1H~ \e[4;1H~ \e[5;1H~ \e[6;1H~ \e[7;1H~ \e[8;1H~ \e[9;1H~ \e[10;1H~ \e[11;1H~ \e[12;1H~ \e[13;1H~ \e[14;1H~ \e[15;1H~ \e[16;1H~ \e[17;1H~ \e[18;1H~ \e[19;1H~ \e[20;1H~ \e[21;1H~ \e[22;1H~ \e[23;1H~ \e[24;1H~ \e[25;1H~ \e[26;1H~ \e[27;1H~ \e[28;1H~ \e[29;1H~ \e[30;1H~ \e[31;1H~ \e[32;1H~ \e[33;1H~ \e[34;1H~ \e[35;1H~ \e[36;1H~ \e[37;1H~ \e[38;1H~ \e[39;1H~ \e[40;1H~ \e[41;1H~ \e[42;1H~ \e[43;1H~ \e[44;1H~ \e[45;1H~ \e[46;1H~ \e[47;1H~ \e[48;1H~ \e[49;1H~ \e[50;1H~ \e[51;1H~ \e[52;1H~ \e[53;1H~ \e[1;1H\e[34h\e[?25h\e[?25l\e[0m\e[54;1H\e[1m-- VISUAL --\e[0m\e[54;13H\e[K\e[1;1H\e[34h\e[?25h\a\e[?25l\e[34h\e[?25h\e[?25l\e[34h\e[?25h\a\e[?25l\e[34h\e[?25h\e[?25l\e[34h\e[?25h\e[?25l\e[34h\e[?25h\e[?25l\e[54;1H\e[K\e[1;1H\e[34h\e[?25h\e[?25l\e[54;1HType :qa! and press <Enter> to abandon all changes and exit Vim\a\e[1;1H\e[34h\e[?25h\e[?25l\e[34h\e[?25h\e[?25l\e[34h\e[?25h\e[?25l\e[34h\e[?25h\a\a\e[54;1H\e[?1l\e>\e[?1049lVim: Error reading input, exiting...\r
+Vim: Finished.\r
+\e[54;1H\e[34h\e[?25h6 files to edit
module test
-from StdFunc import seq, seqList, :: St
-import StdFunctions
-import System.Directory
-import System.File
-import System.FilePath
-import Data.Tuple
-import Data.Func
-import Data.Bifunctor
-import iTasks
-import iTasks.Internal.Util
+import iTasks.Extensions.Files
-derive class iTask RTree, FileInfo, Tm
-
-Start w = startEngine
- (viewSharedInformation () []
- $ mapRead (map fst)
- $ sdsFocus "/opt/clean/lib/StdLib" directoryShare
- ) w
-
-instance toString OSError where toString (_, e) = e
-instance Bifunctor MaybeError
-where
- bifmap fa fb (Error a) = Error (fa a)
- bifmap fa fb (Ok b) = Ok (fb b)
- first fa fab = bifmap fa id fab
- second fb fab = bifmap id fb fab
-
-selectFile :: FilePath -> Task FilePath
-selectFile root = get (sdsFocus root directoryShare)
- >>= \cs->withShared (RNode root (map fst cs)) \tree->
- editSelectionWithShared () False selectOption (mapRead numberTree tree)
- (\tree->[i\\(i, (f, _))<-leafs tree])
-
-selectFile :: !FilePath !d !Bool [FilePath]-> Task [FilePath] | toPrompt d
-selectFile root prompt multi initial
- = accWorld (createDirectoryTree root) @ numberTree
- >>= \tree->editSelection prompt multi selectOption tree
- [i\\(i, (f, _))<-leafs tree | elem f initial]
-where
- selectOption = SelectInTree
- (\tree->[{foldTree fp2cn tree & label=root}])
- (\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel])
-
- fp2cn (i, (fp, mfi)) cs =
- { id = case mfi of
- Error e = ~i
- Ok {directory=True} = ~i
- _ = i
- , label=dropDirectory fp
- , icon=Nothing
- , expanded=False
- , children=cs
- }
-
- numberTree :: ((RTree a) -> RTree (Int, a))
- numberTree = flip evalState zero o foldTree \a cs->
- (\lvs i->RNode (i, a) lvs) <$> 'CM'.sequence cs <*> getState <* modify inc
-
-
-
-
-
- =
-
-directoryShare :: ROShared FilePath [(FilePath, MaybeOSError FileInfo)]
-directoryShare = SDSSource {SDSSource | name = "directoryShare", read = read, write=write}
-where
- read p iw
- # (merr, iw) = liftIWorld (readDirectory p) iw
- | isError merr = (liftError (first exception merr), iw)
- # (Ok files) = merr
- # (fis, iw) = liftIWorld (seqList (map getFileInfo files)) iw
- = (Ok $ sortBy fst [(f, fi)\\f<-files & fi<-fis], iw)
-
- write p w iw = (Ok (const (const False)), iw)
-//import iTasks
-//import iTasks.Extensions.Files
-//
-//Start w = startEngine (
-// selectFile "/opt/clean/lib" () False []
-// >&> viewSharedInformation "Selection" []) w
+Start w = startEngine (
+ selectFileTreeLazy "select a file" False "/opt/clean"
+ -&&- selectFileTree False "select a file" False "/opt/clean"[]
+ >&> viewSharedInformation "selection" []) w
--- /dev/null
+module test
+
+import iTasks
+import iTasks.Extensions.FileDialog
+
+Start w = startEngine (editFilePath "bork" (Action "Ok") (Just "/opt/clean")) w
--- /dev/null
+definition module EditorExt
+
+from iTasks.UI.Editor import :: Editor
+
+row :: String (Editor a) -> Editor a
+
+choose :: [(String, Editor a)] -> Editor (Int, a)
--- /dev/null
+implementation module EditorExt
+
+from Data.Func import $
+import Data.Tuple
+import qualified Data.Map as DM
+import StdTuple
+import Data.Maybe
+
+import iTasks
+import iTasks.UI.Editor.Common
+
+row :: String (Editor a) -> Editor a
+row l e = bijectEditorValue (tuple l) snd $
+ container2 label e <<@ directionAttr Horizontal
+
+import StdDebug, StdMisc
+
+// Choose combinators (Used for selecting constructors in ADTs)
+choose :: [(String, Editor a)] -> Editor (Int, a)
+choose [] = emptyEditor
+choose [(k,v)] = bijectEditorValue snd (tuple 0) $ row k v
+choose cs = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
+where
+ numConses = length cs
+ conses = map fst cs
+
+ genUI dp (consindex, value) vst=:{VSt|taskId,mode,optional,selectedConsIndex}
+ # cured = snd (cs !! consindex)
+ = case mode of
+ Enter
+ # (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses Nothing
+ = (Ok (UI UIVarCons 'DM'.newMap [consChooseUI],CompoundMask {fields=[consChooseMask],state=JSONNull}),{vst & selectedConsIndex = selectedConsIndex})
+ Update
+ = case cured.Editor.genUI dp value vst of
+ (Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
+ # (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses (Just vst.selectedConsIndex)
+ = (Ok (UI UIVarCons attr [consChooseUI:items],CompoundMask {fields=[consChooseMask:fields],state=JSONNull})
+ ,{vst & selectedConsIndex = selectedConsIndex})
+ (Error e,vst) = (Error e,vst)
+ View
+ = case cured.Editor.genUI dp value vst of
+ (Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
+ # (consViewUI,consViewMask) = genConsViewUI conses vst.selectedConsIndex
+ = (Ok (UI UIVarCons attr [consViewUI:items],CompoundMask {fields=[consViewMask:fields],state=JSONNull})
+ ,{vst & selectedConsIndex = selectedConsIndex})
+ (Error e,vst) = (Error e,vst)
+
+ genConsChooseUI taskId dp optional gtd_conses mbSelectedCons = (consChooseUI,consChooseMask)
+ where
+ consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gdc)] \\ gdc <- gtd_conses & i <- [0..]]
+ consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) (maybeToList mbSelectedCons) consOptions)
+ consChooseMask = FieldMask {touched=False,valid=optional || isJust mbSelectedCons,state=maybe JSONNull JSONInt mbSelectedCons}
+
+ genConsViewUI gtd_conses selectedCons
+ = (uia UITextView (valueAttr (JSONString (gtd_conses !! selectedCons))), newFieldMask)
+
+ //Update is a constructor switch
+ onEdit dp ([],JSONArray [JSONInt consIdx]) (i, val) (CompoundMask {fields=[FieldMask {FieldMask|touched,valid,state}:masks]}) vst//=:{VSt|mode}
+ | not (trace_tn ("cons switch from " +++ toString i +++ " to " +++ toString consIdx)) = undef
+ # cured = snd (cs !! consIdx)
+ | consIdx < 0 || consIdx >= numConses
+ = (Error "Constructor selection out of bounds", (i, val),vst)
+ //Create a default value for the selected constructor
+ //This is a rather ugly trick: We create a special target path that consists only of negative values that is
+ //decoded by the the onEdit instance of EITHER to create a value that consists of the correct nesting of LEFT's and RIGHT's
+ // //TODO hier zit de bug
+ # (_,val,vst) = cured.Editor.onEdit dp (consCreatePath consIdx numConses,JSONNull) val newCompoundMask vst
+ //Create a UI for the new constructor
+ = case cured.Editor.genUI dp val {vst & mode = Enter} of
+ (Ok (UI _ attr items, CompoundMask {fields=masks}),vst)
+ //Construct a UI change that does the following:
+ //1: If necessary remove the fields of the previously selected constructor
+ # removals = case state of
+// (JSONInt prevConsIdx) = repeatn (length (snd (cs !! prevConsIdx))) (1,RemoveChild)
+// (JSONInt prevConsIdx) = repeatn (length items) (1,RemoveChild)
+ _ = []
+ //2: Inserts the fields of the newly created ui
+ # inserts = [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
+ # change = ChangeUI [] (removals ++ inserts)
+ //Create a new mask for the constructor selection
+ # consChooseMask = FieldMask {touched=True,valid=True,state=JSONInt consIdx}
+ = (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}), (consIdx, val), vst)
+ (Error e,vst) = (Error e, (i, val), vst)
+
+ //Other events targeted directly at the ADT
+ onEdit dp ([],e) (i, val) (CompoundMask {fields=[consChooseMask=:(FieldMask {FieldMask|touched,valid,state}):masks]}) vst=:{VSt|optional}
+ | e =: JSONNull || e =: (JSONArray []) // A null or an empty array are accepted as a reset events
+ //If necessary remove the fields of the previously selected constructor
+ # change = case state of
+// (JSONInt prevConsIdx) = ChangeUI [] (repeatn 32 /*(gtd_conses !! prevConsIdx).gcd_arity */(1,RemoveChild))
+ _ = NoChange
+ # consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
+ = (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}),(i, val), vst)
+ = (Error "Unknown constructor select event ",(i, val),vst)
+
+ //Update is targeted somewhere inside this value
+ onEdit dp (tp,e) (i, val) mask=:(CompoundMask {fields,state}) vst
+ # cured = snd (cs !! i)
+ //Adjust for the added constructor switch UI
+ # consChooseMask = hd fields
+ = case cured.Editor.onEdit dp (tp,e) val (CompoundMask {fields=tl fields,state=JSONNull}) vst of
+ (Ok (change,CompoundMask {fields}),val,vst)
+ # change = case change of
+ (ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
+ _ = NoChange
+ = (Ok (change,CompoundMask {fields=[consChooseMask:fields],state=JSONNull}),(i, val),vst)
+ (Error e,val,vst) = (Error e, (i, val), vst)
+
+ consCreatePath i n
+ | i >= n = []
+ | n == 1 = []
+ | i < (n /2) = [ -1: consCreatePath i (n/2) ]
+ | otherwise = [ -2: consCreatePath (i - (n/2)) (n - (n/2)) ]
+
+ onRefresh dp (i, new) (j, old) mask=:(CompoundMask {fields}) vst=:{VSt|mode,taskId,optional,selectedConsIndex=curSelectedConsIndex}
+ # cured = snd (cs !! i)
+ | numConses == 1
+ # (change,val,vst) = cured.Editor.onRefresh dp new old mask vst
+ = (change,(j, val),vst)
+ | otherwise
+ //Adjust for the added constructor view/choose UI
+ # consChooseMask = hd fields
+ //Don't recursively refresh if no constructor has been chosen
+ | (not mode =: View) && consChooseMask =: (FieldMask {FieldMask|state=JSONNull})
+ = (Ok (NoChange,mask),(i, old),vst)
+ = case cured.Editor.onRefresh dp new old (CompoundMask {fields=tl fields,state=JSONNull}) {vst & selectedConsIndex = 0} of
+ (Ok (change,CompoundMask {fields}),val,vst=:{VSt|selectedConsIndex})
+ //If the cons was changed we need to update the selector
+ # consIndex = ~selectedConsIndex - 1
+ # consChange = if (selectedConsIndex < 0)
+ [(0, ChangeChild (ChangeUI [SetAttribute "value" (JSONArray [JSONInt consIndex,JSONBool True])] []))]
+ []
+ //Adjust the changes
+ # change = case change of
+ NoChange = if (consChange =: []) NoChange (ChangeUI [] consChange)
+ (ChangeUI attrChanges itemChanges) = ChangeUI attrChanges (consChange ++ [(i + 1,c) \\ (i,c) <- itemChanges])
+ (ReplaceUI ui=:(UI type attr items))
+ //Add the constructor selection/view ui
+ # (consUI,_) = if (mode =: View)
+ (genConsViewUI conses consIndex)
+ (genConsChooseUI taskId dp optional conses (Just consIndex))
+ = ReplaceUI (UI type attr [consUI:items])
+ | otherwise
+ = (Ok (change, CompoundMask {fields=[consChooseMask:fields],state=JSONNull}), (j, val),{vst & selectedConsIndex = curSelectedConsIndex})
+
+ (Ok (change,mask),val,vst=:{VSt|selectedConsIndex})
+ = (Error "Corrupt mask in generic choose editor",(i, old), vst)
+ (Error e,val,vst) = (Error e,(i, val),vst)
+ onRefresh dp (i, new) (j, old) mask vst
+ = (Error "Corrupt mask in generic choose editor",(j, old), vst)
--- /dev/null
+definition module MetaType
+
+from StdOverloaded import class toString, class fromString
+from iTasks.UI.Editor import :: Editor
+from iTasks.UI.Definition import :: UIType
+from iTasks.WF.Definition import class iTask
+from iTasks.UI.Editor import :: Editor
+from iTasks.UI.Editor.Generic import generic gEditor
+from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
+from iTasks.Internal.Generic.Defaults import generic gDefault
+from iTasks.WF.Definition import :: Task
+from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
+from Data.GenEq import generic gEq
+from Data.Maybe import :: Maybe
+from Data.Either import :: Either
+
+derive class iTask MetaType
+derive gEq MetaInst
+derive gText MetaInst
+derive JSONEncode MetaInst
+derive JSONDecode MetaInst
+derive gEditor MetaInst
+derive gDefault MetaInst
+
+:: MetaType = MInt | MReal | MBool | MChar | MVoid | MPoint MetaType | MThis
+ | MRecord [(String, MetaType)] | MADT [(String, [MetaType])]
+// | MTup2 (MetaType, MetaType)
+// | MTup3 (MetaType, MetaType, MetaType)
+// | MTup4 (MetaType, MetaType, MetaType, MetaType)
+
+:: MetaInst = IInt Int | IReal Real | IBool Bool | IChar Char | IVoid
+ | IPoint String | IRecord [MetaInst] | IADT Int [MetaInst]
+
+typeToInst :: MetaType -> MetaInst
+typeToEditor :: MetaType -> Editor MetaInst
+
+enterValueOfType :: MetaType -> Task MetaInst
+
+parse :: MetaType [Char] -> Either String (MetaInst, [Char])
+
+instance toString MetaType
+instance fromString MetaType
--- /dev/null
+implementation module MetaType
+
+from StdFunc import o, flip
+from Data.Func import $
+
+import StdOverloaded, StdString, StdList, StdMisc, StdTuple, StdBool
+import StdGeneric
+
+//import Control.Monad
+//import Control.Applicative
+import Data.Functor
+import Data.Tuple
+import Data.Either
+import Data.List
+import iTasks
+import iTasks.UI.Editor
+import iTasks.UI.Editor.Containers
+import iTasks.UI.Editor.Controls
+import iTasks.UI.Editor.Generic
+import iTasks.UI.Editor.Common
+import iTasks.UI.Editor.Modifiers
+import Text.GenJSON
+import Text
+
+import StdDebug
+
+derive class iTask MetaType
+derive gEq MetaInst
+derive gText MetaInst
+derive JSONEncode MetaInst
+derive JSONDecode MetaInst
+gDefault{|MetaInst|} = trace "Unable to derive a default value for MetaInst without the MetaType" IVoid
+gEditor{|MetaInst|} = trace "Unable to derive an editor for MetaInst without the MetaType" emptyEditor
+
+instance toString MetaType
+where
+ toString MInt = "Int"
+ toString MReal = "Real"
+ toString MBool = "Bool"
+ toString MChar = "Char"
+ toString MVoid = "Void"
+ toString (MPoint p) = "(Pointer " +++ toString p +++ ")"
+ toString (MRecord m) = "{" +++ join "," [
+ k +++ "::" +++ toString v\\(k,v)<-m] +++ "}"
+ toString (MADT m) = join " | " [
+ k +++ " " +++ join " " (map toString v)\\(k,v)<-m]
+ toString MThis = "This"
+
+instance fromString MetaType
+where
+ fromString x = MInt
+
+typeToInst :: MetaType -> MetaInst
+typeToInst m = typeToInst` m
+where
+ typeToInst` :: MetaType -> MetaInst
+ typeToInst` MInt = IInt 0
+ typeToInst` MReal = IReal 0.0
+ typeToInst` MBool = IBool False
+ typeToInst` MChar = IChar ' '
+ typeToInst` MVoid = IVoid
+ typeToInst` MThis = typeToInst m
+ typeToInst` (MPoint _) = IPoint ""
+ typeToInst` (MRecord fs) = IRecord $ map (typeToInst` o snd) fs
+ typeToInst` (MADT []) = IADT -1 []
+ typeToInst` (MADT [(c, fs):_]) = IADT 0 $ map typeToInst` fs
+
+typeToEditor :: MetaType -> Editor MetaInst
+typeToEditor x = typeToEditor` x
+where
+ typeToEditor` :: MetaType -> Editor MetaInst
+ typeToEditor` MInt = bijectEditorValue (\(IInt i) ->i) IInt integerField
+ typeToEditor` MReal = bijectEditorValue (\(IReal i)->i) IReal decimalField
+ typeToEditor` MBool = bijectEditorValue (\(IBool i)->i) IBool checkBox
+ typeToEditor` MChar = bijectEditorValue (\(IChar i)->i) IChar gEditor{|*|}
+ typeToEditor` MVoid = bijectEditorValue (\_->()) (\_->IVoid) emptyEditor
+ typeToEditor` (MPoint _) = bijectEditorValue (\(IPoint i)->i) IPoint gEditor{|*|}
+ typeToEditor` MThis = typeToEditor x
+ typeToEditor` (MRecord fs) =
+ bijectEditorValue (\(IRecord i)->i) IRecord
+ $ containerL [row k (typeToEditor` v)\\(k, v)<-fs]
+ typeToEditor` (MADT []) = emptyEditor
+ typeToEditor` (MADT [(k, v)]) = bijectEditorValue (\(IADT 0 m)->m) (IADT 0)
+ $ row k (containerL (map typeToEditor` v) <<@ directionAttr Horizontal)
+ typeToEditor` (MADT kvs) = abort "blurp"/*bijectEditorValue (\(IADT i m)->(i, m)) (uncurry IADT)
+ $ choose [(k, containerL (map typeToEditor` v) <<@ directionAttr Horizontal)\\(k,v)<-kvs]*/
+ typeToEditor` x = abort $ "Nomatch: " +++ toString x
+
+enterValueOfType :: MetaType -> Task MetaInst
+enterValueOfType mt = enterValueOfType` mt
+where
+ enterValueOfType` MInt = enterInformation () [] @ IInt
+ enterValueOfType` MReal = enterInformation () [] @ IReal
+ enterValueOfType` MBool = enterInformation () [] @ IBool
+ enterValueOfType` MChar = enterInformation () [] @ IChar
+ enterValueOfType` MVoid = return IVoid
+ enterValueOfType` MThis = enterValueOfType` mt
+ enterValueOfType` (MPoint _) = enterInformation () [] @ IPoint
+ enterValueOfType` (MRecord fs)
+ = allTasks [enterValueOfType` v <<@ Title k\\(k,v)<-fs]
+ >>* [OnAction (Action "Continue") $ ifValue (\v->length v == length fs) $ return o IRecord]
+ enterValueOfType` (MADT kvs)
+ = enterChoice "Cons" [ChooseFromDropdown (fst o fst)] (zip2 kvs [0..])
+ >&> \sh->whileUnchanged sh \mc->case mc of
+ Nothing = viewInformation () [] () @! IVoid
+ Just ((k, vs), i)
+ = allTasks (map enterValueOfType` vs) <<@ Title k @ IADT i
+
+row :: String (Editor a) -> Editor a
+row l e = bijectEditorValue (tuple l) snd $
+ container2 label e <<@ directionAttr Horizontal
+
+parse :: MetaType [Char] -> Either String (MetaInst, [Char])
+parse t cs = parse` t t cs
+where
+ parse` t MVoid cs = Right (IVoid, cs)
+ parse` t MInt cs = case parseInt cs of
+ (i, []) = Right (IInt i, cs)
+ (i, [' ':cs]) = Right (IInt i, cs)
+ _ = Left "Integer must end with a space"
+ parse` t MReal cs = Right $ appFst IReal (parseReal cs)
+ parse` t MBool [c:cs]
+ | c == '0' || c == '1' = Right (IBool (c == '1'), cs)
+ = Left "Bool must be encoded as 0 or 1"
+ parse` t MChar [c:cs] = Right (IChar c, cs)
+ parse` t (MPoint _) ['\0':cs] = Right (IPoint "", cs)
+ parse` t p=:(MPoint _) [c:cs] = case parse p cs of
+ Left e = Left e
+ Right (IPoint ss, cs) = Right (IPoint (toString c +++ ss), cs)
+ parse` t MThis c = parse t c
+ parse` t (MRecord fs) cs = undef
+ parse` t (MADT cons) cs = case parse MInt cs of
+ Right (IInt c, cs)
+ | c < 0 || c > length cons = Left $ "Not a valid cons identifier: " +++ toString c
+ = appFst (IADT c) <$> plist t (snd $ cons !! c) cs
+ Left e = Left e
+ parse` t _ [] = Left "Empty input"
+ parse` t` t _ = Left $ "Undef: " +++ toString t` +++ " , " +++ toString t
+
+ plist t [] cs = Right ([], cs)
+ plist t [a:as] cs = case parse` t a cs of
+ Left e = Left e
+ Right (a, cs) = case plist t as cs of
+ Left e = Left e
+ Right (as, cs) = Right ([a:as], cs)
+
+ parseInt :: [Char] -> (Int, [Char])
+ parseInt [c:cs] = appFst ((*) -1) $ int cs
+ parseInt cs = int cs
+
+ int = appFst (toInt o toString) o span isDigit
+
+ parseReal :: [Char] -> (Real, [Char])
+ parseReal cs = (0.0, cs)
+
+print :: MetaInst -> String
+print i = trim $ print` i
+where
+ print` IVoid = ""
+ print` (IInt i) = toString i +++ " "
+ print` (IReal i) = toString i +++ " "
+ print` (IBool i) = if i "1" "0"
+ print` (IChar i) = toString i
+ print` (IPoint i) = i +++ "\0"
+ print` (IRecord fs) = concat $ map print fs
+ print` (IADT i cs) = concat [toString i," ":map print cs]
--- /dev/null
+module ed
+
+from Data.Func import $
+import iTasks
+import MetaType
+import Data.Maybe
+import Data.Functor
+
+import GenPrint
+derive gPrint MetaInst
+
+Start w = startEngine t w
+where
+ t = enterInformation "Enter MetaType" []
+ >&> \sh->whileUnchanged sh \mt->case mt of
+ Nothing = viewInformation () [] "No type entered"
+ Just mt = enterValueOfType mt
+ >&> viewSharedInformation "Value:" [ViewAs $ fmap lens] @! ""
+
+ lens :: (MetaInst -> String)
+ lens = printToString
--- /dev/null
+definition module test
+
+class c c
+where
+ m1 :: c
+ m2 :: c
--- /dev/null
+implementation module test
+
+class c c
+where
+ m1 :: c
+
+Start = 42
--- /dev/null
+module test
+
+import Data.Func, StdFunctions, iTasks
+
+derive gDefault ChoiceNode
+
+Start w = flip startEngine w $
+ withShared 5 \sharedInt->
+ withShared [] \sharedSel->
+ editSharedSelectionWithShared "test" False
+ (SelectInTree
+ (\l->[{defaultValue & id=i,label=toString i}\\i<-[0..l]])
+ (\_ s->s)
+ ) sharedInt sharedSel
+ -|| updateSharedInformation "Number of items" [] sharedInt
+ -|| updateSharedInformation "Current selection" [] sharedSel
+ >&> viewSharedInformation "Current task value" [] o mapRead toSingleLineText