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.

Annex/UUID.hs

@@ -30,7 +30,7 @@ configkey = "annex.uuid"
 {- Generates a UUID. There is a library for this, but it's not packaged,
  - so use the command line tool. -}
 genUUID :: IO UUID
-genUUID = pOpen ReadFromPipe command params $ liftM read . hGetLine
+genUUID = pOpen ReadFromPipe command params $ liftM toUUID . hGetLine
 	where
 		command = SysConfig.uuid
 		params = if command == "uuid"
@@ -56,12 +56,12 @@ getRepoUUID r = do
 			return u
 		else return c
 	where
-		cached g = read $ Git.configGet g cachekey ""
+		cached g = toUUID $ Git.configGet g cachekey ""
 		updatecache g u = when (g /= r) $ storeUUID cachekey u
 		cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid"
 
 getUncachedUUID :: Git.Repo -> UUID
-getUncachedUUID r = read $ Git.configGet r configkey ""
+getUncachedUUID r = toUUID $ Git.configGet r configkey ""
 
 {- Make sure that the repo has an annex.uuid setting. -}
 prepUUID :: Annex ()
@@ -69,4 +69,4 @@ prepUUID = whenM ((==) NoUUID <$> getUUID) $
 	storeUUID configkey =<< liftIO genUUID
 
 storeUUID :: String -> UUID -> Annex ()
-storeUUID configfield uuid = setConfig configfield (show uuid)
+storeUUID configfield = setConfig configfield . fromUUID

Command/ConfigList.hs

@@ -21,5 +21,5 @@ seek = [withNothing start]
 start :: CommandStart
 start = do
 	u <- getUUID
-	liftIO $ putStrLn $ "annex.uuid=" ++ show u
+	liftIO $ putStrLn $ "annex.uuid=" ++ fromUUID u
 	stop

Command/Map.hs

@@ -62,7 +62,8 @@ drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others
 		others = map (unreachable . uuidnode) $
 			filter (`notElem` ruuids) (M.keys umap)
 		trusted = map (trustworthy . uuidnode) ts
-		uuidnode u = Dot.graphNode (show u) $ M.findWithDefault "" u umap
+		uuidnode u = Dot.graphNode (fromUUID u) $
+			M.findWithDefault "" u umap
 
 hostname :: Git.Repo -> String
 hostname r

Common/Annex.hs

