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.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 diff --git a/src/Data/JsonSpec/Elm/Servant.hs b/src/Data/JsonSpec/Elm/Servant.hs --- a/src/Data/JsonSpec/Elm/Servant.hs +++ b/src/Data/JsonSpec/Elm/Servant.hs @@ -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 diff --git a/test/Api.hs b/test/Api.hs --- a/test/Api.hs +++ b/test/Api.hs @@ -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