This repository has been archived by the owner on Jan 25, 2022. It is now read-only.
/
API.hs
254 lines (188 loc) · 8.71 KB
/
API.hs
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
module MusicBrainz.API
( -- * Parsers
mbid
, name
, nonEmptyText
-- ** Entity reference parsers
, edit
, editorRef
, revision
-- ** Entities
, artist
, label
, releaseGroup
, url
, work
-- ** Tree data
, aliases
-- * Running API Calls
, runApi
-- * Prelabelled fields
, editor
) where
import Control.Applicative
import Control.Lens
import Data.Monoid (mempty)
import Data.Text (Text)
import Network.URI (parseURI)
import Text.Digestive
import Data.Set ()
import qualified Data.Set as Set
import qualified Data.Text as T
import MusicBrainz hiding (mbid, labelCode)
import qualified MusicBrainz as MB
import MusicBrainz.Data
--------------------------------------------------------------------------------
{-| Parse an MBID parameter. -}
mbid :: Monad m => Form Text m (MBID a)
mbid = "mbid" .: validate parse (string Nothing)
where parse s = case s ^? MB.mbid of
Just mbid' -> Success mbid'
Nothing -> Error "Could not parse MBID"
--------------------------------------------------------------------------------
nonEmptyText :: Monad m => Form Text m Text
nonEmptyText =
check "Text must be a non-empty string" (not . T.null) (text Nothing)
--------------------------------------------------------------------------------
artistCreditRef :: Monad m => Form Text m (Ref ArtistCredit)
artistCreditRef = validate (const $ Error "artistCreditRef cannot be implemented until digestive-functors #52 is fixed") $
text Nothing
--------------------------------------------------------------------------------
artistTypeRef :: Form Text MusicBrainz (Maybe (Ref ArtistType))
artistTypeRef = optionalRef "Invalid artist type reference"
--------------------------------------------------------------------------------
workTypeRef :: Form Text MusicBrainz (Maybe (Ref WorkType))
workTypeRef = optionalRef "Invalid work type reference"
--------------------------------------------------------------------------------
countryRef :: Form Text MusicBrainz (Maybe (Ref Country))
countryRef = optionalRef "Invalid country reference"
--------------------------------------------------------------------------------
editorRef :: Form Text MusicBrainz (Ref Editor)
editorRef = ref "Invalid editor reference"
--------------------------------------------------------------------------------
genderRef :: Form Text MusicBrainz (Maybe (Ref Gender))
genderRef = optionalRef "Invalid gender reference"
--------------------------------------------------------------------------------
labelTypeRef :: Form Text MusicBrainz (Maybe (Ref LabelType))
labelTypeRef = optionalRef "Invalid label type reference"
--------------------------------------------------------------------------------
languageRef :: Form Text MusicBrainz (Maybe (Ref Language))
languageRef = optionalRef "Invalid language reference"
--------------------------------------------------------------------------------
releaseGroupTypeRef :: ResolveReference (ReleaseGroupType a)
=> Form Text MusicBrainz (Maybe (Ref (ReleaseGroupType a)))
releaseGroupTypeRef = optionalRef "Invalid release group type reference"
--------------------------------------------------------------------------------
artist :: Form Text MusicBrainz Artist
artist = Artist <$> name
<*> sortName
<*> comment
<*> beginDate
<*> endDate
<*> ended
<*> "gender" .: genderRef
<*> "type" .: artistTypeRef
<*> "country" .: countryRef
--------------------------------------------------------------------------------
label :: Form Text MusicBrainz Label
label = Label <$> name
<*> sortName
<*> comment
<*> beginDate
<*> endDate
<*> ended
<*> "type" .: labelTypeRef
<*> "code" .: labelCode
<*> "country" .: countryRef
where labelCode = check "Label codes must be positive and at most 5 digits"
(maybe True (\i -> i > 0 && i < 100000)) $
optionalStringRead "Invalid integer" Nothing
--------------------------------------------------------------------------------
releaseGroup :: Form Text MusicBrainz ReleaseGroup
releaseGroup = ReleaseGroup <$> name
<*> comment
<*> "artist_credit" .: artistCreditRef
<*> "primary_type" .: releaseGroupTypeRef
<*> pure mempty -- Require's #52 to be fixed
--------------------------------------------------------------------------------
url :: Form Text MusicBrainz Url
url = Url <$> uri
where
uri = validate (maybe (Error "Invalid URI") Success . parseURI) $
string Nothing
--------------------------------------------------------------------------------
work :: Form Text MusicBrainz Work
work = Work <$> name
<*> comment
<*> "type" .: workTypeRef
<*> "language" .: languageRef
--------------------------------------------------------------------------------
runApi :: (Monad m, Functor m) => Form v m (m b) -> Form v m b
runApi = validateM (fmap Success)
--------------------------------------------------------------------------------
optionalRef :: (ResolveReference a, Read (RefSpec a), Show (RefSpec a))
=> Text -> Form Text MusicBrainz (Maybe (Ref a))
optionalRef e = validateM (maybe (return $ Success Nothing) resolveOptionalRefSpec) $
optionalStringRead e Nothing
--------------------------------------------------------------------------------
ref :: (ResolveReference a, Read (RefSpec a), Show (RefSpec a))
=> Text -> Form Text MusicBrainz (Ref a)
ref e = validateM resolveRefSpec $ stringRead e Nothing
--------------------------------------------------------------------------------
resolveOptionalRefSpec :: ResolveReference a => RefSpec a -> MusicBrainz (Result Text (Maybe (Ref a)))
resolveOptionalRefSpec = resolveRefSpec' Just
--------------------------------------------------------------------------------
resolveRefSpec :: ResolveReference a => RefSpec a -> MusicBrainz (Result Text (Ref a))
resolveRefSpec = resolveRefSpec' id
--------------------------------------------------------------------------------
resolveRefSpec' :: ResolveReference a =>
(Ref a -> b) -> RefSpec a -> MusicBrainz (Result Text b)
resolveRefSpec' ret r = do
resolved <- resolveReference r
case resolved of
Nothing -> return $ Error "Reference could not be resolved"
Just ref' -> return $ Success $ ret ref'
--------------------------------------------------------------------------------
name, sortName :: Monad m => Form Text m Text
name = "name" .: nonEmptyText
sortName = "sort-name" .: nonEmptyText
--------------------------------------------------------------------------------
comment :: Monad m => Form Text m Text
comment = "comment" .: text Nothing
--------------------------------------------------------------------------------
partialDate, beginDate, endDate :: Monad m => Form Text m PartialDate
partialDate = pure emptyDate
beginDate = "begin-date" .: partialDate
endDate = "end-date" .: partialDate
--------------------------------------------------------------------------------
ended :: Monad m => Form Text m Bool
ended = "ended" .: bool Nothing
--------------------------------------------------------------------------------
editor :: Form Text MusicBrainz (Ref Editor)
editor = "editor" .: editorRef
--------------------------------------------------------------------------------
edit :: Form Text MusicBrainz (Ref Edit)
edit = "edit" .: editRef
where editRef = ref "Invalid edit reference"
--------------------------------------------------------------------------------
revision :: ResolveReference (Revision a) => Form Text MusicBrainz (Ref (Revision a))
revision = "revision" .: revisionRef
where revisionRef = ref "Invalid revision reference"
--------------------------------------------------------------------------------
aliases :: ResolveReference (AliasType a) => Form Text MusicBrainz (Set.Set (Alias a))
aliases = Set.fromList <$> "aliases" .: listOf (const alias) Nothing
where
alias = Alias <$> "name" .: nonEmptyText
<*> "sort-name" .: nonEmptyText
<*> beginDate
<*> endDate
<*> ended
<*> "type" .: aliasTypeRef
<*> "locale" .: locale
<*> "primary-for-locale" .: bool Nothing
locale = validate (\t -> if T.null t then Success Nothing else Success (Just t)) $
text Nothing
aliasTypeRef = optionalRef "Invalid alias type reference"