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 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. -}
|
||||||
|
|
|
@ -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
|
||||||
|
|
12
demo.log
12
demo.log
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue