1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{- git-annex UUID type
-
- Copyright 2011-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
module Types.UUID where
import qualified Data.ByteString as B
import qualified Data.ByteString.Short as SB
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Data.UUID as U
import Data.Maybe
import Data.String
import Data.ByteString.Builder
import Control.DeepSeq
import qualified Data.Semigroup as Sem
import Common
import Git.Types (ConfigValue(..))
import Utility.QuickCheck
import Utility.Aeson
import qualified Utility.SimpleProtocol as Proto
-- A UUID is either an arbitrary opaque string, or UUID info may be missing.
data UUID = NoUUID | UUID B.ByteString
deriving (Eq, Ord, Show, Read)
instance NFData UUID where
rnf NoUUID = ()
rnf (UUID b) = rnf b
class FromUUID a where
fromUUID :: UUID -> a
class ToUUID a where
toUUID :: a -> UUID
instance FromUUID UUID where
fromUUID = id
instance ToUUID UUID where
toUUID = id
instance FromUUID B.ByteString where
fromUUID (UUID u) = u
fromUUID NoUUID = B.empty
instance ToUUID B.ByteString where
toUUID b
| B.null b = NoUUID
| otherwise = UUID b
instance FromUUID SB.ShortByteString where
fromUUID (UUID u) = SB.toShort u
fromUUID NoUUID = SB.empty
instance ToUUID SB.ShortByteString where
toUUID b
| SB.null b = NoUUID
| otherwise = UUID (SB.fromShort b)
#ifdef WITH_OSPATH
-- OsPath is a ShortByteString internally, so this is the most
-- efficient conversion.
instance FromUUID OsPath where
fromUUID s = toOsPath (fromUUID s :: SB.ShortByteString)
instance ToUUID OsPath where
toUUID s = toUUID (fromOsPath s :: SB.ShortByteString)
#endif
instance FromUUID String where
fromUUID s = decodeBS (fromUUID s)
instance ToUUID String where
toUUID s = toUUID (encodeBS s)
instance FromUUID ConfigValue where
fromUUID s = (ConfigValue (fromUUID s))
instance ToUUID ConfigValue where
toUUID (ConfigValue v) = toUUID v
toUUID NoConfigValue = NoUUID
-- There is no matching FromUUID U.UUID because a git-annex UUID may
-- be NoUUID or perhaps contain something not allowed in a canonical UUID.
instance ToUUID U.UUID where
toUUID = toUUID . U.toASCIIBytes
instance ToJSON' UUID where
toJSON' (UUID u) = toJSON' u
toJSON' NoUUID = toJSON' ""
instance FromJSON UUID where
parseJSON (String t)
| isUUID s = pure (toUUID s)
| otherwise = mempty
where
s = T.unpack t
parseJSON _ = mempty
buildUUID :: UUID -> Builder
buildUUID (UUID b) = byteString b
buildUUID NoUUID = mempty
isUUID :: String -> Bool
isUUID = isJust . U.fromString
-- A description of a UUID.
newtype UUIDDesc = UUIDDesc B.ByteString
deriving (Eq, Sem.Semigroup, Monoid, IsString)
fromUUIDDesc :: UUIDDesc -> String
fromUUIDDesc (UUIDDesc d) = decodeBS d
toUUIDDesc :: String -> UUIDDesc
toUUIDDesc = UUIDDesc . encodeBS
type UUIDDescMap = M.Map UUID UUIDDesc
instance Proto.Serializable UUID where
serialize = fromUUID
deserialize = Just . toUUID
instance Arbitrary UUID where
arbitrary = frequency [(1, return NoUUID), (3, UUID <$> arb)]
where
arb = encodeBS <$> listOf1 (elements uuidchars)
uuidchars = '-' : ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
|