@@ -1,6 +1,7 @@
 module Common.Annex (
 	module Common,
 	module Types,
+	module Types.UUID,
 	module Annex,
 	module Locations,
 	module Messages,
@@ -8,6 +9,7 @@ module Common.Annex (
 
 import Common
 import Types
+import Types.UUID (toUUID, fromUUID)
 import Annex (gitRepo)
 import Locations
 import Messages

Crypto.hs

@@ -102,14 +102,18 @@ describeCipher (EncryptedCipher _ (KeyIds ks)) =
 {- Stores an EncryptedCipher in a remote's configuration. -}
 storeCipher :: RemoteConfig -> EncryptedCipher -> RemoteConfig
 storeCipher c (EncryptedCipher t ks) = 
-	M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (show ks) c
+	M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c
+	where
+		showkeys (KeyIds l) = join "," l
 
 {- Extracts an EncryptedCipher from a remote's configuration. -}
 extractCipher :: RemoteConfig -> Maybe EncryptedCipher
 extractCipher c = 
 	case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of
-		(Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (read ks)
+		(Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (readkeys ks)
 		_ -> Nothing
+	where
+		readkeys = KeyIds . split ","
 
 {- Encrypts a Cipher to the specified KeyIds. -}
 encryptCipher :: Cipher -> KeyIds -> IO EncryptedCipher

Logs/Location.hs

@@ -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.) -}

Logs/Presence.hs

@@ -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

Logs/Trust.hs

@@ -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"
 

Logs/UUIDBased.hs

@@ -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

Remote.hs

@@ -100,7 +100,7 @@ byName' n = do
 		then return $ Left $ "there is no git remote named \"" ++ n ++ "\""
 		else return $ Right $ head match
 	where
-		matching r = n == name r || read n == uuid r
+		matching r = n == name r || toUUID n == uuid r
 
 {- Looks up a remote by name (or by UUID, or even by description),
  - and returns its UUID. Finds even remotes that are not configured in
@@ -116,7 +116,7 @@ nameToUUID n = byName' n >>= go
 			case M.lookup n $ transform swap m of
 				Just u -> return $ Just u
 				Nothing -> return $ byuuid m
-		byuuid m = M.lookup (read n) $ transform double m
+		byuuid m = M.lookup (toUUID n) $ transform double m
 		transform a = M.fromList . map a . M.toList
 		swap (a, b) = (b, a)
 		double (a, _) = (a, a)
@@ -142,8 +142,8 @@ prettyPrintUUIDs desc uuids = do
 		remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
 		findlog m u = M.findWithDefault "" u m
 		prettify m here u
-			| not (null d) = show u ++ " -- " ++ d
-			| otherwise = show u
+			| not (null d) = fromUUID u ++ " -- " ++ d
+			| otherwise = fromUUID u
 			where
 				ishere = here == u
 				n = findlog m u
@@ -152,7 +152,7 @@ prettyPrintUUIDs desc uuids = do
 					| ishere = addname n "here"
 					| otherwise = n
 		jsonify m here u = toJSObject
-			[ ("uuid", toJSON $ show u)
+			[ ("uuid", toJSON $ fromUUID u)
 			, ("description", toJSON $ findlog m u)
 			, ("here", toJSON $ here == u)
 			]

Remote/Bup.hs

@@ -161,13 +161,15 @@ storeBupUUID u buprepo = do
 		then do
 			showAction "storing uuid"
 			onBupRemote r boolSystem "git"
-				[Params $ "config annex.uuid " ++ show u]
+				[Params $ "config annex.uuid " ++ v]
 					>>! error "ssh failed"
 		else liftIO $ do
 			r' <- Git.configRead r
 			let olduuid = Git.configGet r' "annex.uuid" ""
-			when (olduuid == "") $
-				Git.run r' "config" [Param "annex.uuid", Param $ show u]
+			when (olduuid == "") $ Git.run r' "config"
+				[Param "annex.uuid", Param v]
+	where
+		v = fromUUID u
 
 onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a
 onBupRemote r a command params = do
@@ -192,7 +194,7 @@ getBupUUID r u
 	| otherwise = liftIO $ do
 		ret <- try $ Git.configRead r
 		case ret of
-			Right r' -> return (read $ Git.configGet r' "annex.uuid" "", r')
+			Right r' -> return (toUUID $ Git.configGet r' "annex.uuid" "", r')
 			Left _ -> return (NoUUID, r)
 
 {- Converts a bup remote path spec into a Git.Repo. There are some

Remote/Helper/Special.hs

@@ -32,7 +32,7 @@ gitConfigSpecialRemote u c k v = do
 	g <- gitRepo
 	liftIO $ do
 		Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
-		Git.run g "config" [Param (configsetting "annex-uuid"), Param $ show u]
+		Git.run g "config" [Param (configsetting "annex-uuid"), Param $ fromUUID u]
 	where
 		remotename = fromJust (M.lookup "name" c)
 		configsetting s = "remote." ++ remotename ++ "." ++ s

Remote/S3real.hs

@@ -64,7 +64,7 @@ s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
 s3Setup u c = handlehost $ M.lookup "host" c
 	where
 		remotename = fromJust (M.lookup "name" c)
-		defbucket = remotename ++ "-" ++ show u
+		defbucket = remotename ++ "-" ++ fromUUID u
 		defaults = M.fromList
 			[ ("datacenter", "US")
 			, ("storageclass", "STANDARD")

Types/Crypto.hs

@@ -7,17 +7,9 @@
 
 module Types.Crypto where
 
-import Data.String.Utils
-
 -- XXX ideally, this would be a locked memory region
 newtype Cipher = Cipher String
 
 data EncryptedCipher = EncryptedCipher String KeyIds
 
 newtype KeyIds = KeyIds [String]
-
-instance Show KeyIds where
-	show (KeyIds ks) = join "," ks
-
-instance Read KeyIds where
-	readsPrec _ s = [(KeyIds (split "," s), "")]

Types/TrustLevel.hs

@@ -17,14 +17,4 @@ import Types.UUID
 data TrustLevel = SemiTrusted | UnTrusted | Trusted
 	deriving Eq
 
-instance Show TrustLevel where
-        show SemiTrusted = "?"
-        show UnTrusted = "0"
-        show Trusted = "1"
-
-instance Read TrustLevel where
-        readsPrec _ "1" = [(Trusted, "")]
-        readsPrec _ "0" = [(UnTrusted, "")]
-	readsPrec _ _ = [(SemiTrusted, "")]
-
 type TrustMap = M.Map UUID TrustLevel

Types/UUID.hs

@@ -9,13 +9,12 @@ module Types.UUID where
 
 -- A UUID is either an arbitrary opaque string, or UUID info may be missing.
 data UUID = NoUUID | UUID String
-	deriving (Eq, Ord)
+	deriving (Eq, Ord, Show)
 
-instance Show UUID where
-	show (UUID u) = u
-	show NoUUID = ""
+fromUUID :: UUID -> String
+fromUUID (UUID u) = u
+fromUUID NoUUID = ""
 
-instance Read UUID where
-	readsPrec _ s
-		| null s = [(NoUUID, "")]
-		| otherwise = [(UUID s, "")]
+toUUID :: String -> UUID
+toUUID [] = NoUUID
+toUUID s = UUID s

Upgrade/V1.hs

@@ -178,7 +178,7 @@ fileKey1 file = readKey1 $
 	replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
 
 writeLog1 :: FilePath -> [LogLine] -> IO ()
-writeLog1 file ls = viaTmp writeFile file (unlines $ map show ls)
+writeLog1 file ls = viaTmp writeFile file (showLog ls)
 
 readLog1 :: FilePath -> IO [LogLine]
 readLog1 file = catch (parseLog <$> readFileStrict file) (const $ return [])

git-annex-shell.hs

@@ -45,9 +45,9 @@ options = commonOptions ++
 	where
 		check expected = do
 			u <- getUUID
-			when (u /= read expected) $ error $
+			when (u /= toUUID expected) $ error $
 				"expected repository UUID " ++ expected
-					++ " but found UUID " ++ show u
+					++ " but found UUID " ++ fromUUID u
 
 header :: String
 header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"