filepicker/test.icl

   1 module test
   2
   3 import StdFunctions
   4 import System.Directory
   5 import System.File
   6 import System.FilePath
   7 import Data.List
   8 import Data.Functor
   9 import Data.Tree
  10 import qualified Control.Monad as CM
  11 import Control.Applicative
  12 import Control.Monad.Identity
  13 import Control.Monad.State
  14 import iTasks
  15
  16 derive class iTask RTree, FileInfo, Tm
  17
  18 Start w = startEngine (selectFile "select a file" "/opt/clean") w
  19
  20 selectFile :: !d !FilePath -> Task FilePath | toPrompt d
  21 selectFile d root = accWorld (createDirectoryTree root (Just 1)) >>= \tree->
  22         withShared tree \stree->let numberedtree = mapRead numberTree stree in
  23         withShared [] \ssel->
  24         editSharedSelectionWithShared d False selOpt numberedtree ssel
  25         -|| whileUnchanged (ssel >*< numberedtree) (\(sel, tree)->case sel of
  26                 [i] = case find ((==)i o fst) (leafs tree) of
  27                         Just (i, (fp, Ok {directory=True}))
  28                                 = accWorld (createDirectoryTree fp (Just 1))
  29                                 @ flip (mergeIn i) tree
  30                                 >>= \newtree->set ([], newtree) (ssel >*< stree) @? const NoValue
  31                         _ = unstable ()
  32                 _ = unstable ()
  33         )
  34         -|| viewSharedInformation "tree" [] (mapRead (drawRTree o fmap toSingleLineText) numberedtree)
  35         @? tvHd
  36         @ fst o snd
  37 where
  38         mergeIn j newtree = foldTree \(i, t) cs->if (i == j) newtree (RNode t cs)
  39
  40         unstable a = treturn a @? \(Value a _)->Value a False
  41
  42         selOpt :: SelectOption (RTree (Int, (FilePath, MaybeOSError FileInfo))) (Int, (FilePath, MaybeOSError FileInfo))
  43         selOpt = SelectInTree
  44                 (\tree->[{foldTree fp2cn tree & label=root}])
  45                 (\tree sel->[t\\t=:(i, _)<-leafs tree | isMember i sel])
  46
  47         fp2cn (i, (fp, mfi)) cs =
  48                 { id = i
  49                 , label=dropDirectory fp
  50                 , icon=Nothing
  51                 , expanded=True
  52                 , children=cs
  53                 }
  54
  55 numberTree :: ((RTree a) -> RTree (Int, a))
  56 numberTree = flip evalState zero o foldTree \a cs->
  57         (\lvs i->RNode (i, a) lvs) <$> 'CM'.sequence cs <*> getState <* modify inc