From: Mart Lubbers <mart@martlubbers.net>
Date: Tue, 11 Sep 2018 14:43:42 +0000 (+0200)
Subject: updates
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=b52078abe31243355b93ad92ee3256ae85eb37fd;p=clean-tests.git

updates
---

diff --git a/filepicker/test.icl b/filepicker/test.icl
index fa05452..e3af2e6 100644
--- a/filepicker/test.icl
+++ b/filepicker/test.icl
@@ -1,82 +1,57 @@
 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 Data.List
+import Data.Functor
+import Data.Tree
+import qualified Control.Monad as CM
+import Control.Applicative
+import Control.Monad.Identity
+import Control.Monad.State
 import iTasks
-import iTasks.Internal.Util
 
 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
+Start w = startEngine (selectFile "select a file" "/opt/clean") w
+
+selectFile :: !d !FilePath -> Task FilePath | toPrompt d
+selectFile d root = accWorld (createDirectoryTree root (Just 1)) >>= \tree->
+	withShared tree \stree->let numberedtree = mapRead numberTree stree in
+	withShared [] \ssel->
+	editSharedSelectionWithShared d False selOpt numberedtree ssel
+	-|| whileUnchanged (ssel >*< numberedtree) (\(sel, tree)->case sel of
+		[i] = case find ((==)i o fst) (leafs tree) of
+			Just (i, (fp, Ok {directory=True}))
+				= accWorld (createDirectoryTree fp (Just 1))
+				@ flip (mergeIn i) tree
+				>>= \newtree->set ([], newtree) (ssel >*< stree) @? const NoValue
+			_ = unstable ()
+		_ = unstable ()
+	)
+	-|| viewSharedInformation "tree" [] (mapRead (drawRTree o fmap toSingleLineText) numberedtree)
+	@? tvHd
+	@ fst o snd
 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
+	mergeIn j newtree = foldTree \(i, t) cs->if (i == j) newtree (RNode t cs)
 
-selectFile :: FilePath -> Task FilePath
-selectFile root = get (sdsFocus root directoryShare)
-	>>= \cs->withShared (RNode root (map fst cs)) \tree->
-	editSelectionWithShared () False selectOption tree :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (c -> [Int]) -> Task [a] 
+	unstable a = treturn a @? \(Value a _)->Value a False
 
-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
+	selOpt :: SelectOption (RTree (Int, (FilePath, MaybeOSError FileInfo))) (Int, (FilePath, MaybeOSError FileInfo))
+	selOpt = SelectInTree
 		(\tree->[{foldTree fp2cn tree & label=root}])
-		(\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel])
+		(\tree sel->[t\\t=:(i, _)<-leafs tree | isMember i sel])
 
 	fp2cn (i, (fp, mfi)) cs =
-		{ id = case mfi of
-			Error e = ~i
-			Ok {directory=True} = ~i
-			_ = i
+		{ id = i
 		, label=dropDirectory fp
 		, icon=Nothing
-		, expanded=False
+		, expanded=True
 		, 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
+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
diff --git a/shared_selection/test.icl b/shared_selection/test.icl
new file mode 100644
index 0000000..4ac4faa
--- /dev/null
+++ b/shared_selection/test.icl
@@ -0,0 +1,17 @@
+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