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

[clean-tests.git] / filepicker / test.icl

diff --git a/filepicker/test.icl b/filepicker/test.icl
index bdf9d97..fa05452 100644 (file)
--- a/filepicker/test.icl
+++ b/filepicker/test.icl
@@ -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