Merge branch 'master' of git.martlubbers.net:clean-tests
authorMart Lubbers <mart@martlubbers.net>
Mon, 10 Sep 2018 13:54:01 +0000 (15:54 +0200)
committerMart Lubbers <mart@martlubbers.net>
Mon, 10 Sep 2018 13:54:01 +0000 (15:54 +0200)
1  2 
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