summaryrefslogtreecommitdiff
path: root/Key.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-03-15 17:47:29 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-03-15 17:53:39 -0400
commitfe09c2b7231485afced594cd27582bc6bd32f250 (patch)
tree1a59e8df8cab8bc1e96d009f7b7a3a2070596960 /Key.hs
parent0e0f85e09d975a6062fb417f8bbae5fbadb6f79f (diff)
a new Key data type with metadata
Diffstat (limited to 'Key.hs')
-rw-r--r--Key.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/Key.hs b/Key.hs
new file mode 100644
index 000000000..cc4effb11
--- /dev/null
+++ b/Key.hs
@@ -0,0 +1,88 @@
+{- git-annex Key data type
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Key where
+
+import Data.String.Utils
+import Test.QuickCheck
+import Data.Maybe
+import Data.List
+
+{- A Key has a unique name, is associated with a backend,
+ - and may contain other metadata. -}
+data Field = KeyName | KeyBackend | KeySize | KeyModTime
+ deriving (Eq, Ord, Show)
+newtype Key = Key [(Field, String)]
+ deriving (Eq, Ord)
+
+{- Generates a Key given a name, a backend and a list of other metadata. -}
+keyGen :: String -> String -> [(Field, String)] -> Key
+keyGen name backend meta = Key $ (KeyName, name):(KeyBackend, backend):meta
+
+{- Gets the name of a Key. -}
+keyName :: Key -> String
+keyName key = fromJust $ keyField key KeyName
+
+{- Gets the backend associated with a Key. -}
+keyBackend :: Key -> String
+keyBackend key = fromJust $ keyField key KeyBackend
+
+{- Looks up a given Field of a Key's metadata. -}
+keyField :: Key -> Field -> Maybe String
+keyField (Key meta) field =
+ if null matches
+ then Nothing
+ else Just $ snd $ head matches
+ where
+ matches = filter match meta
+ match (f, _) = f == field
+
+fieldSep :: Char
+fieldSep = ','
+
+{- Keys show as strings that are suitable for use as filenames.
+ - The name field is always shown last, and is the only field
+ - allowed to contain the fieldSep. -}
+instance Show Key where
+ show k@(Key meta) = join [fieldSep] $ map showp meta' ++ [name]
+ where
+ name = 'n':keyName k
+ meta' = sort $ (filter (\(f, _) -> f /= KeyName)) meta
+ showp (f, v) = (field f) : v
+
+ field KeyBackend = 'b'
+ field KeySize = 's'
+ field KeyModTime = 'm'
+ field f = error $ "unknown key field" ++ show f
+
+instance Read Key where
+ readsPrec _ s = [(Key (meta s []), "")]
+ where
+ meta (c:r) m = findfield c r m
+ meta [] m = m
+
+ findfield 'n' v m = (KeyName, v):m -- rest is name
+ findfield c v m = let (v', _:r) = span (/= fieldSep) v in
+ meta r (field c v' m)
+
+ field 'b' v m = (KeyBackend, v):m
+ field 's' v m = (KeySize, v):m
+ field 'm' v m = (KeyModTime, v):m
+ field _ _ m = m -- just ignore unparseable fields
+
+-- for quickcheck
+instance Arbitrary Key where
+ arbitrary = do
+ backendname <- arbitrary
+ value <- arbitrary
+ return $ keyGen value backendname []
+
+prop_idempotent_key_read_show :: Key -> Bool
+prop_idempotent_key_read_show k
+ -- backend names will never contain the fieldSep
+ | fieldSep `elem` (keyBackend k) = True
+ | otherwise = k == (read $ show k)