git.iko.soy/typeable/id
on ef95481 help sign in
aa466ff
swap
0 ahead, 18 behind
cabal.projectdeleted−11
since splitsnapshots
unifiedsplit
@@ -1,11 +0,0 @@
1−packages:
2− .
3−
4−-- To compile with js-backend use this:
5−source-repository-package
6− type: git
7− location: https://github.com/typeable/uuid.git
8− tag: 49f50ae517de0e4d5dfbf783edc61e71cfd54d6b
9− subdir:
10− uuid
11− uuid-types
id.cabal+28−69
@@ -1,77 +1,36 @@
1−cabal-version: 2.4
1+cabal-version: 2.4
2−name: id
3−version: 0.2.0.0
4−license-file: LICENSE
5
2
6−flag cassava
3+name: id
7− description: Enable Postgresql support
4+version: 0.1.0.0
8− default: True
5+license-file: LICENSE
9− manual: False
10−
11−flag postgres
12− description: Enable Postgresql support
13− default: True
14− manual: False
15−
16−flag flat
17− description: Enable Flat serialization support
18− default: True
19− manual: False
20−
21−flag store
22− description: Enable Data.Store serialization support
23− default: False
24− manual: False
25−
26−flag uuid-impl
27− description: Include some functions with extra dependencies.
28− Disable to reduce dependencies.
29− default: True
30− manual: False
31
6
32library
7library
33− exposed-modules: Data.Id
8+ exposed-modules:
9+ Data.Id
10+ -- other-modules:
11+ -- other-extensions:
34 build-depends:
12 build-depends:
35− , aeson >=1.0
13+ aeson,
36− , base >=4.12 && <5
14+ base >=4.12 && <5,
37− , binary
15+ binary,
38− , deepseq
16+ deepseq,
17+ flat,
39− , hashable
18+ hashable,
40− , http-api-data
19+ http-api-data,
41− , lens
20+ lens,
21+ openapi3,
42− , path-pieces
22+ path-pieces,
43− , text
23+ text,
44− , uuid-types
24+ QuickCheck,
45− if flag(uuid-impl)
25+ uuid,
46− build-depends:
47− , uuid >=1.3.9
48− cpp-options: -DUSE_UUID
49−
50− if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
26+ if !impl(ghcjs)
51 build-depends:
27 build-depends:
52− , openapi3
28+ cassava,
53− , QuickCheck
54−
55− cpp-options: -DBACKEND
56−
57− if (flag(postgres) && !(impl(ghcjs) || arch(javascript) || arch(wasm32)))
58− build-depends: postgresql-simple
29+ postgresql-simple,
59− cpp-options: -DUSE_POSTGRES
60−
61− if (flag(cassava) && !(impl(ghcjs) || arch(javascript) || arch(wasm32)))
62− build-depends: cassava
63− cpp-options: -DUSE_CASSAVA
64−
65− if flag(flat)
66− build-depends: flat >=0.4
67− cpp-options: -DUSE_FLAT
68−
69− if flag(store)
70− build-depends: store
71− cpp-options: -DUSE_STORE
72−
73− hs-source-dirs: src
30+ hs-source-dirs:
31+ src
74− default-language: Haskell2010
32+ default-language:
33+ Haskell2010
75 default-extensions:
34 default-extensions:
76 AllowAmbiguousTypes
35 AllowAmbiguousTypes
77 DeriveGeneric
36 DeriveGeneric
src/Data/Id.hs+24−89
@@ -4,12 +4,9 @@
4{-# OPTIONS_GHC -Wno-orphans #-}
4{-# OPTIONS_GHC -Wno-orphans #-}
5
5
6module Data.Id
6module Data.Id
7− ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
7+ ( Id, mkId, unId, randomId, unsafeIdTagConvert, coerceId, _Id, nilId
8 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
8 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
9 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
9 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
10−#ifdef USE_UUID
11− , randomId
12−#endif
13 )
10 )
14 where
11 where
15
12
@@ -21,52 +18,33 @@ import Data.Binary (Binary)
21import Data.Coerce (coerce)
18import Data.Coerce (coerce)
22import Data.Data
19import Data.Data
23import Data.Hashable (Hashable)
20import Data.Hashable (Hashable)
21+import Data.OpenApi
24import Data.String
22import Data.String
25import Data.Text as T
23import Data.Text as T
26−import Data.UUID.Types (UUID)
24+import Data.UUID (UUID)
27−import qualified Data.UUID.Types as UUID
25+import qualified Data.UUID as UUID
28−import GHC.TypeLits
29−import Prelude as P
30−import Text.ParserCombinators.ReadP
31−import Web.HttpApiData
32−import Web.PathPieces (PathPiece(..))
33−
34−#ifdef USE_UUID
35import qualified Data.UUID.V4 as UUID.V4
26import qualified Data.UUID.V4 as UUID.V4
36−#endif
27+#ifndef ghcjs_HOST_OS
37−#ifdef BACKEND
38−import Data.OpenApi
39−import Test.QuickCheck
40−#ifdef USE_CASSAVA
41−import Data.Csv as Csv hiding(Name)
42−#endif
43−#ifdef USE_POSTGRES
44import Database.PostgreSQL.Simple.FromField as PG (FromField)
28import Database.PostgreSQL.Simple.FromField as PG (FromField)
45import Database.PostgreSQL.Simple.ToField as PG (ToField)
29import Database.PostgreSQL.Simple.ToField as PG (ToField)
30+import Data.Csv as Csv hiding(Name)
46#endif
31#endif
47−#endif
48−
49−#ifdef USE_FLAT
50import Flat as F
32import Flat as F
51−#endif
33+import GHC.TypeLits
52−#ifdef USE_STORE
34+import Test.QuickCheck
53−import qualified Data.Store
35+import Text.ParserCombinators.ReadP
54−#endif
36+import Web.HttpApiData
37+import Web.PathPieces (PathPiece(..))
55
38
56newtype Id t = Id { unId :: UUID }
39newtype Id t = Id { unId :: UUID }
57 deriving stock Data
40 deriving stock Data
58 deriving newtype
41 deriving newtype
59 ( Eq, Ord, Binary
42 ( Eq, Ord, Binary
60#ifndef ghcjs_HOST_OS
43#ifndef ghcjs_HOST_OS
61−#ifdef USE_POSTGRES
62 , PG.ToField, PG.FromField
44 , PG.ToField, PG.FromField
63#endif
45#endif
64−#endif
65− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
46+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
66−#ifdef BACKEND
67− , ToSchema, ToParamSchema
68−#endif
69− , FromHttpApiData, ToHttpApiData )
47+ , ToParamSchema, FromHttpApiData, ToHttpApiData )
70
48
71type role Id nominal
49type role Id nominal
72
50
@@ -76,42 +54,29 @@ mkId :: forall s. UUID -> Id s
76mkId = coerce
54mkId = coerce
77{-# INLINE mkId #-}
55{-# INLINE mkId #-}
78
56
79−#ifdef USE_UUID
80randomId :: forall s. IO (Id s)
57randomId :: forall s. IO (Id s)
81randomId = coerce <$> UUID.V4.nextRandom
58randomId = coerce <$> UUID.V4.nextRandom
82{-# INLINE randomId #-}
59{-# INLINE randomId #-}
83−#endif
84
60
85instance KnownSymbol s => Show (Id s) where
61instance KnownSymbol s => Show (Id s) where
86− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
62+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
87
63
88instance KnownSymbol s => Read (Id s) where
64instance KnownSymbol s => Read (Id s) where
89 readsPrec _ = readP_to_S $ do
65 readsPrec _ = readP_to_S $ do
90 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
66 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
91 mkId <$> readS_to_P reads
67 mkId <$> readS_to_P reads
92
68
93−#ifdef USE_FLAT
94instance Flat (Id s) where
69instance Flat (Id s) where
95 encode = F.encode . UUID.toWords . coerce
70 encode = F.encode . UUID.toWords . coerce
96 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
71 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
97 size = F.size . UUID.toWords . coerce
72 size = F.size . UUID.toWords . coerce
98−#endif
99
73
100−#ifdef USE_STORE
101−instance Data.Store.Store (Id s) where
102− poke = Data.Store.poke . UUID.toWords . coerce
103− peek = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> Data.Store.peek
104− size = Data.Store.ConstSize 16
105−#endif
106−
107−#ifdef BACKEND
108instance Arbitrary (Id t) where
74instance Arbitrary (Id t) where
109 arbitrary = fmap Id $ UUID.fromWords
75 arbitrary = fmap Id $ UUID.fromWords
110 <$> arbitrary
76 <$> arbitrary
111 <*> arbitrary
77 <*> arbitrary
112 <*> arbitrary
78 <*> arbitrary
113 <*> arbitrary
79 <*> arbitrary
114−#endif
115
80
116instance PathPiece (Id t) where
81instance PathPiece (Id t) where
117 fromPathPiece = coerce . UUID.fromText
82 fromPathPiece = coerce . UUID.fromText
@@ -119,14 +84,12 @@ instance PathPiece (Id t) where
119
84
120#ifndef ghcjs_HOST_OS
85#ifndef ghcjs_HOST_OS
121
86
122−#ifdef USE_CASSAVA
123instance Csv.FromField (Id tag) where
87instance Csv.FromField (Id tag) where
124 parseField = parseField
88 parseField = parseField
125 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
89 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
126
90
127instance Csv.ToField (Id tag) where
91instance Csv.ToField (Id tag) where
128 toField = Csv.toField . UUID.toText . coerce
92 toField = Csv.toField . UUID.toText . coerce
129−#endif
130
93
131#endif
94#endif
132
95
@@ -153,24 +116,11 @@ newtype IntId t = IntId { unIntId :: Integer }
153 deriving newtype
116 deriving newtype
154 ( Eq, Ord, Binary
117 ( Eq, Ord, Binary
155#ifndef ghcjs_HOST_OS
118#ifndef ghcjs_HOST_OS
156−#ifdef USE_POSTGRES
157− , PG.ToField, PG.FromField
158−#endif
159−#ifdef USE_CASSAVA
160− , Csv.ToField, Csv.FromField
119+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
161#endif
120#endif
162−#endif
163−#ifdef USE_FLAT
164− , Flat
165−#endif
166−#ifdef USE_STORE
167− , Data.Store.Store
168−#endif
169−#ifdef BACKEND
170− , ToSchema, ToParamSchema, Arbitrary
171−#endif
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
121+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
122+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
173− , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
123+ , Num, Integral, Real, Enum )
174
124
175type role IntId nominal
125type role IntId nominal
176
126
@@ -181,7 +131,7 @@ mkIntId = coerce
181{-# INLINE mkIntId #-}
131{-# INLINE mkIntId #-}
182
132
183instance KnownSymbol s => Show (IntId s) where
133instance KnownSymbol s => Show (IntId s) where
184− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
134+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
185
135
186instance KnownSymbol s => Read (IntId s) where
136instance KnownSymbol s => Read (IntId s) where
187 readsPrec _ = readP_to_S $ do
137 readsPrec _ = readP_to_S $ do
@@ -204,24 +154,11 @@ newtype Name t = Name { unName :: Text }
204 deriving newtype
154 deriving newtype
205 ( Eq, Ord, Binary
155 ( Eq, Ord, Binary
206#ifndef ghcjs_HOST_OS
156#ifndef ghcjs_HOST_OS
207−#ifdef USE_POSTGRES
208− , PG.ToField, PG.FromField
209−#endif
210−#ifdef USE_CASSAVA
211− , Csv.ToField, Csv.FromField
157+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
212#endif
158#endif
213−#endif
214−#ifdef USE_FLAT
215− , Flat
216−#endif
217−#ifdef USE_STORE
218− , Data.Store.Store
219−#endif
220−#ifdef BACKEND
221− , ToSchema, ToParamSchema
222−#endif
223− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
159+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
160+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
224− , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
161+ , IsString, Semigroup, Monoid )
225
162
226type role Name nominal
163type role Name nominal
227
164
@@ -232,17 +169,15 @@ mkName = coerce
232{-# INLINE mkName #-}
169{-# INLINE mkName #-}
233
170
234instance KnownSymbol s => Show (Name s) where
171instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
172+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
236
173
237instance KnownSymbol s => Read (Name s) where
174instance KnownSymbol s => Read (Name s) where
238 readsPrec _ = readP_to_S $ do
175 readsPrec _ = readP_to_S $ do
239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
176 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240 mkName <$> readS_to_P reads
177 mkName <$> readS_to_P reads
241
178
242−#ifdef BACKEND
243instance Arbitrary (Name s) where
179instance Arbitrary (Name s) where
244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
180 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245−#endif
246
181
247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
182-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248-- You are forced to explicitly specify the phantom types you are converting
183-- You are forced to explicitly specify the phantom types you are converting