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 tree :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (c -> [Int]) -> Task [a]
  34
  35 selectFile :: !FilePath !d !Bool [FilePath]-> Task [FilePath] | toPrompt d
  36 selectFile root prompt multi initial
  37         = accWorld (createDirectoryTree root) @ numberTree
  38         >>= \tree->editSelection prompt multi selectOption tree
  39                 [i\\(i, (f, _))<-leafs tree | elem f initial]
  40 where
  41         selectOption = SelectInTree
  42                 (\tree->[{foldTree fp2cn tree & label=root}])
  43                 (\tree sel->[f\\(i, (f, _))<-leafs tree | isMember i sel])
  44
  45         fp2cn (i, (fp, mfi)) cs =
  46                 { id = case mfi of
  47                         Error e = ~i
  48                         Ok {directory=True} = ~i
  49                         _ = i
  50                 , label=dropDirectory fp
  51                 , icon=Nothing
  52                 , expanded=False
  53                 , children=cs
  54                 }
  55
  56         numberTree :: ((RTree a) -> RTree (Int, a))
  57         numberTree = flip evalState zero o foldTree \a cs->
  58                 (\lvs i->RNode (i, a) lvs) <$> 'CM'.sequence cs <*> getState <* modify inc
  59
  60
  61
  62
  63
  64         =
  65
  66 directoryShare :: ROShared FilePath [(FilePath, MaybeOSError FileInfo)]
  67 directoryShare = SDSSource {SDSSource | name = "directoryShare", read = read, write=write}
  68 where
  69         read p iw
  70                 # (merr, iw) = liftIWorld (readDirectory p) iw
  71                 | isError merr = (liftError (first exception merr), iw)
  72                 # (Ok files) = merr
  73                 # (fis, iw) = liftIWorld (seqList (map getFileInfo files)) iw
  74                 = (Ok $ sortBy fst [(f, fi)\\f<-files & fi<-fis], iw)
  75
  76         write p w iw = (Ok (const (const False)), iw)
  77 //import iTasks
  78 //import iTasks.Extensions.Files
  79 //
  80 //Start w = startEngine (
  81 //      selectFile "/opt/clean/lib" () False []
  82 //      >&> viewSharedInformation "Selection" []) w