From b52078abe31243355b93ad92ee3256ae85eb37fd Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 11 Sep 2018 16:43:42 +0200 Subject: [PATCH] updates --- filepicker/test.icl | 97 +++++++++++++++------------------------ shared_selection/test.icl | 17 +++++++ 2 files changed, 53 insertions(+), 61 deletions(-) create mode 100644 shared_selection/test.icl diff --git a/filepicker/test.icl b/filepicker/test.icl index fa05452..e3af2e6 100644 --- a/filepicker/test.icl +++ b/filepicker/test.icl @@ -1,82 +1,57 @@ 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 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.Internal.Util 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 +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 - 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 + mergeIn j newtree = foldTree \(i, t) cs->if (i == j) newtree (RNode t cs) -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] + unstable a = treturn a @? \(Value a _)->Value a False -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 + selOpt :: SelectOption (RTree (Int, (FilePath, MaybeOSError FileInfo))) (Int, (FilePath, MaybeOSError FileInfo)) + selOpt = SelectInTree (\tree->[{foldTree fp2cn tree & label=root}]) - (\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel]) + (\tree sel->[t\\t=:(i, _)<-leafs tree | isMember i sel]) fp2cn (i, (fp, mfi)) cs = - { id = case mfi of - Error e = ~i - Ok {directory=True} = ~i - _ = i + { id = i , label=dropDirectory fp , icon=Nothing - , expanded=False + , 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 - - - - - - = - -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 +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 diff --git a/shared_selection/test.icl b/shared_selection/test.icl new file mode 100644 index 0000000..4ac4faa --- /dev/null +++ b/shared_selection/test.icl @@ -0,0 +1,17 @@ +module test + +import Data.Func, StdFunctions, iTasks + +derive gDefault ChoiceNode + +Start w = flip startEngine w $ + withShared 5 \sharedInt-> + withShared [] \sharedSel-> + editSharedSelectionWithShared "test" False + (SelectInTree + (\l->[{defaultValue & id=i,label=toString i}\\i<-[0..l]]) + (\_ s->s) + ) sharedInt sharedSel + -|| updateSharedInformation "Number of items" [] sharedInt + -|| updateSharedInformation "Current selection" [] sharedSel + >&> viewSharedInformation "Current task value" [] o mapRead toSingleLineText -- 2.20.1