Commit 1b02c976 authored by Steffen Michels's avatar Steffen Michels

Merge branch '388-add-selectFileTreeWithShared' into 'master'

Add selectFileTreeWithShared

Closes #388

See merge request !423
parents 0d772d9f 8c123237
Pipeline #42790 passed with stage
in 9 minutes and 40 seconds
......@@ -3,6 +3,8 @@ definition module iTasks.Extensions.Files
* This module provides various tasks for managing files
*/
import iTasks
from Data.Tree import :: RTree
from System.File import :: FileInfo
from System.FilePath import :: FilePath
//Managing files
......@@ -70,3 +72,25 @@ selectFileTree :: !Bool !Bool !FilePath [FilePath]-> Task [FilePath]
* @result Filepaths picked
*/
selectFileTreeLazy :: !Bool !FilePath -> Task [FilePath]
/**
* Browse for a file in a file tree.
*
* The tree can be modified before starting interaction with the user using an
* SDS.
*
* @param Whether multiple selection is allowed.
* @param The root directory.
* @param The SDS used for modification. It is typically created with
* `createReadOnlySDS` or `worldShare`. It should return a tree structure
* which is a subset of the parameter (i.e., no file paths should be added
* and the file info should not be modified). The first added boolean
* indicates whether the path should be selected. The second boolean is only
* used for directories; it indicates whether a directory should be expanded.
* @result The selected file paths.
*/
selectFileTreeWithShared ::
!Bool !FilePath
!(sds (RTree (FilePath,MaybeOSError FileInfo)) (RTree (FilePath,MaybeOSError FileInfo,Bool,Bool)) ())
-> Task [FilePath]
| RWShared sds
......@@ -19,6 +19,9 @@ import qualified System.Directory as SD
import iTasks
// withShared in the file selection tasks requires these instances:
derive class iTask RTree, FileInfo
deleteFile :: !FilePath -> Task ()
deleteFile path = accWorldError ('SF'.deleteFile path) (addExplanation ["Failed to delete ",path])
......@@ -123,9 +126,6 @@ where
addExplanation :: ![String] !OSError -> String
addExplanation expl (_,msg) = concat (expl ++ [": ", msg])
//Why is this necessary?!?!?!?
derive class iTask RTree, FileInfo, Tm
selectFileTree :: !Bool !Bool !FilePath [FilePath]-> Task [FilePath]
selectFileTree exp multi root initial
= accWorld (readDirectoryTree root Nothing) @ numberTree
......@@ -174,6 +174,35 @@ where
icon (Ok _) = Just "document"
icon _ = Just "document-error"
selectFileTreeWithShared ::
!Bool !FilePath
!(sds (RTree (FilePath,MaybeOSError FileInfo)) (RTree (FilePath,MaybeOSError FileInfo,Bool,Bool)) ())
-> Task [FilePath]
| RWShared sds
selectFileTreeWithShared multi root sds =
accWorld (readDirectoryTree root Nothing) >>- \tree ->
get (sdsFocus tree sds) @ numberTree >>- \tree ->
editSelection
[SelectMultiple multi, SelectInTree (\t -> [toChoiceNode t]) fromSelection]
tree
[i \\ (i,(_,_,selected,_)) <- leafs tree | selected]
where
toChoiceNode :: !(RTree (Int, (FilePath,MaybeOSError FileInfo,Bool,Bool))) -> ChoiceNode
toChoiceNode (RNode (i,(path,info,_,expanded)) children) =
{ id = i
, label = dropDirectory path +++ if (isError info) (" (" +++ snd (fromError info) +++ ")") ""
, icon = icon info
, expanded = expanded
, children = map toChoiceNode children
}
where
icon (Ok {directory=True}) = Just "folder"
icon (Ok _) = Just "document"
icon _ = Just "document-error"
fromSelection :: !(RTree (Int, (FilePath,MaybeOSError FileInfo,Bool,Bool))) [Int] -> [FilePath]
fromSelection tree selected = [f \\ (i,(f,_,_,_)) <- leafs tree | isMember i selected]
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
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment