From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 10 Sep 2018 13:54:01 +0000 (+0200)
Subject: Merge branch 'master' of git.martlubbers.net:clean-tests
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=be92eac1a42b32c0ddb187f329fa643d508c1c13;p=clean-tests.git

Merge branch 'master' of git.martlubbers.net:clean-tests
---

be92eac1a42b32c0ddb187f329fa643d508c1c13
diff --cc filepicker/test.icl
index e885131,bdf9d97..fa05452
--- a/filepicker/test.icl
+++ b/filepicker/test.icl
@@@ -1,76 -1,8 +1,82 @@@
  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.Extensions.Files
 +import iTasks.Internal.Util
  
 -Start w = startEngine (
 -	selectFile "/opt/clean/lib" () False []
 -	>&> viewSharedInformation "Selection" []) w
 +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 tree :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (c -> [Int]) -> Task [a] 
 +
 +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