runtasks
[clean-tests.git] / filepicker / test.icl
index 27c5ac0..a306d2c 100644 (file)
@@ -1,58 +1,8 @@
 module test
 
-import Control.Monad.State
-import Control.Monad.Identity
-import Control.Applicative
-import System.OS
-import qualified Control.Monad as M
-from Control.Monad import `b`, mapM, class Monad(bind)
-import StdArray
-import Data.Tree
-import Data.Functor
-import Data.Tuple
-import Data.Func
-import System.Directory
-import System.File
-import Text.HTML
-import Text
-import iTasks 
-import iTasks.Internal.SDS => qualified modify
-import iTasks.Internal.Task
+import iTasks.Extensions.Files
 
-import StdDebug, StdMisc
-
-derive class iTask RTree, FileInfo, Tm
-
-Start w = startEngine (selecter "/home/mrl/projects" 2) w
-
-recurseDirectory :: Int FilePath FilePath *World -> *(MaybeOSError (RTree (FilePath, Bool)), *World)
-recurseDirectory maxdepth acc fp w
-# fp = acc </> fp
-= case getFileInfo fp w of
-       (Error (i, e), w) = (Error (i, e +++ " in fileinfo " +++ fp), w)
-       (Ok fi, w)
-               | not fi.directory = (Ok $ RNode (fp, False) [], w)
-               = case readDirectory fp w of
-                       (Error (i, e), w) = (Error (i, e +++ " in readDir " +++ fp), w)
-                       (Ok cs, w)
-                               | maxdepth == 0 = (Ok $ RNode (fp, True) [], w)
-                               = appFst ((fmap $ RNode (fp, True)) o 'M'.sequence)
-                                       $ mapSt (recurseDirectory (maxdepth - 1) fp) (filter real cs) w
-where
-       real i = IF_POSIX (i <> ".." && i <> ".") True
-
-selecter :: !FilePath Int -> Task String
-selecter fp maxdepth = accWorldOSError (recurseDirectory maxdepth fp "")
-       >>= \ds->editSelection "Examples" False (SelectInTree (\x->[evalState (toTree x) 0]) fromTree) ds []
-       @? tvHd
-where
-       toTree :: (RTree (FilePath, Bool)) -> State Int ChoiceNode
-       toTree (RNode (fp, _) forest)
-               = getState `b` \i->put (i+1) `b` \_->mapM toTree forest `b` \cs->pure
-                       {id=i,label=bn fp,icon=Nothing,expanded=i==0,children=cs}
-
-       bn :: FilePath -> FilePath
-       bn x = if (endsWith {pathSeparator} x) (bn $ fst $ splitFileName x) (dropDirectory x)
-
-       fromTree :: (RTree (FilePath, Bool)) [Int] -> [FilePath]
-       fromTree t [i] = map fst $ filter (not o snd) [foldTree (\f fs->[f:flatten fs]) t !! i]
+Start w = startEngine (
+       selectFileTreeLazy "select a file" False "/opt/clean"
+       -&&- selectFileTree False "select a file" False "/opt/clean"[]
+       >&> viewSharedInformation "selection" []) w