X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=filepicker%2Ftest.icl;h=a306d2c0295769897bee98cd35f7064c5de0892a;hb=bcac28800fcf7a1da9f3a6dbb85bce08e991ae5b;hp=fa05452d8c3817a212e4352fcf1ea168c669fe44;hpb=be92eac1a42b32c0ddb187f329fa643d508c1c13;p=clean-tests.git diff --git a/filepicker/test.icl b/filepicker/test.icl index fa05452..a306d2c 100644 --- a/filepicker/test.icl +++ b/filepicker/test.icl @@ -1,82 +1,8 @@ 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 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 +Start w = startEngine ( + selectFileTreeLazy "select a file" False "/opt/clean" + -&&- selectFileTree False "select a file" False "/opt/clean"[] + >&> viewSharedInformation "selection" []) w