X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=filepicker%2Ftest.icl;h=f308b3315db25d1b815a62007c0ea88a9b78d554;hb=1eb7ba9a34eacb68c762bd9f7f81865cf37ecb0b;hp=27c5ac0223bdaa9ca99ed70472c4abf233146c3f;hpb=af595886d03bdf67057026993cebda553661eff5;p=clean-tests.git

diff --git a/filepicker/test.icl b/filepicker/test.icl
index 27c5ac0..f308b33 100644
--- a/filepicker/test.icl
+++ b/filepicker/test.icl
@@ -1,58 +1,83 @@
 module test
 
-import Control.Monad.State
-import Control.Monad.Identity
-import Control.Applicative
-import System.OS
-import qualified Control.Monad as M
-from Control.Monad import `b`, mapM, class Monad(bind)
-import StdArray
-import Data.Tree
-import Data.Functor
-import Data.Tuple
-import Data.Func
+from StdFunc import seq, seqList, :: St
+import StdFunctions
 import System.Directory
 import System.File
-import Text.HTML
-import Text
-import iTasks 
-import iTasks.Internal.SDS => qualified modify
-import iTasks.Internal.Task
-
-import StdDebug, StdMisc
+import System.FilePath
+import Data.Tuple
+import Data.Func
+import Data.Bifunctor
+import iTasks
+import iTasks.Internal.Util
 
 derive class iTask RTree, FileInfo, Tm
 
-Start w = startEngine (selecter "/home/mrl/projects" 2) w
-
-recurseDirectory :: Int FilePath FilePath *World -> *(MaybeOSError (RTree (FilePath, Bool)), *World)
-recurseDirectory maxdepth acc fp w
-# fp = acc </> fp
-= case getFileInfo fp w of
-	(Error (i, e), w) = (Error (i, e +++ " in fileinfo " +++ fp), w)
-	(Ok fi, w)
-		| not fi.directory = (Ok $ RNode (fp, False) [], w)
-		= case readDirectory fp w of
-			(Error (i, e), w) = (Error (i, e +++ " in readDir " +++ fp), w)
-			(Ok cs, w)
-				| maxdepth == 0 = (Ok $ RNode (fp, True) [], w)
-				= appFst ((fmap $ RNode (fp, True)) o 'M'.sequence)
-					$ mapSt (recurseDirectory (maxdepth - 1) fp) (filter real cs) w
+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
-	real i = IF_POSIX (i <> ".." && i <> ".") True
+	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
 
-selecter :: !FilePath Int -> Task String
-selecter fp maxdepth = accWorldOSError (recurseDirectory maxdepth fp "")
-	>>= \ds->editSelection "Examples" False (SelectInTree (\x->[evalState (toTree x) 0]) fromTree) ds []
-	@? tvHd
+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
-	toTree :: (RTree (FilePath, Bool)) -> State Int ChoiceNode
-	toTree (RNode (fp, _) forest)
-		= getState `b` \i->put (i+1) `b` \_->mapM toTree forest `b` \cs->pure
-			{id=i,label=bn fp,icon=Nothing,expanded=i==0,children=cs}
+	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
+	
 
-	bn :: FilePath -> FilePath
-	bn x = if (endsWith {pathSeparator} x) (bn $ fst $ splitFileName x) (dropDirectory x)
+	
+	
+	
+	= 
+
+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)
 
-	fromTree :: (RTree (FilePath, Bool)) [Int] -> [FilePath]
-	fromTree t [i] = map fst $ filter (not o snd) [foldTree (\f fs->[f:flatten fs]) t !! i]
+	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