Skip to content
Browse files

Removed SVN stuff

  • Loading branch information...
1 parent a12cd09 commit d1c6fef90c379e5c6b7cdc72213d5b682782a09f nathan committed
View
39 DirTools/.svn/entries
@@ -1,39 +0,0 @@
-9
-
-dir
-0
-https://funion.googlecode.com/svn/trunk/DirTools
-https://funion.googlecode.com/svn
-add
-
-
-
-
-
-
-
-svn:special svn:externals svn:needs-lock
-
-DirTools.hs
-file
-
-
-
-add
-
-10803b5caea56a1154214d4d161a60ac
-
-
-
-has-props
-has-prop-mods
-
-
-
-
-
-
-copied
-https://funion.googlecode.com/svn/trunk/DirTools.hs
-3
-
View
1 DirTools/.svn/format
@@ -1 +0,0 @@
-9
View
5 DirTools/.svn/props/DirTools.hs.svn-work
@@ -1,5 +0,0 @@
-K 13
-svn:mergeinfo
-V 0
-
-END
View
146 DirTools/.svn/text-base/DirTools.hs.svn-base
@@ -1,146 +0,0 @@
-module DirTools where
-
-import System.Directory
-import System.Time
-import Data.List
-import Control.Monad
-
-{-
- Need to generate the filetree view that I want to present.
- The entry should contain the actual path along with the
- fake path.
--}
-
-data FSEntryStatistics = FSEntryStatistics {
- fsEntryFileName :: String
- , fsEntryActualPath :: FilePath
- , fsEntryVirtualPath :: FilePath
- , fsEntryPermissions :: Permissions
- , fsEntryModificationTime :: ClockTime
- }
- deriving (Show)
-
-data File = File {
- fileStats :: FSEntryStatistics
- }
- deriving (Show)
-
-data Directory = Directory {
- dirStats :: FSEntryStatistics
- , dirFiles :: [File]
- , dirDirs :: [Directory]
- }
- deriving (Show)
-
-treeUnion :: FilePath -> [Directory] -> Directory
-treeUnion path [] = undefined
-treeUnion path dirs =
- Directory (FSEntryStatistics {
- fsEntryFileName = fsEntryFileName newDirStatistics
- , fsEntryActualPath = ""
- , fsEntryVirtualPath = newPath
- , fsEntryPermissions = r_x
- , fsEntryModificationTime = TOD 1234567890 0 -- need to improve
- })
- (unionFiles $ sortByFileName $ concat $ map (dirFiles) dirs)
- (unionDirs $ sortByDirName $ concat $ map (dirDirs) dirs)
- where
- newDirStatistics = dirStats $ head dirs
- newPath = path ++ "/" ++(fsEntryFileName newDirStatistics)
-
- sortByFileName = sortBy (\a b -> compare (fsEntryFileName $ fileStats a) (fsEntryFileName $ fileStats b))
-
- sameFileName :: File -> File -> Bool
- sameFileName (File stat1) (File stat2) = (fsEntryFileName stat1) == (fsEntryFileName stat2)
-
- unionFiles :: [File] -> [File]
- unionFiles files = concat $ map (renameFiles 0) $ groupBy (sameFileName) files
-
- renameFiles :: Int -> [File] -> [File]
- renameFiles n [x] = [updateFileName n x]
- renameFiles n (x:xs) = (updateFileName n x) : (renameFiles (n+1) xs)
-
- updateFileName :: Int -> File -> File
- updateFileName n (File (FSEntryStatistics name actpath virtpath perm time)) = File (FSEntryStatistics {
- fsEntryFileName = name ++ ext
- , fsEntryActualPath = actpath
- , fsEntryVirtualPath =newPath ++ "/" ++ name ++ ext
- , fsEntryPermissions = perm
- , fsEntryModificationTime = time
- })
- where ext = if n == 0 then "" else "~" ++ show n
-
- sortByDirName = sortBy (\a b -> compare (fsEntryFileName $ dirStats a) (fsEntryFileName $ dirStats b))
-
- sameDirName :: Directory -> Directory -> Bool
- sameDirName (Directory stat1 _ _) (Directory stat2 _ _) = (fsEntryFileName stat1) == (fsEntryFileName stat2)
-
- unionDirs :: [Directory] -> [Directory]
- unionDirs dirs = map (treeUnion (newPath)) $ groupBy (sameDirName) dirs
-
-
-r_x = Permissions { readable = True, writable = False, executable = True, searchable = True}
-
-prettyTree tree = prettyTree' 0 [tree]
-prettyTree' tabStop treeLevel = concat $ map (prettyEntry tabStop) treeLevel
-
-prettyStats tabStop stats = (concat $ replicate tabStop " ") ++
- fsEntryFileName stats ++ " " ++ fsEntryVirtualPath stats ++ " " ++
- fsEntryActualPath stats ++ "\n"
-
-prettyEntry :: Int -> Directory -> String
-prettyEntry tabStop (Directory stats files dirs) = "*"++ (prettyStats tabStop stats) ++ (concat $ map ((prettyStats $ tabStop+1) . fileStats) files) ++ (concat $ map (prettyEntry $ tabStop+1) dirs)
-
-dirContents :: FilePath -> IO [FilePath]
-dirContents = fmap (filter (`notElem` [".",".."])) . getDirectoryContents
-
-dirExists :: FilePath -> String -> IO Bool
-dirExists path name = doesDirectoryExist (path ++ "/" ++ name)
-
-fileExists :: FilePath -> String -> IO Bool
-fileExists path name = doesFileExist (path ++ "/" ++ name)
-
-getStats :: FilePath -> String -> IO FSEntryStatistics
-getStats path name = do
- let uri = path ++ "/" ++ name
- perm <- getPermissions uri
- time <- getModificationTime uri
- return FSEntryStatistics {
- fsEntryFileName = name
- , fsEntryActualPath = uri
- , fsEntryVirtualPath = ""
- , fsEntryPermissions = perm
- , fsEntryModificationTime = time
- }
-
-
-
-readDir :: FilePath -> String -> IO Directory
-readDir path name = do
- let uri = path ++ "/" ++ name
- perm <- getPermissions uri
- time <- getModificationTime uri
- contents <- dirContents uri
- --files <- filterM (doesFileExist) $ map (uri++) contents
- files <- filterM (fileExists uri) contents
- fileList <- mapM (getStats (uri)) files
-
- -- list of directories
- dirs <- filterM (dirExists uri) contents
- dirtree <- mapM (readDir uri) dirs
-
- return $ Directory (FSEntryStatistics {
- fsEntryFileName = name
- , fsEntryActualPath = path ++ name
- , fsEntryVirtualPath = ""
- , fsEntryPermissions = perm
- , fsEntryModificationTime = time
- }) (map (File) fileList)
- dirtree
-
-
-main = do
- dir <- readDir "/dvds" "tv"
- dir' <- readDir "/disk2/dvds" "tv"
- putStrLn $ prettyTree $ treeUnion "" [dir,dir']
-

0 comments on commit d1c6fef

Please sign in to comment.
Something went wrong with that request. Please try again.