filepicker/test.icl

   1 module test
   2
   3 from StdFunc import seq, seqList, :: St
   4 import StdFunctions
   5 import System.Directory
   6 import System.File
   7 import System.FilePath
   8 import Data.Tuple
   9 import Data.Func
  10 import Data.Bifunctor
  11 import iTasks
  12 import iTasks.Internal.Util
  13
  14 derive class iTask RTree, FileInfo, Tm
  15
  16 Start w = startEngine
  17         (viewSharedInformation () []
  18                 $ mapRead (map fst)
  19                 $ sdsFocus "/opt/clean/lib/StdLib" directoryShare
  20         ) w
  21
  22 instance toString OSError where toString (_, e) = e
  23 instance Bifunctor MaybeError
  24 where
  25         bifmap fa fb (Error a) = Error (fa a)
  26         bifmap fa fb (Ok b) = Ok (fb b)
  27         first fa fab = bifmap fa id fab
  28         second fb fab = bifmap id fb fab
  29
  30 selectFile :: FilePath -> Task FilePath
  31 selectFile root = get (sdsFocus root directoryShare)
  32         >>= \cs->withShared (RNode root (map fst cs)) \tree->
  33         editSelectionWithShared () False selectOption (mapRead numberTree tree)
  34                 (\tree->[i\\(i, (f, _))<-leafs tree])
  35
  36 selectFile :: !FilePath !d !Bool [FilePath]-> Task [FilePath] | toPrompt d
  37 selectFile root prompt multi initial
  38         = accWorld (createDirectoryTree root) @ numberTree
  39         >>= \tree->editSelection prompt multi selectOption tree
  40                 [i\\(i, (f, _))<-leafs tree | elem f initial]
  41 where
  42         selectOption = SelectInTree
  43                 (\tree->[{foldTree fp2cn tree & label=root}])
  44                 (\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel])
  45
  46         fp2cn (i, (fp, mfi)) cs =
  47                 { id = case mfi of
  48                         Error e = ~i
  49                         Ok {directory=True} = ~i
  50                         _ = i
  51                 , label=dropDirectory fp
  52                 , icon=Nothing
  53                 , expanded=False
  54                 , children=cs
  55                 }
  56
  57         numberTree :: ((RTree a) -> RTree (Int, a))
  58         numberTree = flip evalState zero o foldTree \a cs->
  59                 (\lvs i->RNode (i, a) lvs) <$> 'CM'.sequence cs <*> getState <* modify inc
  60
  61
  62
  63
  64
  65         =
  66
  67 directoryShare :: ROShared FilePath [(FilePath, MaybeOSError FileInfo)]
  68 directoryShare = SDSSource {SDSSource | name = "directoryShare", read = read, write=write}
  69 where
  70         read p iw
  71                 # (merr, iw) = liftIWorld (readDirectory p) iw
  72                 | isError merr = (liftError (first exception merr), iw)
  73                 # (Ok files) = merr
  74                 # (fis, iw) = liftIWorld (seqList (map getFileInfo files)) iw
  75                 = (Ok $ sortBy fst [(f, fi)\\f<-files & fi<-fis], iw)
  76
  77         write p w iw = (Ok (const (const False)), iw)
  78 //import iTasks
  79 //import iTasks.Extensions.Files
  80 //
  81 //Start w = startEngine (
  82 //      selectFile "/opt/clean/lib" () False []
  83 //      >&> viewSharedInformation "Selection" []) w