Merge branch 'master' of git.martlubbers.net:clean-tests
[clean-tests.git] / filepicker / test.icl
index e3af2e6..a306d2c 100644 (file)
@@ -1,57 +1,8 @@
 module test
 
-import StdFunctions
-import System.Directory
-import System.File
-import System.FilePath
-import Data.List
-import Data.Functor
-import Data.Tree
-import qualified Control.Monad as CM
-import Control.Applicative
-import Control.Monad.Identity
-import Control.Monad.State
-import iTasks
+import iTasks.Extensions.Files
 
-derive class iTask RTree, FileInfo, Tm
-
-Start w = startEngine (selectFile "select a file" "/opt/clean") w
-
-selectFile :: !d !FilePath -> Task FilePath | toPrompt d
-selectFile d root = accWorld (createDirectoryTree root (Just 1)) >>= \tree->
-       withShared tree \stree->let numberedtree = mapRead numberTree stree in
-       withShared [] \ssel->
-       editSharedSelectionWithShared d False selOpt numberedtree ssel
-       -|| whileUnchanged (ssel >*< numberedtree) (\(sel, tree)->case sel of
-               [i] = case find ((==)i o fst) (leafs tree) of
-                       Just (i, (fp, Ok {directory=True}))
-                               = accWorld (createDirectoryTree fp (Just 1))
-                               @ flip (mergeIn i) tree
-                               >>= \newtree->set ([], newtree) (ssel >*< stree) @? const NoValue
-                       _ = unstable ()
-               _ = unstable ()
-       )
-       -|| viewSharedInformation "tree" [] (mapRead (drawRTree o fmap toSingleLineText) numberedtree)
-       @? tvHd
-       @ fst o snd
-where
-       mergeIn j newtree = foldTree \(i, t) cs->if (i == j) newtree (RNode t cs)
-
-       unstable a = treturn a @? \(Value a _)->Value a False
-
-       selOpt :: SelectOption (RTree (Int, (FilePath, MaybeOSError FileInfo))) (Int, (FilePath, MaybeOSError FileInfo))
-       selOpt = SelectInTree
-               (\tree->[{foldTree fp2cn tree & label=root}])
-               (\tree sel->[t\\t=:(i, _)<-leafs tree | isMember i sel])
-
-       fp2cn (i, (fp, mfi)) cs =
-               { id = i
-               , label=dropDirectory fp
-               , icon=Nothing
-               , expanded=True
-               , 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
+Start w = startEngine (
+       selectFileTreeLazy "select a file" False "/opt/clean"
+       -&&- selectFileTree False "select a file" False "/opt/clean"[]
+       >&> viewSharedInformation "selection" []) w