Skip to content

Commit be9464f

Browse files
Case insensitive enum parsing
1 parent d8f87ff commit be9464f

File tree

12 files changed

+147
-129
lines changed

12 files changed

+147
-129
lines changed

src/GitHub/Data/Content.hs

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,15 @@
66
--
77
module GitHub.Data.Content where
88

9-
import Data.Aeson.Types (Pair)
10-
import Data.Maybe (maybe)
119
import GitHub.Data.GitData
1210
import GitHub.Data.URL
1311
import GitHub.Internal.Prelude
1412
import Prelude ()
1513

14+
import Data.Aeson.Types (Pair)
15+
import Data.Maybe (maybe)
16+
import qualified Data.Text as T
17+
1618
data Content
1719
= ContentFile !ContentFileData
1820
| ContentDirectory !(Vector ContentItem)
@@ -142,11 +144,10 @@ instance FromJSON ContentItem where
142144
<*> parseJSON (Object o)
143145

144146
instance FromJSON ContentItemType where
145-
parseJSON = withText "ContentItemType" $ \t ->
146-
case t of
147-
"file" -> return ItemFile
148-
"dir" -> return ItemDir
149-
_ -> fail $ "Invalid ContentItemType: " ++ unpack t
147+
parseJSON = withText "ContentItemType" $ \t -> case T.toLower t of
148+
"file" -> pure ItemFile
149+
"dir" -> pure ItemDir
150+
_ -> fail $ "Unknown ContentItemType: " <> T.unpack t
150151

151152
instance FromJSON ContentInfo where
152153
parseJSON = withObject "ContentInfo" $ \o ->

src/GitHub/Data/Definitions.hs

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -134,11 +134,10 @@ fromOwner (Owner owner) = owner
134134
-- JSON instances
135135

136136
instance FromJSON OwnerType where
137-
parseJSON = withText "Owner type" $ \t ->
138-
case t of
139-
"User" -> pure $ OwnerUser
140-
"Organization" -> pure $ OwnerOrganization
141-
_ -> fail $ "Unknown owner type: " ++ T.unpack t
137+
parseJSON = withText "OwnerType" $ \t -> case T.toLower t of
138+
"user" -> pure $ OwnerUser
139+
"organization" -> pure $ OwnerOrganization
140+
_ -> fail $ "Unknown OwnerType: " <> T.unpack t
142141

143142
instance FromJSON SimpleUser where
144143
parseJSON = withObject "SimpleUser" $ \obj -> do

src/GitHub/Data/Deployments.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,8 @@ import GitHub.Data.URL (URL)
2727
import GitHub.Internal.Prelude
2828

2929
import qualified Data.Aeson as JSON
30-
import qualified Data.Text as Text
31-
import qualified Data.Text.Encoding as Text
30+
import qualified Data.Text as T
31+
import qualified Data.Text.Encoding as T
3232

3333
data DeploymentQueryOption
3434
= DeploymentQuerySha !Text
@@ -42,7 +42,7 @@ instance Binary DeploymentQueryOption
4242

4343
renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString)
4444
renderDeploymentQueryOption =
45-
second Text.encodeUtf8 . \case
45+
second T.encodeUtf8 . \case
4646
DeploymentQuerySha sha -> ("sha", sha)
4747
DeploymentQueryRef ref -> ("ref", ref)
4848
DeploymentQueryTask task -> ("task", task)
@@ -172,13 +172,13 @@ instance ToJSON DeploymentStatusState where
172172
DeploymentStatusInactive -> "inactive"
173173

174174
instance FromJSON DeploymentStatusState where
175-
parseJSON = withText "GitHub DeploymentStatusState" $ \case
175+
parseJSON = withText "DeploymentStatusState" $ \t -> case T.toLower t of
176176
"error" -> pure DeploymentStatusError
177177
"failure" -> pure DeploymentStatusFailure
178178
"pending" -> pure DeploymentStatusPending
179179
"success" -> pure DeploymentStatusSuccess
180180
"inactive" -> pure DeploymentStatusInactive
181-
x -> fail $ "Unknown deployment status: " ++ Text.unpack x
181+
_ -> fail $ "Unknown DeploymentStatusState: " <> T.unpack t
182182

