filepicker/test.icl

   1 module test
   2
   3 import Control.Monad.State
   4 import Control.Monad.Identity
   5 import Control.Applicative
   6 import System.OS
   7 import qualified Control.Monad as M
   8 from Control.Monad import `b`, mapM, class Monad(bind)
   9 import StdArray
  10 import Data.Tree
  11 import Data.Functor
  12 import Data.Tuple
  13 import Data.Func
  14 import System.Directory
  15 import System.File
  16 import Text.HTML
  17 import Text
  18 import iTasks
  19 import iTasks.Internal.SDS => qualified modify
  20 import iTasks.Internal.Task
  21
  22 import StdDebug, StdMisc
  23
  24 derive class iTask RTree, FileInfo, Tm
  25
  26 Start w = startEngine (selecter "/home/mrl/projects" 2) w
  27
  28 recurseDirectory :: Int FilePath FilePath *World -> *(MaybeOSError (RTree (FilePath, Bool)), *World)
  29 recurseDirectory maxdepth acc fp w
  30 # fp = acc </> fp
  31 = case getFileInfo fp w of
  32         (Error (i, e), w) = (Error (i, e +++ " in fileinfo " +++ fp), w)
  33         (Ok fi, w)
  34                 | not fi.directory = (Ok $ RNode (fp, False) [], w)
  35                 = case readDirectory fp w of
  36                         (Error (i, e), w) = (Error (i, e +++ " in readDir " +++ fp), w)
  37                         (Ok cs, w)
  38                                 | maxdepth == 0 = (Ok $ RNode (fp, True) [], w)
  39                                 = appFst ((fmap $ RNode (fp, True)) o 'M'.sequence)
  40                                         $ mapSt (recurseDirectory (maxdepth - 1) fp) (filter real cs) w
  41 where
  42         real i = IF_POSIX (i <> ".." && i <> ".") True
  43
  44 selecter :: !FilePath Int -> Task String
  45 selecter fp maxdepth = accWorldOSError (recurseDirectory maxdepth fp "")
  46         >>= \ds->editSelection "Examples" False (SelectInTree (\x->[evalState (toTree x) 0]) fromTree) ds []
  47         @? tvHd
  48 where
  49         toTree :: (RTree (FilePath, Bool)) -> State Int ChoiceNode
  50         toTree (RNode (fp, _) forest)
  51                 = getState `b` \i->put (i+1) `b` \_->mapM toTree forest `b` \cs->pure
  52                         {id=i,label=bn fp,icon=Nothing,expanded=i==0,children=cs}
  53
  54         bn :: FilePath -> FilePath
  55         bn x = if (endsWith {pathSeparator} x) (bn $ fst $ splitFileName x) (dropDirectory x)
  56
  57         fromTree :: (RTree (FilePath, Bool)) [Int] -> [FilePath]
  58         fromTree t [i] = map fst $ filter (not o snd) [foldTree (\f fs->[f:flatten fs]) t !! i]