clean up read/show abuse
Avoid ever using read to parse a non-haskell formatted input string. show :: Key is arguably still show abuse, but displaying Keys as filenames is just too useful to give up.
This commit is contained in:
parent
fdf988be6d
commit
b11a63a860
18 changed files with 75 additions and 98 deletions
|
@ -37,7 +37,7 @@ logChange repo _ NoUUID _ = error $
|
|||
{- Returns a list of repository UUIDs that, according to the log, have
|
||||
- the value of a key. -}
|
||||
keyLocations :: Key -> Annex [UUID]
|
||||
keyLocations key = map read <$> (currentLog . logFile) key
|
||||
keyLocations key = map toUUID <$> (currentLog . logFile) key
|
||||
|
||||
{- Finds all keys that have location log information.
|
||||
- (There may be duplicate keys in the list.) -}
|
||||
|
|
|
@ -16,6 +16,7 @@ module Logs.Presence (
|
|||
addLog,
|
||||
readLog,
|
||||
parseLog,
|
||||
showLog,
|
||||
logNow,
|
||||
compactLog,
|
||||
currentLog,
|
||||
|
@ -36,41 +37,9 @@ data LogLine = LogLine {
|
|||
info :: String
|
||||
} deriving (Eq)
|
||||
|
||||
data LogStatus = InfoPresent | InfoMissing | Undefined
|
||||
data LogStatus = InfoPresent | InfoMissing
|
||||
deriving (Eq)
|
||||
|
||||
instance Show LogStatus where
|
||||
show InfoPresent = "1"
|
||||
show InfoMissing = "0"
|
||||
show Undefined = "undefined"
|
||||
|
||||
instance Read LogStatus where
|
||||
readsPrec _ "1" = [(InfoPresent, "")]
|
||||
readsPrec _ "0" = [(InfoMissing, "")]
|
||||
readsPrec _ _ = [(Undefined, "")]
|
||||
|
||||
instance Show LogLine where
|
||||
show (LogLine d s i) = unwords [show d, show s, i]
|
||||
|
||||
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
|
||||
then maybe bad good pdate
|
||||
else bad
|
||||
where
|
||||
w = words string
|
||||
s = read $ w !! 1
|
||||
i = w !! 2
|
||||
pdate :: Maybe UTCTime
|
||||
pdate = parseTime defaultTimeLocale "%s%Qs" $ head w
|
||||
|
||||
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s i
|
||||
bad = ret $ LogLine 0 Undefined ""
|
||||
ret v = [(v, "")]
|
||||
|
||||
addLog :: FilePath -> LogLine -> Annex ()
|
||||
addLog file line = Annex.Branch.change file $ \s ->
|
||||
showLog $ compactLog (line : parseLog s)
|
||||
|
@ -80,15 +49,26 @@ addLog file line = Annex.Branch.change file $ \s ->
|
|||
readLog :: FilePath -> Annex [LogLine]
|
||||
readLog file = parseLog <$> Annex.Branch.get file
|
||||
|
||||
{- Parses a log file. Unparseable lines are ignored. -}
|
||||
parseLog :: String -> [LogLine]
|
||||
parseLog = filter parsable . map read . lines
|
||||
parseLog = mapMaybe (parseline . words) . lines
|
||||
where
|
||||
-- some lines may be unparseable, avoid them
|
||||
parsable l = status l /= Undefined
|
||||
parseline (a:b:c:_) = do
|
||||
d <- parseTime defaultTimeLocale "%s%Qs" a
|
||||
s <- parsestatus b
|
||||
Just $ LogLine (utcTimeToPOSIXSeconds d) s c
|
||||
parseline _ = Nothing
|
||||
parsestatus "1" = Just InfoPresent
|
||||
parsestatus "0" = Just InfoMissing
|
||||
parsestatus _ = Nothing
|
||||
|
||||
{- Generates a log file. -}
|
||||
showLog :: [LogLine] -> String
|
||||
showLog = unlines . map show
|
||||
showLog = unlines . map genline
|
||||
where
|
||||
genline (LogLine d s i) = unwords [show d, genstatus s, i]
|
||||
genstatus InfoPresent = "1"
|
||||
genstatus InfoMissing = "0"
|
||||
|
||||
{- Generates a new LogLine with the current date. -}
|
||||
logNow :: LogStatus -> String -> Annex LogLine
|
||||
|
|
|
@ -45,18 +45,26 @@ trustMap = do
|
|||
|
||||
parseTrust :: String -> Maybe TrustLevel
|
||||
parseTrust s
|
||||
| length w > 0 = readMaybe $ head w
|
||||
| length w > 0 = Just $ parse $ head w
|
||||
-- back-compat; the trust.log used to only list trusted repos
|
||||
| otherwise = Just Trusted
|
||||
| otherwise = Just $ Trusted
|
||||
where
|
||||
w = words s
|
||||
parse "1" = Trusted
|
||||
parse "0" = UnTrusted
|
||||
parse _ = SemiTrusted
|
||||
|
||||
showTrust :: TrustLevel -> String
|
||||
showTrust SemiTrusted = "?"
|
||||
showTrust UnTrusted = "0"
|
||||
showTrust Trusted = "1"
|
||||
|
||||
{- Changes the trust level for a uuid in the trustLog. -}
|
||||
trustSet :: UUID -> TrustLevel -> Annex ()
|
||||
trustSet uuid@(UUID _) level = do
|
||||
ts <- liftIO $ getPOSIXTime
|
||||
Annex.Branch.change trustLog $
|
||||
showLog show . changeLog ts uuid level . parseLog parseTrust
|
||||
showLog showTrust . changeLog ts uuid level . parseLog parseTrust
|
||||
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
|
||||
trustSet NoUUID _ = error "unknown UUID; cannot modify trust level"
|
||||
|
||||
|
|
|
@ -50,28 +50,27 @@ showLog :: (a -> String) -> Log a -> String
|
|||
showLog shower = unlines . map showpair . M.toList
|
||||
where
|
||||
showpair (k, LogEntry (Date p) v) =
|
||||
unwords [show k, shower v, tskey ++ show p]
|
||||
unwords [fromUUID k, shower v, tskey ++ show p]
|
||||
showpair (k, LogEntry Unknown v) =
|
||||
unwords [show k, shower v]
|
||||
unwords [fromUUID k, shower v]
|
||||
|
||||
parseLog :: (String -> Maybe a) -> String -> Log a
|
||||
parseLog parser = M.fromListWith best . catMaybes . map pair . lines
|
||||
parseLog parser = M.fromListWith best . catMaybes . map parse . lines
|
||||
where
|
||||
pair line
|
||||
parse line
|
||||
| null ws = Nothing
|
||||
| otherwise = case parser $ unwords info of
|
||||
Nothing -> Nothing
|
||||
Just v -> Just (read u, LogEntry c v)
|
||||
| otherwise = parser (unwords info) >>= makepair
|
||||
where
|
||||
makepair v = Just (toUUID u, LogEntry ts v)
|
||||
ws = words line
|
||||
u = head ws
|
||||
end = last ws
|
||||
c
|
||||
ts
|
||||
| tskey `isPrefixOf` end =
|
||||
pdate $ tail $ dropWhile (/= '=') end
|
||||
| otherwise = Unknown
|
||||
info
|
||||
| c == Unknown = drop 1 ws
|
||||
| ts == Unknown = drop 1 ws
|
||||
| otherwise = drop 1 $ init ws
|
||||
pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
|
||||
Nothing -> Unknown
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue