-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)