blob: 78a5b5f2275dd4965b39baedcab09dc1090d446a (
plain)
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
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.UUID.Typed where
import Control.Monad.IO.Class
import GHC.Generics
import Text.Read
import Control.DeepSeq
import Data.Aeson as JSON
import Data.Aeson.Types as JSON
import Data.Binary
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
import Data.Data
import Data.Hashable
import qualified Data.Text as T
import Data.Text (Text)
import Foreign.Storable
import System.Random
import Web.HttpApiData
import Data.Validity
import Data.Validity.UUID ()
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
newtype UUID a = UUID
{ unUUID :: UUID.UUID
} deriving ( Eq
, Ord
, Generic
, Data
, Storable
, Binary
, NFData
, Hashable
, Random
)
instance Validity (UUID a)
instance Show (UUID a) where
show (UUID u) = show u
instance Read (UUID a) where
readPrec = UUID <$> readPrec
uuidBs :: UUID a -> SB.ByteString
uuidBs (UUID uuid) = UUID.toASCIIBytes uuid
uuidLBs :: UUID a -> LB.ByteString
uuidLBs = LB.fromStrict . uuidBs
uuidString :: UUID a -> String
uuidString (UUID uuid) = UUID.toString uuid
uuidText :: UUID a -> Text
uuidText (UUID uuid) = UUID.toText uuid
nextRandomUUID :: MonadIO m => m (UUID a)
nextRandomUUID = liftIO $ UUID <$> UUID.nextRandom
parseUUID :: Text -> Maybe (UUID a)
parseUUID = fmap UUID . UUID.fromText
parseUUIDString :: String -> Maybe (UUID a)
parseUUIDString = fmap UUID . UUID.fromString
instance FromJSONKey (UUID a) where
fromJSONKey = FromJSONKeyTextParser textJSONParseUUID
instance ToJSONKey (UUID a) where
toJSONKey = toJSONKeyText (UUID.toText . unUUID)
instance FromJSON (UUID a) where
parseJSON = jsonParseUUID
jsonParseUUID :: Value -> Parser (UUID a)
jsonParseUUID = withText "UUID" textJSONParseUUID
textJSONParseUUID :: Text -> Parser (UUID a)
textJSONParseUUID t =
case UUID.fromText t of
Nothing -> fail "Invalid Text when parsing UUID"
Just u -> pure $ UUID u
instance ToJSON (UUID a) where
toJSON (UUID u) = JSON.String $ UUID.toText u
instance FromHttpApiData (UUID a) where
parseUrlPiece t =
case UUID.fromText t of
Nothing -> fail $ "Invalid UUID in Url Piece: " ++ T.unpack t
Just uuid -> pure $ UUID uuid
instance ToHttpApiData (UUID a) where
toUrlPiece (UUID uuid) = UUID.toText uuid
|
