1{- git-annex presence log, pure operations 2 - 3 - Copyright 2010-2019 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8module Logs.Presence.Pure where 9 10import Annex.Common 11import Annex.VectorClock 12import Logs.Line 13import Utility.QuickCheck 14 15import qualified Data.Map as M 16import qualified Data.ByteString.Lazy as L 17import qualified Data.ByteString as S 18import qualified Data.ByteString.Char8 as C8 19import qualified Data.Attoparsec.ByteString.Lazy as A 20import Data.Attoparsec.ByteString.Char8 (char, anyChar) 21import Data.ByteString.Builder 22import Data.Char 23 24newtype LogInfo = LogInfo { fromLogInfo :: S.ByteString } 25 deriving (Show, Eq, Ord) 26 27data LogLine = LogLine 28 { date :: VectorClock 29 , status :: LogStatus 30 , info :: LogInfo 31 } deriving (Eq, Show) 32 33data LogStatus = InfoPresent | InfoMissing | InfoDead 34 deriving (Eq, Show, Bounded, Enum) 35 36parseLog :: L.ByteString -> [LogLine] 37parseLog = fromMaybe [] . A.maybeResult . A.parse logParser 38 39logParser :: A.Parser [LogLine] 40logParser = parseLogLines $ LogLine 41 <$> vectorClockParser 42 <* char ' ' 43 <*> statusParser 44 <* char ' ' 45 <*> (LogInfo <$> A.takeByteString) 46 47statusParser :: A.Parser LogStatus 48statusParser = do 49 c <- anyChar 50 case c of 51 '1' -> return InfoPresent 52 '0' -> return InfoMissing 53 'X' -> return InfoDead 54 _ -> fail "unknown status character" 55 56parseStatus :: String -> Maybe LogStatus 57parseStatus "1" = Just InfoPresent 58parseStatus "0" = Just InfoMissing 59parseStatus "X" = Just InfoDead 60parseStatus _ = Nothing 61 62buildLog :: [LogLine] -> Builder 63buildLog = mconcat . map genline 64 where 65 genline (LogLine c s (LogInfo i)) = 66 buildVectorClock c <> sp <> genstatus s <> sp <> byteString i <> nl 67 sp = charUtf8 ' ' 68 nl = charUtf8 '\n' 69 genstatus InfoPresent = charUtf8 '1' 70 genstatus InfoMissing = charUtf8 '0' 71 genstatus InfoDead = charUtf8 'X' 72 73{- Given a log, returns only the info that is are still in effect. -} 74getLog :: L.ByteString -> [LogInfo] 75getLog = map info . filterPresent . parseLog 76 77{- Returns the info from LogLines that are in effect. -} 78filterPresent :: [LogLine] -> [LogLine] 79filterPresent = filter (\l -> InfoPresent == status l) . compactLog 80 81{- Compacts a set of logs, returning a subset that contains the current 82 - status. -} 83compactLog :: [LogLine] -> [LogLine] 84compactLog = mapLog . logMap 85 86type LogMap = M.Map LogInfo LogLine 87 88mapLog :: LogMap -> [LogLine] 89mapLog = M.elems 90 91logMap :: [LogLine] -> LogMap 92logMap = foldr insertNewerLogLine M.empty 93 94insertBetter :: (LogLine -> Bool) -> LogLine -> LogMap -> Maybe LogMap 95insertBetter betterthan l m 96 | better = Just (M.insert i l m) 97 | otherwise = Nothing 98 where 99 better = maybe True betterthan (M.lookup i m) 100 i = info l 101 102{- Inserts a log into a map of logs, if the log has newer 103 - information than the other logs in the map for the same info. -} 104insertNewerLogLine :: LogLine -> LogMap -> LogMap 105insertNewerLogLine l m = fromMaybe m $ insertBetter newer l m 106 where 107 newer l' = date l' <= date l 108 109{- Inserts the log unless there's already one in the map with 110 - the same status for its info, in which case there's no need to 111 - change anything, to avoid log churn. -} 112insertNewStatus :: LogLine -> LogMap -> Maybe LogMap 113insertNewStatus l m = insertBetter diffstatus l m 114 where 115 diffstatus l' = status l' /= status l 116 117instance Arbitrary LogLine where 118 arbitrary = LogLine 119 <$> arbitrary 120 <*> elements [minBound..maxBound] 121 <*> (LogInfo <$> arbinfo) 122 where 123 -- Avoid newline characters, which cannot appear in 124 -- LogInfo. 125 -- 126 -- Avoid non-ascii values because fully arbitrary 127 -- strings may not be encoded using the filesystem 128 -- encoding, which is normally applied to all input. 129 arbinfo = (encodeBS <$> arbitrary `suchThat` all isAscii) 130 `suchThat` (\b -> C8.notElem '\n' b && C8.notElem '\r' b) 131 132prop_parse_build_presence_log :: [LogLine] -> Bool 133prop_parse_build_presence_log l = 134 parseLog (toLazyByteString (buildLog l)) == l 135