183183
data CreateDeploymentStatus = CreateDeploymentStatus
184184
{ createDeploymentStatusState :: !DeploymentStatusState

src/GitHub/Data/Email.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@ module GitHub.Data.Email where
88
import GitHub.Internal.Prelude
99
import Prelude ()
1010

11+
import qualified Data.Text as T
12+
1113
data EmailVisibility
1214
= EmailVisibilityPrivate
1315
| EmailVisibilityPublic
@@ -17,9 +19,10 @@ instance NFData EmailVisibility where rnf = genericRnf
1719
instance Binary EmailVisibility
1820

1921
instance FromJSON EmailVisibility where
20-
parseJSON (String "private") = pure EmailVisibilityPrivate
21-
parseJSON (String "public") = pure EmailVisibilityPublic
22-
parseJSON _ = fail "Could not build an EmailVisibility"
22+
parseJSON = withText "EmailVisibility" $ \t -> case T.toLower t of
23+
"private" -> pure EmailVisibilityPrivate
24+
"public" -> pure EmailVisibilityPublic
25+
_ -> fail $ "Unknown EmailVisibility: " <> T.unpack t
2326

2427
data Email = Email
2528
{ emailAddress :: !Text

src/GitHub/Data/Invitation.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@ import GitHub.Data.Name (Name)
1111
import GitHub.Internal.Prelude
1212
import Prelude ()
1313

14+
import qualified Data.Text as T
15+
1416
data Invitation = Invitation
1517
{ invitationId :: !(Id Invitation)
1618
-- TODO: technically either one should be, maybe both. use `these` ?
@@ -48,10 +50,10 @@ instance NFData InvitationRole where rnf = genericRnf
4850
instance Binary InvitationRole
4951

5052
instance FromJSON InvitationRole where
51-
parseJSON = withText "InvirationRole" $ \t -> case t of
53+
parseJSON = withText "InvitationRole" $ \t -> case T.toLower t of
5254
"direct_member" -> pure InvitationRoleDirectMember
5355
"admin" -> pure InvitationRoleAdmin
5456
"billing_manager" -> pure InvitationRoleBillingManager
5557
"hiring_manager" -> pure InvitationRoleHiringManager
5658
"reinstate" -> pure InvitationRoleReinstate
57-
_ -> fail $ "Invalid role " ++ show t
59+
_ -> fail $ "Unknown InvitationRole: " <> T.unpack t

src/GitHub/Data/Issues.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,8 @@ import GitHub.Data.URL (URL)
1515
import GitHub.Internal.Prelude
1616
import Prelude ()
1717

18+
import qualified Data.Text as T
19+
1820
data Issue = Issue
1921
{ issueClosedAt :: !(Maybe UTCTime)
2022
, issueUpdatedAt :: !UTCTime
@@ -141,7 +143,7 @@ instance FromJSON IssueEvent where
141143
<*> o .:? "label"
142144

143145
instance FromJSON EventType where
144-
parseJSON = withText "EventType" $ \t -> case t of
146+
parseJSON = withText "EventType" $ \t -> case T.toLower t of
145147
"closed" -> pure Closed
146148
"reopened" -> pure Reopened
147149
"subscribed" -> pure Subscribed
@@ -169,7 +171,7 @@ instance FromJSON EventType where
169171
"removed_from_project" -> pure RemovedFromProject
170172
"converted_note_to_issue" -> pure ConvertedNoteToIssue
171173
"unsubscribed" -> pure Unsubscribed -- not in api docs list
172-
_ -> fail $ "Unknown EventType " ++ show t
174+
_ -> fail $ "Unknown EventType: " <> T.unpack t
173175

174176
instance FromJSON IssueComment where
175177
parseJSON = withObject "IssueComment" $ \o -> IssueComment

src/GitHub/Data/Options.hs

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -82,9 +82,10 @@ instance ToJSON IssueState where
8282
toJSON StateClosed = String "closed"
8383

8484
instance FromJSON IssueState where
85-
parseJSON (String "open") = pure StateOpen
86-
parseJSON (String "closed") = pure StateClosed
87-
parseJSON v = typeMismatch "IssueState" v
85+
parseJSON = withText "IssueState" $ \t -> case T.toLower t of
86+
"open" -> pure StateOpen
87+
"closed" -> pure StateClosed
88+
_ -> fail $ "Unknown IssueState: " <> T.unpack t
8889

8990
instance NFData IssueState where rnf = genericRnf
9091
instance Binary IssueState
@@ -109,13 +110,14 @@ instance ToJSON MergeableState where
109110
toJSON StateBehind = String "behind"
110111

111112
instance FromJSON MergeableState where
112-
parseJSON (String "unknown") = pure StateUnknown
113-
parseJSON (String "clean") = pure StateClean
114-
parseJSON (String "dirty") = pure StateDirty
115-
parseJSON (String "unstable") = pure StateUnstable
116-
parseJSON (String "blocked") = pure StateBlocked
117-
parseJSON (String "behind") = pure StateBehind
118-
parseJSON v = typeMismatch "MergeableState" v
113+
parseJSON = withText "MergeableState" $ \t -> case T.toLower t of
114+
"unknown" -> pure StateUnknown
115+
"clean" -> pure StateClean
116+
"dirty" -> pure StateDirty
117+
"unstable" -> pure StateUnstable
118+
"blocked" -> pure StateBlocked
119+
"behind" -> pure StateBehind
120+
_ -> fail $ "Unknown MergeableState: " <> T.unpack t
119121

120122
instance NFData MergeableState where rnf = genericRnf
121123
instance Binary MergeableState

src/GitHub/Data/PullRequests.hs

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -283,19 +283,19 @@ instance FromJSON PullRequestEvent where
283283
<*> o .: "sender"
284284

285285
instance FromJSON PullRequestEventType where
286-
parseJSON (String "opened") = pure PullRequestOpened
287-
parseJSON (String "closed") = pure PullRequestClosed
288-
parseJSON (String "synchronize") = pure PullRequestSynchronized
289-
parseJSON (String "reopened") = pure PullRequestReopened
290-
parseJSON (String "assigned") = pure PullRequestAssigned
291-
parseJSON (String "unassigned") = pure PullRequestUnassigned
292-
parseJSON (String "labeled") = pure PullRequestLabeled
293-
parseJSON (String "unlabeled") = pure PullRequestUnlabeled
294-
parseJSON (String "review_requested") = pure PullRequestReviewRequested
295-
parseJSON (String "review_request_removed") = pure PullRequestReviewRequestRemoved
296-
parseJSON (String "edited") = pure PullRequestEdited
297-
parseJSON (String s) = fail $ "Unknown action type " <> T.unpack s
298-
parseJSON v = typeMismatch "Could not build a PullRequestEventType" v
286+
parseJSON = withText "PullRequestEventType" $ \t -> case T.toLower t of
287+
"opened" -> pure PullRequestOpened
288+
"closed" -> pure PullRequestClosed
289+
"synchronize" -> pure PullRequestSynchronized
290+
"reopened" -> pure PullRequestReopened
291+
"assigned" -> pure PullRequestAssigned
292+
"unassigned" -> pure PullRequestUnassigned
293+
"labeled" -> pure PullRequestLabeled
294+
"unlabeled" -> pure PullRequestUnlabeled
295+
"review_requested" -> pure PullRequestReviewRequested
296+
"review_request_removed" -> pure PullRequestReviewRequestRemoved
297+
"edited" -> pure PullRequestEdited
298+
_ -> fail $ "Unknown PullRequestEventType: " <> T.unpack t
299299

300300
instance FromJSON PullRequestReference where
301301
parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference

src/GitHub/Data/Reviews.hs

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,14 @@
11
module GitHub.Data.Reviews where
22

3-
import Data.Text (Text)
43
import GitHub.Data.Definitions (SimpleUser)
54
import GitHub.Data.Id (Id)
65
import GitHub.Data.URL (URL)
76
import GitHub.Internal.Prelude
87
import Prelude ()
98

9+
import Data.Text (Text)
10+
import qualified Data.Text as T
11+
1012
data ReviewState
1113
= ReviewStatePending
1214
| ReviewStateApproved
@@ -21,12 +23,13 @@ instance NFData ReviewState where
2123
instance Binary ReviewState
2224

2325
instance FromJSON ReviewState where
24-
parseJSON (String "APPROVED") = pure ReviewStateApproved
25-
parseJSON (String "PENDING") = pure ReviewStatePending
26-
parseJSON (String "DISMISSED") = pure ReviewStateDismissed
27-
parseJSON (String "COMMENTED") = pure ReviewStateCommented
28-
parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested
29-
parseJSON _ = fail "Unexpected ReviewState"
26+
parseJSON = withText "ReviewState" $ \t -> case T.toLower t of
27+
"approved" -> pure ReviewStateApproved
28+
"pending" -> pure ReviewStatePending
29+
"dismissed" -> pure ReviewStateDismissed
30+
"commented" -> pure ReviewStateCommented
31+
"changes_requested" -> pure ReviewStateChangesRequested
32+
_ -> fail $ "Unknown ReviewState: " <> T.unpack t
3033

3134
data Review = Review
3235
{ reviewBody :: !Text

src/GitHub/Data/Statuses.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import Prelude ()
1414
import GitHub.Data.GitData (Commit)
1515
import GitHub.Data.Repos (RepoRef)
1616

17+
import qualified Data.Text as T
1718

1819
data StatusState
1920
= StatusPending
@@ -26,11 +27,12 @@ instance NFData StatusState where rnf = genericRnf
2627
instance Binary StatusState
2728

2829
instance FromJSON StatusState where
29-
parseJSON (String "pending") = pure StatusPending
30-
parseJSON (String "success") = pure StatusSuccess
31-
parseJSON (String "error") = pure StatusError
32-
parseJSON (String "failure") = pure StatusFailure
33-
parseJSON _ = fail "Could not build a StatusState"
30+
parseJSON = withText "StatusState" $ \t -> case T.toLower t of
31+
"pending" -> pure StatusPending
32+
"success" -> pure StatusSuccess
33+
"error" -> pure StatusError
34+
"failure" -> pure StatusFailure
35+
_ -> fail $ "Unknown StatusState: " <> T.unpack t
3436

3537
instance ToJSON StatusState where
3638
toJSON StatusPending = String "pending"

0 commit comments

Comments
 (0)