X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=filepicker%2Ftest.icl;h=a306d2c0295769897bee98cd35f7064c5de0892a;hb=8b58864aa5e0ace806f15156d51cdbc256e4f9f5;hp=27c5ac0223bdaa9ca99ed70472c4abf233146c3f;hpb=af595886d03bdf67057026993cebda553661eff5;p=clean-tests.git diff --git a/filepicker/test.icl b/filepicker/test.icl index 27c5ac0..a306d2c 100644 --- a/filepicker/test.icl +++ b/filepicker/test.icl @@ -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