json-spec-elm-servant 0.4.1.1 → 0.4.1.2
raw patch · 3 files changed
+61/−192 lines, 3 filesdep ~json-specPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: json-spec
API changes (from Hackage documentation)
Files
- json-spec-elm-servant.cabal +2/−2
- src/Data/JsonSpec/Elm/Servant.hs +19/−16
- test/Api.hs +40/−174
json-spec-elm-servant.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-elm-servant-version: 0.4.1.1+version: 0.4.1.2 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@@ -30,7 +30,7 @@ , elm-syntax >= 0.3.3.0 && < 0.4 , filepath >= 1.4.300.2 && < 1.6 , http-types >= 0.12.3 && < 0.13- , json-spec >= 0.3.0.0 && < 0.6+ , json-spec >= 0.3.0.0 && < 1.1 , json-spec-elm >= 0.4.0.0 && < 0.5 , mtl >= 2.3.1 && < 2.4 , prettyprinter >= 1.7.1 && < 1.8
src/Data/JsonSpec/Elm/Servant.hs view
@@ -37,14 +37,13 @@ import Bound (Var(B, F), Scope, abstract1, closed, toScope)-import Control.Monad.Writer (MonadTrans(lift), MonadWriter(tell),- execWriter)+import Control.Monad.Writer (MonadTrans(lift), MonadWriter(tell), execWriter) import Data.Foldable (Foldable(fold), traverse_) import Data.HashMap.Strict (HashMap)-import Data.JsonSpec (HasJsonDecodingSpec(DecodingSpec),- HasJsonEncodingSpec(EncodingSpec))-import Data.JsonSpec.Elm (HasType(decoderOf, encoderOf, typeOf),- Definitions)+import Data.JsonSpec+ ( HasJsonDecodingSpec(DecodingSpec), HasJsonEncodingSpec(EncodingSpec)+ )+import Data.JsonSpec.Elm (HasType(decoderOf, encoderOf, typeOf), Definitions) import Data.List (drop, foldl', init, unlines) import Data.Maybe (fromJust, fromMaybe, mapMaybe) import Data.Proxy (Proxy(Proxy))@@ -59,18 +58,22 @@ import Language.Elm.Pretty (modules) import Language.Elm.Type (Type) import Network.HTTP.Types (Method)-import Prelude (Applicative(pure), Bool(False, True), Eq((==)),- Foldable(foldr, length), Functor(fmap), Maybe(Just, Nothing),- Monad((>>=)), Monoid(mconcat), Semigroup((<>)), Show(show),- Traversable(sequence, traverse), ($), (.), (<$>), IO, Int, String,- error, putStrLn, reverse)+import Prelude+ ( Applicative(pure), Bool(False, True), Eq((==)), Foldable(foldr, length)+ , Functor(fmap), Maybe(Just, Nothing), Monad((>>=)), Monoid(mconcat)+ , Semigroup((<>)), Show(show), Traversable(sequence, traverse), ($), (.)+ , (<$>), IO, Int, String, error, putStrLn, reverse+ ) import Prettyprinter (defaultLayoutOptions, layoutPretty) import Prettyprinter.Render.Text (renderStrict)-import Servant.API (ReflectMethod(reflectMethod), (:<|>), (:>), Capture,- Header', Headers, JSON, NamedRoutes, NoContent, NoContentVerb, Optional,- QueryParam', ReqBody', Required, ToServantApi, Verb)-import System.Directory.OsPath (createDirectoryIfMissing,- doesDirectoryExist, listDirectory)+import Servant.API+ ( ReflectMethod(reflectMethod), (:<|>), (:>), Capture, Header', Headers, JSON+ , NamedRoutes, NoContent, NoContentVerb, Optional, QueryParam', ReqBody'+ , Required, ToServantApi, Verb+ )+import System.Directory.OsPath+ ( createDirectoryIfMissing, doesDirectoryExist, listDirectory+ ) import System.OsPath ((</>), OsPath, OsString, osp, splitExtension) import System.Process (readProcess) import qualified Data.HashMap.Strict as HM
test/Api.hs view
@@ -50,11 +50,14 @@ 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),- unField)+import Data.JsonSpec+ ( Field(Field), HasJsonDecodingSpec(DecodingSpec, fromJSONStructure)+ , HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON)+ , Specification+ ( JsonArray, JsonDateTime, JsonEither, JsonInt, JsonLet, JsonObject, JsonRef+ , JsonString, JsonTag+ )+ ) import Data.Map (Map) import Data.Set (Set) import Data.Text (Text)@@ -62,18 +65,17 @@ import Data.Time (UTCTime) import Data.UUID (UUID) import GHC.Generics (Generic)-import Prelude (Applicative(pure), Either(Left, Right), Functor(fmap),- 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 Prelude+ ( Applicative(pure), Either(Right), (.), Eq, Int, Maybe, Ord, undefined+ )+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 data Api mode = Api@@ -203,16 +205,7 @@ ) ] (JsonRef "DashboardData")- toJSONStructure DashboardData {proposals, credits, user} =- (Field @"proposals"- [ (Field @"key" (toJSONStructure k),- (Field @"value" (toJSONStructure v),- ()))- | (k, v) <- Map.toAscList proposals- ],- (Field @"credits" (toJSONStructure credits),- (Field @"user" (toJSONStructure user),- ())))+ toJSONStructure = undefined data Proposal = Proposal@@ -237,49 +230,10 @@ , "invites" ::: JsonArray (EncodingSpec Invite) , "created-at" ::: JsonDateTime ]- toJSONStructure- Proposal- { name- , owner- , availability- , description- , invites- , venue- , createdAt- }- =- (Field @"name" (toJSONStructure name),- (Field @"owner" (toJSONStructure owner),- (Field @"availability" (toJSONStructure <$> availability),- (Field @"description" description,- (Field @"venue" venue,- (Field @"invites" (toJSONStructure <$> Set.toList invites),- (Field @"created-at" createdAt,- ())))))))+ toJSONStructure = undefined instance HasJsonDecodingSpec Proposal where type DecodingSpec Proposal = EncodingSpec Proposal- fromJSONStructure- (Field @"name" name,- (Field @"owner" user,- (Field @"availability" rawAvailability,- (Field @"description" description,- (Field @"venue" venue,- (Field @"invites" rawInvites,- (Field @"created-at" createdAt,- ())))))))- = do- availability <- traverse fromJSONStructure rawAvailability- invites <- traverse fromJSONStructure rawInvites- pure- Proposal- { name = Name name- , owner = DiscordUser user- , description- , availability- , invites = Set.fromList invites- , venue- , createdAt- }+ fromJSONStructure = undefined data Invite@@ -305,33 +259,10 @@ ) ] (JsonRef "Invite")- toJSONStructure = \case- InviteUser user ->- Left- (Field @"type" (Tag @"discord-user"),- (Field @"username" (toJSONStructure user),- ()))- InviteGuild guild ->- Right- (Field @"type" (Tag @"discord-server"),- (Field @"guild" (toJSONStructure guild),- ()))+ toJSONStructure = undefined instance HasJsonDecodingSpec Invite where type DecodingSpec Invite = EncodingSpec Invite- fromJSONStructure = \case- Left- (Field @"type" (Tag @"discord-user"),- (Field @"username" user,- ()))- ->- InviteUser <$> fromJSONStructure user-- Right- (Field @"type" (Tag @"discord-server"),- (Field @"guild" guild,- ()))- ->- InviteGuild <$> fromJSONStructure guild+ fromJSONStructure = undefined data Guild = Guild@@ -346,19 +277,10 @@ '[ "id" ::: EncodingSpec GuildId , "name" ::: JsonString ]- toJSONStructure Guild { guildId , name } =- (Field @"id" (toJSONStructure guildId),- (Field @"name" name,- ()))+ toJSONStructure = undefined instance HasJsonDecodingSpec Guild where type DecodingSpec Guild = EncodingSpec Guild- fromJSONStructure- (Field @"id" id_,- (Field @"name" name,- ()))- = do- guildId <- fromJSONStructure id_- pure Guild { guildId , name }+ fromJSONStructure = undefined newtype GuildId = GuildId@@ -381,27 +303,14 @@ deriving ToJSON via (SpecJSON AvailabilityInterval) instance HasJsonDecodingSpec AvailabilityInterval where type DecodingSpec AvailabilityInterval = EncodingSpec AvailabilityInterval- fromJSONStructure- (Field @"interval" rawInterval,- (Field @"users" rawUsers,- ()))- = do- interval <- fromJSONStructure rawInterval- pure- AvailabilityInterval- { interval- , users = Set.fromList (DiscordUser <$> rawUsers)- }+ fromJSONStructure = undefined instance HasJsonEncodingSpec AvailabilityInterval where type EncodingSpec AvailabilityInterval = JsonObject '[ "interval" ::: EncodingSpec Interval , "users" ::: JsonArray (EncodingSpec DiscordUser) ]- toJSONStructure AvailabilityInterval { interval , users } =- (Field @"interval" (toJSONStructure interval),- (Field @"users" (toJSONStructure <$> Set.toList users),- ()))+ toJSONStructure = undefined newtype AvailableCredits = AvailableCredits@@ -410,7 +319,7 @@ deriving ToJSON via (SpecJSON AvailableCredits) instance HasJsonEncodingSpec AvailableCredits where type EncodingSpec AvailableCredits = JsonInt- toJSONStructure = unAvailableCredits+ toJSONStructure = undefined data UnprotectedApi mode = UnprotectedApi@@ -451,9 +360,7 @@ type EncodingSpec FEConfig = JsonObject '[ "redirectUrl" ::: JsonString ]- toJSONStructure FEConfig { discordRedirect } =- (Field @"redirectUrl" discordRedirect,- ())+ toJSONStructure = undefined newtype Email = Email { unEmail :: Text@@ -468,7 +375,7 @@ deriving (FromJSON) via (SpecJSON DiscordAccessToken) instance HasJsonDecodingSpec DiscordAccessToken where type DecodingSpec DiscordAccessToken = JsonString- fromJSONStructure = pure . DiscordAccessToken+ fromJSONStructure = undefined newtype Token = Token@@ -494,7 +401,7 @@ deriving ToJSON via (SpecJSON ProposalId) instance HasJsonEncodingSpec ProposalId where type EncodingSpec ProposalId = JsonString- toJSONStructure = UUID.toText . unProposalId+ toJSONStructure = undefined data NewProposalReq = NewProposalReq@@ -512,22 +419,7 @@ , "description" ::: JsonString , "venue" ::? JsonString ]- fromJSONStructure- (Field @"name" rawName,- (Field @"availability" rawAvailability,- (Field @"description" description,- (fmap (unField @"venue") -> venue,- ()))))- = do- name <- fromJSONStructure rawName- availability <- fromJSONStructure rawAvailability- pure- NewProposalReq- { name- , availability- , description- , venue- }+ fromJSONStructure = undefined newtype Availability = Availability@@ -536,9 +428,7 @@ deriving FromJSON via (SpecJSON Availability) instance HasJsonDecodingSpec Availability where type DecodingSpec Availability = JsonArray (DecodingSpec Interval)- fromJSONStructure =- fmap (Availability . Set.fromList)- . traverse fromJSONStructure+ fromJSONStructure = undefined newtype Name = Name@@ -547,10 +437,10 @@ deriving (ToJSON, FromJSON) via (SpecJSON Name) instance HasJsonEncodingSpec Name where type EncodingSpec Name = JsonString- toJSONStructure = unName+ toJSONStructure = undefined instance HasJsonDecodingSpec Name where type DecodingSpec Name = EncodingSpec Name- fromJSONStructure = pure . Name+ fromJSONStructure = undefined data Interval = Interval@@ -565,27 +455,10 @@ '[ "startInclusive" ::: JsonDateTime , "endExclusive" ::: JsonDateTime ]- toJSONStructure- Interval- { startInclusive- , endExclusive- }- =- (Field @"startInclusive" startInclusive,- (Field @"endExclusive" endExclusive,- ()))+ toJSONStructure = undefined instance HasJsonDecodingSpec Interval where type DecodingSpec Interval = EncodingSpec Interval- fromJSONStructure- (Field @"startInclusive" startInclusive,- (Field @"endExclusive" endExclusive,- ()))- = do- pure- Interval- { startInclusive- , endExclusive- }+ fromJSONStructure = undefined newtype DiscordUser = DiscordUser@@ -595,10 +468,10 @@ deriving ToJSON via (SpecJSON DiscordUser) instance HasJsonEncodingSpec DiscordUser where type EncodingSpec DiscordUser = JsonString- toJSONStructure = unDiscordUser+ toJSONStructure = undefined instance HasJsonDecodingSpec DiscordUser where type DecodingSpec DiscordUser = EncodingSpec DiscordUser- fromJSONStructure = pure . DiscordUser+ fromJSONStructure = undefined data KV k v = KV@@ -607,21 +480,14 @@ } deriving via (SpecJSON (KV ProposalId Proposal)) instance ToJSON (KV ProposalId Proposal)-instance- (HasJsonEncodingSpec k, HasJsonEncodingSpec v)- =>- HasJsonEncodingSpec (KV k v)- where+instance HasJsonEncodingSpec (KV k v) where type EncodingSpec (KV k v) = JsonObject '[ "key" ::: EncodingSpec k , "value" ::: EncodingSpec v ] - toJSONStructure KV { key , value } =- (Field @"key" (toJSONStructure key),- (Field @"value" (toJSONStructure value),- ()))+ toJSONStructure = undefined type (:::) = Spec.Required