robustness

This commit is contained in:
Joey Hess 2010-10-09 23:35:05 -04:00
parent 011118dbdf
commit 381e6f84e5
2 changed files with 20 additions and 19 deletions

View file

@ -6,6 +6,7 @@ import Directory
import System.Directory
import System.Path
import Data.String.Utils
import Utility
{- Given a relative or absolute filename, calculates the name to use
- relative to a git repository directory (which must be absolute).
@ -49,16 +50,8 @@ seekUp dir want = do
if ok
then return (Just dir)
else case (parentDir dir) of
(Just d) -> seekUp d want
Nothing -> return Nothing
parentDir :: String -> Maybe String
parentDir dir =
if length dirs > 0
then Just ("/" ++ (join "/" $ take ((length dirs) - 1) dirs))
else Nothing
where
dirs = filter (\x -> length x > 0) $ split "/" dir
"" -> return Nothing
d -> seekUp d want
isRepoTop dir = do
r <- isGitRepo dir

View file

@ -19,6 +19,7 @@ module LocationLog where
import Data.DateTime
import System.IO
import System.Directory
import GitRepo
import Utility
@ -55,22 +56,29 @@ instance Read LogLine where
where
date = fromSeconds $ read $ w !! 0
status = read $ w !! 1
repo = unwords $ rest w
repo = unwords $ drop 2 w
w = words string
rest (_:_:l) = l
{- Reads a log file -}
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
readLog :: String -> IO [LogLine]
readLog file = do
h <- openLocked file ReadMode
s <- hGetContents h
-- hClose handle' -- TODO disabled due to lazy IO issue
-- filter out any unparsable lines
return $ filter (\l -> (status l) /= Undefined ) $ map read $ lines s
exists <- doesFileExist file
if exists
then do
h <- openLocked file ReadMode
s <- hGetContents h
-- hClose handle' -- TODO disabled due to lazy IO issue
-- filter out any unparsable lines
return $ filter (\l -> (status l) /= Undefined )
$ map read $ lines s
else do
return []
{- Adds a LogLine to a log file -}
writeLog :: String -> LogLine -> IO ()
writeLog file line = do
createDirectoryIfMissing True (parentDir file)
h <- openLocked file AppendMode
hPutStrLn h $ show line
hClose h
@ -99,4 +107,4 @@ fileLocations file = do
{- Filters the list of LogLines to find repositories where the file
- is (or should still be) present. -}
filterPresent :: [LogLine] -> [LogLine]
filterPresent lines =
filterPresent lines = error "unimplimented" -- TODO