aboutsummaryrefslogtreecommitdiff
path: root/Key.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-06-01 21:56:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-06-01 21:56:04 -0400
commit703c437bd9c6cb9e4675b65ac2b107f76b135d71 (patch)
treea6f35036bdd2b33aca50fd899448a0f6e3b60507 /Key.hs
parent971ab27e7820a3228f71dd42f3e870c0fc2f4345 (diff)
rename modules for data types into Types/ directory
Diffstat (limited to 'Key.hs')
-rw-r--r--Key.hs74
1 files changed, 0 insertions, 74 deletions
diff --git a/Key.hs b/Key.hs
deleted file mode 100644
index e1d8ee34d..000000000
--- a/Key.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{- git-annex Key data type
- -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Key (
- Key(..),
- stubKey,
- readKey,
-
- prop_idempotent_key_read_show
-) where
-
-import Utility
-import System.Posix.Types
-
-{- A Key has a unique name, is associated with a key/value backend,
- - and may contain other optional metadata. -}
-data Key = Key {
- keyName :: String,
- keyBackendName :: String,
- keySize :: Maybe Integer,
- keyMtime :: Maybe EpochTime
-} deriving (Eq, Ord)
-
-stubKey :: Key
-stubKey = Key {
- keyName = "",
- keyBackendName = "",
- keySize = Nothing,
- keyMtime = Nothing
-}
-
-fieldSep :: Char
-fieldSep = '-'
-
-{- Keys show as strings that are suitable for use as filenames.
- - The name field is always shown last, separated by doubled fieldSeps,
- - and is the only field allowed to contain the fieldSep. -}
-instance Show Key where
- show Key { keyBackendName = b, keySize = s, keyMtime = m, keyName = n } =
- b +++ ('s' ?: s) +++ ('m' ?: m) +++ (fieldSep : n)
- where
- "" +++ y = y
- x +++ "" = x
- x +++ y = x ++ fieldSep:y
- c ?: (Just v) = c:(show v)
- _ ?: _ = ""
-
-readKey :: String -> Maybe Key
-readKey s = if key == Just stubKey then Nothing else key
- where
- key = startbackend stubKey s
-
- startbackend k v = sepfield k v addbackend
-
- sepfield k v a = case span (/= fieldSep) v of
- (v', _:r) -> findfields r $ a k v'
- _ -> Nothing
-
- findfields (c:v) (Just k)
- | c == fieldSep = Just $ k { keyName = v }
- | otherwise = sepfield k v $ addfield c
- findfields _ v = v
-
- addbackend k v = Just k { keyBackendName = v }
- addfield 's' k v = Just k { keySize = readMaybe v }
- addfield 'm' k v = Just k { keyMtime = readMaybe v }
- addfield _ _ _ = Nothing
-
-prop_idempotent_key_read_show :: Key -> Bool
-prop_idempotent_key_read_show k = Just k == (readKey $ show k)