implementation module directories // some simple utility tasks for directory access and text file creation import StdFile import FilePath, Directory, StdString import _WinBase import iTasks derive class iTask MaybeError, DirPath, DirFile derive bimap Maybe, (,) :: DirPath = DirPath Absolute Relative :: Absolute :== String // absolute path :: Relative :== [String] // relative path :: DirFile = TextFile FileName // only files of this particular kind are shown | Directory FileName :: FileName :== String instance toString DirPath where toString (DirPath absPath names) = absPath +++ foldl (\x y -> x +++ (toString pathSeparator) +++ y) "" names // ------------- getInitialPath :: DirFile -> Task DirPath getInitialPath (Directory "") = getInitialPath (Directory "temp") getInitialPath (Directory name) = accWorld getCurrentDirectory >>= \(Ok dir) -> mkDir (DirPath dir [name]) where mkDir dirPath=:(DirPath dir [name]) = readDir dirPath >>= \(ok,_) -> if ok (return dirPath) (newDir (DirPath dir []) (Directory name) >>| return dirPath) getInitialPath _ = getInitialPath (Directory "temp") newDir :: DirPath DirFile -> Task Bool newDir (DirPath abs rel) (Directory name) = accWorld (createDirectory (toString (DirPath abs (rel ++ [name])))) >>= \result -> case result of (Ok _) -> return True _ -> return False newDir _ _ = return False removeDir :: DirPath DirFile -> Task Bool removeDir (DirPath abs rel) (Directory name) = accWorld (removeDirectory (toString (DirPath abs (rel ++ [name])))) >>= \result -> case result of (Ok _) -> return True _ -> return False removeDir _ _ = return False readDir :: DirPath -> Task (Bool,[DirFile]) readDir dirPath = accWorld (readDirectory (toString dirPath)) >>= \result -> case result of (Error _) -> return (False,[]) (Ok names) -> return (True,[TextFile name \\ name <- names | takeExtension name == "txt"] ++ [Directory name \\ name <- names | takeExtension name == "" && name <> "." && name <> ".."]) getParent :: DirPath -> Task DirPath getParent dirPath=:(DirPath abs rel) | length rel > 1 = return (DirPath abs (init rel)) = return dirPath openDirectory :: DirPath DirFile -> Task DirPath openDirectory dirPath=:(DirPath abs rel) (Directory name) = return (DirPath abs (rel ++ [name])) openDirectory dirPath _ = return dirPath safeTextFile :: DirPath DirFile String -> Task Bool safeTextFile dirPath (TextFile fileName) text = accWorld (safeFileMonad dirPath fileName text) where safeFileMonad :: DirPath String String *World -> (Bool,*World) safeFileMonad dirPath fileName text world # (ok,file,world) = fopen (toString dirPath +++ toString pathSeparator +++ fileName) FWriteText world | not ok = (False,world) # file = fwrites text file = fclose file world safeTextFile _ _ _ = return False readTextFile :: DirPath DirFile -> Task (Bool,String) readTextFile dirPath (TextFile fileName) = accWorld (readFileMonad (toString dirPath +++ toString pathSeparator +++ fileName)) where readFileMonad :: String *World -> ((Bool,String),*World) readFileMonad fileName world # (ok,file,world) = fopen fileName FReadText world | not ok = ((False,""),world) # (text,file) = freads file 1000000 | text == "" = ((False,""),world) # (ok,world) = fclose file world | not ok = ((False,""),world) = ((True,text),world) readTextFile _ _ = return (False,"") deleteTextFile :: DirPath DirFile -> Task Bool deleteTextFile dirPath (TextFile fileName) = accWorld (deleteFileA (toString dirPath +++ toString pathSeparator +++ fileName)) >>= \i -> return (i == 0) deleteTextFile _ _ = return False