This commit is contained in:
Joey Hess 2011-03-15 18:15:44 -04:00
parent fe09c2b723
commit 940c4e361d

16
Key.hs
View file

@ -60,19 +60,19 @@ instance Show Key where
field f = error $ "unknown key field" ++ show f field f = error $ "unknown key field" ++ show f
instance Read Key where instance Read Key where
readsPrec _ s = [(Key (meta s []), "")] readsPrec _ s = [(Key (findfields s []), "")]
where where
meta (c:r) m = findfield c r m findfields ('n':v) m = (KeyName, v):m -- rest is name
meta [] m = m findfields (c:v) m =
case span (/= fieldSep) v of
findfield 'n' v m = (KeyName, v):m -- rest is name (v', _:r) -> findfields r (field c v' m)
findfield c v m = let (v', _:r) = span (/= fieldSep) v in _ -> m
meta r (field c v' m) findfields [] m = m
field 'b' v m = (KeyBackend, v):m field 'b' v m = (KeyBackend, v):m
field 's' v m = (KeySize, v):m field 's' v m = (KeySize, v):m
field 'm' v m = (KeyModTime, v):m field 'm' v m = (KeyModTime, v):m
field _ _ m = m -- just ignore unparseable fields field _ _ m = m
-- for quickcheck -- for quickcheck
instance Arbitrary Key where instance Arbitrary Key where