From d4b7c7efc28e095b444132c87d1b4298ceef1762 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 10 Sep 2018 15:53:39 +0200
Subject: [PATCH] file picker

---
 filepicker/test.icl | 107 ++++++++++++++++++++++++++------------------
 1 file changed, 64 insertions(+), 43 deletions(-)

diff --git a/filepicker/test.icl b/filepicker/test.icl
index 4ae8838..e885131 100644
--- a/filepicker/test.icl
+++ b/filepicker/test.icl
@@ -1,55 +1,76 @@
 module test
 
-from iTasks.UI.Editor.Controls import :: ChoiceNode{..}
-import StdEnv
-import Data.List
-import Data.Func
-import Data.Functor
-import Data.Tuple
-import Data.Tree
-import Data.Maybe
-import Data.Error
-import Control.Applicative
-import Control.Monad
-import Control.Monad.State
-import Control.Monad.Identity
-import System.FilePath
-import System.File
+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 iTasks
+import iTasks.Internal.Util
+
+derive class iTask RTree, FileInfo, Tm
 
-import Text.GenPrint
-import iTasks => qualified >>=, >>|, forever, sequence, return
+Start w = startEngine
+	(viewSharedInformation () []
+		$ mapRead (map fst)
+		$ sdsFocus "/opt/clean/lib/StdLib" directoryShare
+	) w
 
-derive class iTask RTree, ChoiceNode, FileInfo, Tm
+instance toString OSError where toString (_, e) = e
+instance Bifunctor MaybeError
+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
 
-Start w = startEngine (selectFile "/opt/clean/lib/StdLib" () False) w
+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] 
 
-selectFile :: FilePath d Bool -> Task [FilePath] | toPrompt d
-selectFile root p m = tbind
-	(accWorldOSError (appFst (fmap numberTree) o recurseDirectory root ""))
-	\tree->editSelection p m (SelectInTree (pure o toChoiceNode fp2cn) fromTree) tree []
+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
+		(\tree->[{foldTree fp2cn tree & label=root}])
+		(\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel])
+
+	fp2cn (i, (fp, mfi)) cs =
+		{ id = case mfi of
+			Error e = ~i
+			Ok {directory=True} = ~i
+			_ = i
+		, label=dropDirectory fp
+		, icon=Nothing
+		, expanded=False
+		, children=cs
+		}
+
 	numberTree :: ((RTree a) -> RTree (Int, a))
 	numberTree = flip evalState zero o foldTree \a cs->
-		(\lvs i->RNode (i, a) lvs) <$> sequence cs <*> getState <* modify ((+)one)
+		(\lvs i->RNode (i, a) lvs) <$> 'CM'.sequence cs <*> getState <* modify inc
+	
+
 	
-	toChoiceNode :: (Int a -> ChoiceNode) -> ((RTree (Int, a)) -> ChoiceNode)
-	toChoiceNode tfun = foldTree \a cs->{ChoiceNode | uncurry tfun a & children=cs}
 	
-	fp2cn :: Int (FilePath, FileInfo) -> ChoiceNode
-	fp2cn i (fp, fi) = {id =if fi.directory (~i) i,label=dropDirectory fp,icon=Nothing,expanded=False,children=[]}
-
-	fromTree :: (RTree (Int, (FilePath, a))) [Int] -> [FilePath]
-	fromTree tree sel = [f\\(i, (f, _))<-leafs tree | isMember i sel]
-
-recurseDirectory :: !FilePath !FilePath !*World -> *(MaybeOSError (RTree (FilePath, FileInfo)), !*World)
-recurseDirectory acc fp w
-	# fp = acc </> fp
-	# (mfi, w) = getFileInfo fp w
-	| isError mfi = (liftError mfi, w)
-	# (Ok fi) = mfi
-	| not fi.directory = (Ok $ RNode (fp, fi) [], w)
-	# (mcs, w) = readDirectory fp w
-	| isError mfi = (liftError mcs, w)
-	# (cs, w) = appFst sequence $ mapSt (recurseDirectory fp) (filter (\c->not (elem c [".", ".."])) (fromOk mcs)) w
-	= (RNode (fp, fi) <$> cs, w)
+	
+	= 
+
+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)
-- 
2.20.1