diff --git a/json-spec-elm-servant.cabal b/json-spec-elm-servant.cabal --- a/json-spec-elm-servant.cabal +++ b/json-spec-elm-servant.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-elm-servant -version: 0.3.2.1 +version: 0.4.0.0 synopsis: Generated elm code for servant APIs. description: Generate Elm encoders, decoders, and API requests for an Servant API, where the shape of the data @@ -24,23 +24,20 @@ common dependencies build-depends: , base >= 4.19.0.0 && < 4.20 - , bound >= 2.0.7 && < 2.1 , containers >= 0.6.8 && < 0.7 , elm-syntax >= 0.3.3.0 && < 0.4 - , http-types >= 0.12.3 && < 0.13 - , json-spec >= 0.2.1.3 && < 0.3 - , json-spec-elm >= 0.3.0.4 && < 0.4 - , mtl >= 2.3.1 && < 2.4 + , json-spec >= 0.3.0.0 && < 0.4 , servant >= 0.20.1 && < 0.21 , text >= 2.1 && < 2.2 common warnings ghc-options: + -Wall -Wmissing-deriving-strategies -Wmissing-export-lists -Wmissing-import-lists -Wredundant-constraints - -Wall + -Wunused-packages library import: dependencies, warnings @@ -50,6 +47,12 @@ -- other-extensions: hs-source-dirs: src default-language: Haskell2010 + build-depends: + , bound >= 2.0.7 && < 2.1 + , http-types >= 0.12.3 && < 0.13 + , json-spec-elm >= 0.4.0.0 && < 0.5 + , mtl >= 2.3.1 && < 2.4 + test-suite test import: dependencies, warnings diff --git a/test/Api.hs b/test/Api.hs --- a/test/Api.hs +++ b/test/Api.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} {- swiped from an incomplete personal project to use for testing. -} module Api ( @@ -49,10 +50,11 @@ import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) import Data.Binary (Binary) import Data.ByteString (ByteString) -import Data.JsonSpec (Field(Field), HasJsonDecodingSpec(DecodingSpec, - fromJSONStructure), HasJsonEncodingSpec(EncodingSpec, toJSONStructure), - SpecJSON(SpecJSON), Specification(JsonArray, JsonDateTime, JsonEither, - JsonInt, JsonLet, JsonObject, JsonRef, JsonString, JsonTag), Tag(Tag)) +import Data.JsonSpec (Field(Field, unField), + HasJsonDecodingSpec(DecodingSpec, fromJSONStructure), + HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON), + Specification(JsonArray, JsonDateTime, JsonEither, JsonInt, JsonLet, + JsonObject, JsonRef, JsonString, JsonTag), Tag(Tag)) import Data.Map (Map) import Data.Set (Set) import Data.Text (Text) @@ -61,13 +63,14 @@ import Data.UUID (UUID) import GHC.Generics (Generic) import Prelude (Applicative(pure), Either(Left, Right), Functor(fmap), - Traversable(traverse), (.), (<$>), Eq, Int, Ord) + Traversable(traverse), (.), (<$>), Eq, Int, Maybe, Ord) import Servant.API (FromHttpApiData(parseHeader, parseQueryParam), GenericMode((:-)), StdMethod(GET), (:>), Capture, DeleteNoContent, Get, Header, Header', Headers, JSON, NamedRoutes, NoContent, Optional, Post, PostNoContent, QueryParam', ReqBody, ReqBody', Required, Strict, ToHttpApiData, Verb) import Web.Cookie (SetCookie) +import qualified Data.JsonSpec as Spec import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.UUID as UUID @@ -156,9 +159,9 @@ instance HasJsonDecodingSpec SetMetadataReq where type DecodingSpec SetMetadataReq = JsonObject - '[ '("name", DecodingSpec Name) - , '("description", JsonString) - , '("venue", JsonString) + '[ "name" ::: (DecodingSpec Name) + , "description" ::: JsonString + , "venue" ::: JsonString ] fromJSONStructure (Field @"name" name_, @@ -186,16 +189,16 @@ JsonLet '[ '("DashboardData" , JsonObject - '[ '("proposals", + '[ "proposals" ::: JsonArray - ( JsonObject - '[ '("key", EncodingSpec ProposalId) - , '("value", EncodingSpec Proposal) + ( + JsonObject + '[ "key" ::: EncodingSpec ProposalId + , "value" ::: EncodingSpec Proposal ] ) - ) - , '("credits", EncodingSpec AvailableCredits) - , '("user", EncodingSpec DiscordUser) + , "credits" ::: EncodingSpec AvailableCredits + , "user" ::: EncodingSpec DiscordUser ] ) ] @@ -226,13 +229,13 @@ instance HasJsonEncodingSpec Proposal where type EncodingSpec Proposal = JsonObject - '[ '("name", EncodingSpec Name) - , '("owner", EncodingSpec DiscordUser) - , '("availability", JsonArray (EncodingSpec AvailabilityInterval)) - , '("description", JsonString) - , '("venue", JsonString) - , '("invites", JsonArray (EncodingSpec Invite)) - , '("created-at", JsonDateTime) + '[ "name" ::: EncodingSpec Name + , "owner" ::: EncodingSpec DiscordUser + , "availability" ::: JsonArray (EncodingSpec AvailabilityInterval) + , "description" ::: JsonString + , "venue" ::: JsonString + , "invites" ::: JsonArray (EncodingSpec Invite) + , "created-at" ::: JsonDateTime ] toJSONStructure Proposal @@ -290,13 +293,13 @@ '[ '( "Invite" , JsonEither ( JsonObject - '[ '("type", JsonTag "discord-user") - , '("username", EncodingSpec DiscordUser) + '[ "type" ::: JsonTag "discord-user" + , "username" ::: EncodingSpec DiscordUser ] ) ( JsonObject - '[ '("type", JsonTag "discord-server") - , '("guild", EncodingSpec Guild) + '[ "type" ::: JsonTag "discord-server" + , "guild" ::: EncodingSpec Guild ] ) ) @@ -340,8 +343,8 @@ instance HasJsonEncodingSpec Guild where type EncodingSpec Guild = JsonObject - '[ '("id", EncodingSpec GuildId) - , '("name", JsonString) + '[ "id" ::: EncodingSpec GuildId + , "name" ::: JsonString ] toJSONStructure Guild { guildId , name } = (Field @"id" (toJSONStructure guildId), @@ -391,10 +394,10 @@ } instance HasJsonEncodingSpec AvailabilityInterval where type EncodingSpec AvailabilityInterval = - JsonObject '[ - '("interval", EncodingSpec Interval), - '("users", JsonArray (EncodingSpec DiscordUser)) - ] + JsonObject + '[ "interval" ::: EncodingSpec Interval + , "users" ::: JsonArray (EncodingSpec DiscordUser) + ] toJSONStructure AvailabilityInterval { interval , users } = (Field @"interval" (toJSONStructure interval), (Field @"users" (toJSONStructure <$> Set.toList users), @@ -447,7 +450,7 @@ instance HasJsonEncodingSpec FEConfig where type EncodingSpec FEConfig = JsonObject - '[ '( "redirectUrl", JsonString) ] + '[ "redirectUrl" ::: JsonString ] toJSONStructure FEConfig { discordRedirect } = (Field @"redirectUrl" discordRedirect, ()) @@ -498,22 +501,22 @@ { name :: Name , availability :: Availability , description :: Text - , venue :: Text + , venue :: Maybe Text } deriving (FromJSON) via (SpecJSON NewProposalReq) instance HasJsonDecodingSpec NewProposalReq where type DecodingSpec NewProposalReq = JsonObject - '[ '("name", DecodingSpec Name) - , '("availability", DecodingSpec Availability) - , '("description", JsonString) - , '("venue", JsonString) + '[ "name" ::: DecodingSpec Name + , "availability" ::: DecodingSpec Availability + , "description" ::: JsonString + , "venue" ::? JsonString ] fromJSONStructure (Field @"name" rawName, (Field @"availability" rawAvailability, (Field @"description" description, - (Field @"venue" venue, + (fmap (unField @"venue") -> venue, ())))) = do name <- fromJSONStructure rawName @@ -558,10 +561,10 @@ deriving (ToJSON, FromJSON) via (SpecJSON Interval) instance HasJsonEncodingSpec Interval where type EncodingSpec Interval = - JsonObject '[ - '("startInclusive", JsonDateTime), - '("endExclusive", JsonDateTime) - ] + JsonObject + '[ "startInclusive" ::: JsonDateTime + , "endExclusive" ::: JsonDateTime + ] toJSONStructure Interval { startInclusive @@ -611,13 +614,17 @@ where type EncodingSpec (KV k v) = JsonObject - '[ '("key", EncodingSpec k) - , '("value", EncodingSpec v) + '[ "key" ::: EncodingSpec k + , "value" ::: EncodingSpec v ] toJSONStructure KV { key , value } = (Field @"key" (toJSONStructure key), (Field @"value" (toJSONStructure value), ())) + + +type (:::) = Spec.Required +type (::?) = Spec.Optional