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:
parent
dc5e8853f3
commit
c5d7ca0a5a
3 changed files with 35 additions and 28 deletions
1
Annex.hs
1
Annex.hs
|
@ -11,6 +11,7 @@ import Locations
|
|||
import Types
|
||||
import Backend
|
||||
import BackendList
|
||||
import LocationLog
|
||||
|
||||
{- On startup, examine the git repo, prepare it, and record state for
|
||||
- later. -}
|
||||
|
|
|
@ -18,7 +18,9 @@
|
|||
|
||||
module LocationLog where
|
||||
|
||||
import Data.DateTime
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Time
|
||||
import System.Locale
|
||||
import qualified Data.Map as Map
|
||||
import System.IO
|
||||
import System.Directory
|
||||
|
@ -28,6 +30,12 @@ import Utility
|
|||
import Locations
|
||||
import Types
|
||||
|
||||
data LogLine = LogLine {
|
||||
date :: POSIXTime,
|
||||
status :: LogStatus,
|
||||
reponame :: String
|
||||
} deriving (Eq)
|
||||
|
||||
data LogStatus = FilePresent | FileMissing | Undefined
|
||||
deriving (Eq)
|
||||
|
||||
|
@ -41,29 +49,30 @@ instance Read LogStatus where
|
|||
readsPrec _ "0" = [(FileMissing, "")]
|
||||
readsPrec _ _ = [(Undefined, "")]
|
||||
|
||||
data LogLine = LogLine {
|
||||
date :: DateTime,
|
||||
status :: LogStatus,
|
||||
repo :: String
|
||||
} deriving (Eq)
|
||||
|
||||
instance Show LogLine where
|
||||
show (LogLine date status repo) = unwords
|
||||
[(show (toSeconds date)), (show status), repo]
|
||||
show (LogLine date status reponame) = unwords
|
||||
[(show date), (show status), reponame]
|
||||
|
||||
instance Read LogLine where
|
||||
-- This parser is robust in that even unparsable log lines are
|
||||
-- read without an exception being thrown.
|
||||
-- Such lines have a status of Undefined.
|
||||
readsPrec _ string =
|
||||
if (length w >= 3 && all isDigit date)
|
||||
then [((LogLine (fromSeconds $ read date) status repo), "")]
|
||||
else [((LogLine (fromSeconds 0) Undefined ""), "")]
|
||||
if (length w >= 3)
|
||||
then case (pdate) of
|
||||
Just v -> good v
|
||||
Nothing -> undefined
|
||||
else undefined
|
||||
where
|
||||
w = words string
|
||||
date = w !! 0
|
||||
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.
|
||||
- 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. -}
|
||||
logNow :: LogStatus -> String -> IO LogLine
|
||||
logNow status repo = do
|
||||
now <- getCurrentTime
|
||||
return $ LogLine now status repo
|
||||
logNow status reponame = do
|
||||
now <- getPOSIXTime
|
||||
return $ LogLine now status reponame
|
||||
|
||||
{- Returns the filename of the log file for a given annexed file. -}
|
||||
logFile :: GitRepo -> FilePath -> IO String
|
||||
|
@ -113,7 +122,7 @@ fileLocations :: GitRepo -> FilePath -> IO [String]
|
|||
fileLocations thisrepo file = do
|
||||
log <- logFile thisrepo file
|
||||
lines <- readLog log
|
||||
return $ map repo (filterPresent lines)
|
||||
return $ map reponame (filterPresent lines)
|
||||
|
||||
{- Filters the list of LogLines to find ones where the file
|
||||
- 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 -}
|
||||
mapLog map log =
|
||||
if (better)
|
||||
then Map.insert (repo log) log map
|
||||
then Map.insert (reponame log) log map
|
||||
else map
|
||||
where
|
||||
better = case (Map.lookup (repo log) map) of
|
||||
-- <= used because two log entries could
|
||||
-- have the same timestamp; if so the one that
|
||||
-- is seen last should win.
|
||||
better = case (Map.lookup (reponame log) map) of
|
||||
Just l -> (date l <= date log)
|
||||
Nothing -> True
|
||||
|
|
12
demo.log
12
demo.log
|
@ -1,11 +1,11 @@
|
|||
1286654242 1 repo
|
||||
1286652724 0 foo
|
||||
1286656282 1 foo
|
||||
1286656282 0 repo
|
||||
1286656281 0 foo
|
||||
1286654242s 1 repo
|
||||
1286652724s 0 foo
|
||||
1286656282s 1 foo
|
||||
1286656282s 0 repo
|
||||
1286656281s 0 foo
|
||||
# some garbage, should be ignored
|
||||
a a a
|
||||
|
||||
a 1 a
|
||||
-1 a a
|
||||
1286652724 1 foo
|
||||
1286652724.0001s 1 foo
|
||||
|
|
Loading…
Reference in a new issue