-- | Low-level operators. module System.FileSystem.Operators ( (<:) , (<<:) , (?:) , (=:) , (-:) , (<-:) ) where import Data.Maybe (fromJust) import Control.Arrow (first,second) import System.FileSystem.Types {--------------------------------------------------- -- For code readers: This is the not so pretty part of the code, but full of Haskell syntax (patterns, cases, conditionals, ...). In the other hand, the library works thanks to this module. So, if there is a bug, probably it comes from here. Before read these lines, you must to know the Path type and the FileSystem types, defined in the Types module. ---------------------------------------------------} -- | Operator for addition of new files/directories. (<:) :: Path -> FileSystem -> FileSystem p <: fs = case pathList p of [] -> if isFilePath p then let rightFile = fromJust $ pathFile p add :: InApp [FSE] add [] = [ Right rightFile ] add (e:es) = case e of Right f -> if getFN f == getFN rightFile then Right rightFile : es else e : add es _ -> e : add es in modDirCnt add fs else fs (x:xs) -> let pathTail = p { pathList = xs } add :: InApp [FSE] add [] = [ Left (x , pathTail <: emptyFileSystem) ] add (e:es) = case e of Left (n,fs') -> if n == x then Left (n, pathTail <: fs') : es else e : add es _ -> e : add es in modDirCnt add fs -- | Operator for addition of new file system elements ('FSE'). (<<:) :: FSE -> FileSystem -> FileSystem (<<:) fse = let add :: InApp [FSE] add [] = [fse] add (e:es) = case e of Right f' -> case fse of Right f -> if getFN f == getFN f' then fse : es else e : add es _ -> e : add es Left (dn',fs') -> case fse of Left (dn,fs) -> let fs'' = foldr (<<:) fs' $ dirCnt fs in if dn == dn' then Left (dn,fs'') : es else e : add es _ -> e : add es in modDirCnt add -- | Operator for search a file. (?:) :: FPath -> FileSystem -> Maybe File (dp,fn) ?: fs = case dp of [] -> let search :: [FSE] -> Maybe File search [] = Nothing search (x:xs) = case x of Right f -> if fn == getFN f then Just f else search xs _ -> search xs in search $ dirCnt fs (d:ds) -> let search :: [FSE] -> Maybe File search [] = Nothing search (x:xs) = case x of Left (dn,fs') -> if d == dn then (ds,fn) ?: fs' else search xs _ -> search xs in search $ dirCnt fs -- | Descension operator. Extract the file system of an immediate subdirectory. (=:) :: DirName -> FileSystem -> Maybe FileSystem dn =: fs = case dirCnt fs of [] -> Nothing (x:xs) -> case x of Left (dn',fs') -> if dn == dn' then Just fs' else dn =: Directory xs _ -> dn =: Directory xs -- | Substraction operator. Search and remove a file/directory from a file system. (-:) :: Path -> FileSystem -> FileSystem p -: fs = case pathList p of [] -> if isFilePath p then let remove :: InApp [FSE] remove [] = [] remove (e:es) = case e of Right f -> if (getFN . fromJust . pathFile) p == getFN f then es else e : remove es _ -> e : remove es in modDirCnt remove fs else fs (x:xs) -> let pathTail = p { pathList = xs } remove :: InApp [FSE] remove [] = [] remove (e:es) = case e of Left (dn,fs') -> if dn == x then Left (dn , pathTail -: fs') : es else e : remove es _ -> e : remove es in case xs of [] -> if isFilePath p then modDirCnt remove fs else let remove' :: InApp [FSE] remove' [] = [] remove' (e:es) = case e of Left (dn,fs') -> if dn == x then es else e : remove' es _ -> e : remove' es in modDirCnt remove' fs _ -> modDirCnt remove fs -- | If the Bool argument is True, rename a directory, otherwise a file. (<-:*) :: (String,String,Bool) -> FileSystem -> (FileSystem,Bool) (<-:*) (s1,s2,b) = let (&:) :: FSE -> ([FSE],Bool) -> ([FSE],Bool) (&:) e = first (e:) rename :: [FSE] -> ([FSE],Bool) rename [] = ([],False) rename (e:es) = case e of Left (dn,fs') -> if dn == s1 && b then ( Left (s2,fs') : es , True ) else e &: rename es Right f -> if getFN f == s1 && not b then ( Right ( f { getFN = s2 } ) : es , True ) else e &: rename es in first Directory . rename . dirCnt -- | Substitution operator. /Provisional implementation/. (<-:) :: ([String],[String],Bool) -> FileSystem -> (FileSystem,Bool) ([s1],[s2],b) <-: fs = (s1,s2,b) <-:* fs ( (d1:t1@(_:_)) , (d2:t2@(_:_)) , b ) <-: fs = if d1 == d2 then (t1,t2,b) <-: fs else (fs,False) _ <-: fs = (fs,False)