use Data.Time instead of Data.DateTime

The latter has shady rounding. The new module is a bit harder to use, but
worth it, it adds subsecond timestamps too.
This commit is contained in:
Joey Hess 2010-10-10 22:20:52 -04:00
parent dc5e8853f3
commit c5d7ca0a5a
3 changed files with 35 additions and 28 deletions

View file

@ -11,6 +11,7 @@ import Locations
import Types import Types
import Backend import Backend
import BackendList import BackendList
import LocationLog
{- On startup, examine the git repo, prepare it, and record state for {- On startup, examine the git repo, prepare it, and record state for
- later. -} - later. -}

View file

@ -18,7 +18,9 @@
module LocationLog where module LocationLog where
import Data.DateTime import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as Map import qualified Data.Map as Map
import System.IO import System.IO
import System.Directory import System.Directory
@ -28,6 +30,12 @@ import Utility
import Locations import Locations
import Types import Types
data LogLine = LogLine {
date :: POSIXTime,
status :: LogStatus,
reponame :: String
} deriving (Eq)
data LogStatus = FilePresent | FileMissing | Undefined data LogStatus = FilePresent | FileMissing | Undefined
deriving (Eq) deriving (Eq)
@ -41,29 +49,30 @@ instance Read LogStatus where
readsPrec _ "0" = [(FileMissing, "")] readsPrec _ "0" = [(FileMissing, "")]
readsPrec _ _ = [(Undefined, "")] readsPrec _ _ = [(Undefined, "")]
data LogLine = LogLine {
date :: DateTime,
status :: LogStatus,
repo :: String
} deriving (Eq)
instance Show LogLine where instance Show LogLine where
show (LogLine date status repo) = unwords show (LogLine date status reponame) = unwords
[(show (toSeconds date)), (show status), repo] [(show date), (show status), reponame]
instance Read LogLine where instance Read LogLine where
-- This parser is robust in that even unparsable log lines are -- This parser is robust in that even unparsable log lines are
-- read without an exception being thrown. -- read without an exception being thrown.
-- Such lines have a status of Undefined. -- Such lines have a status of Undefined.
readsPrec _ string = readsPrec _ string =
if (length w >= 3 && all isDigit date) if (length w >= 3)
then [((LogLine (fromSeconds $ read date) status repo), "")] then case (pdate) of
else [((LogLine (fromSeconds 0) Undefined ""), "")] Just v -> good v
Nothing -> undefined
else undefined
where where
w = words string w = words string
date = w !! 0 date = w !! 0
status = read $ w !! 1 status = read $ w !! 1
repo = unwords $ drop 2 w reponame = unwords $ drop 2 w
pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status reponame
undefined = ret $ LogLine (0) Undefined ""
ret v = [(v, "")]
{- Reads a log file. {- Reads a log file.
- Note that the LogLines returned may be in any order. -} - Note that the LogLines returned may be in any order. -}
@ -97,9 +106,9 @@ writeLog file lines = do
{- Generates a new LogLine with the current date. -} {- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> IO LogLine logNow :: LogStatus -> String -> IO LogLine
logNow status repo = do logNow status reponame = do
now <- getCurrentTime now <- getPOSIXTime
return $ LogLine now status repo return $ LogLine now status reponame
{- Returns the filename of the log file for a given annexed file. -} {- Returns the filename of the log file for a given annexed file. -}
logFile :: GitRepo -> FilePath -> IO String logFile :: GitRepo -> FilePath -> IO String
@ -113,7 +122,7 @@ fileLocations :: GitRepo -> FilePath -> IO [String]
fileLocations thisrepo file = do fileLocations thisrepo file = do
log <- logFile thisrepo file log <- logFile thisrepo file
lines <- readLog log lines <- readLog log
return $ map repo (filterPresent lines) return $ map reponame (filterPresent lines)
{- Filters the list of LogLines to find ones where the file {- Filters the list of LogLines to find ones where the file
- is (or should still be) present. -} - is (or should still be) present. -}
@ -131,12 +140,9 @@ compactLog' map (l:ls) = compactLog' (mapLog map l) ls
- information about a repo than the other logs in the map -} - information about a repo than the other logs in the map -}
mapLog map log = mapLog map log =
if (better) if (better)
then Map.insert (repo log) log map then Map.insert (reponame log) log map
else map else map
where where
better = case (Map.lookup (repo log) map) of better = case (Map.lookup (reponame log) map) of
-- <= used because two log entries could
-- have the same timestamp; if so the one that
-- is seen last should win.
Just l -> (date l <= date log) Just l -> (date l <= date log)
Nothing -> True Nothing -> True

View file

@ -1,11 +1,11 @@
1286654242 1 repo 1286654242s 1 repo
1286652724 0 foo 1286652724s 0 foo
1286656282 1 foo 1286656282s 1 foo
1286656282 0 repo 1286656282s 0 repo
1286656281 0 foo 1286656281s 0 foo
# some garbage, should be ignored # some garbage, should be ignored
a a a a a a
a 1 a a 1 a
-1 a a -1 a a
1286652724 1 foo 1286652724.0001s 1 foo