json-spec-elm 0.2.0.0 → 0.3.0.0
raw patch · 3 files changed
+139/−65 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.JsonSpec.Elm: instance (Data.JsonSpec.Elm.HasType spec, GHC.TypeLits.KnownSymbol consName, GHC.TypeLits.KnownSymbol name) => Data.JsonSpec.Elm.HasDef '(name, Data.JsonSpec.Elm.Named consName spec)
Files
- json-spec-elm.cabal +1/−1
- src/Data/JsonSpec/Elm.hs +101/−39
- test/test.hs +37/−25
json-spec-elm.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-elm-version: 0.2.0.0+version: 0.3.0.0 synopsis: Elm code generate for `json-spec`. description: Produce elm types, encoders, and decoders from a
src/Data/JsonSpec/Elm.hs view
@@ -21,7 +21,8 @@ import Bound (Scope(Scope), Var(B), abstract1, closed, toScope)-import Control.Monad.Writer (MonadWriter(tell), Writer, execWriter)+import Control.Monad.Writer (MonadTrans(lift), MonadWriter(tell),+ Writer, execWriter) import Data.JsonSpec (Specification(JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRef, JsonString, JsonTag))@@ -85,7 +86,10 @@ recordDecoders = do dec <- decoderOf @spec more <- recordDecoders @more- pure $ ( sym @name , dec) : more+ pure $+ ( sym @name+ , "Json.Decode.field" `a` Expr.String (sym @name) `a` dec+ ) : more class HasType (spec :: Specification) where@@ -255,7 +259,6 @@ :$$: Lits.Text "> | MySum_3 Float" :$$: Lits.Text "> | MySum_4 Bool" :$$: Lits.Text ""- ) ) =>@@ -285,7 +288,7 @@ class HasDef (def :: (Symbol, Specification)) where defs :: Definitions ()-instance {-# OVERLAPS #-} {- HasDef '(name, JsonEither left right) -}+instance {- HasDef '(name, JsonEither left right) -} ( KnownSymbol name , SumDef (JsonEither left right) )@@ -333,10 +336,12 @@ Expr.Lam . toScope $ Expr.Case (Expr.Var (B ()))- [ ( Pat.Con (localName (constructorName conName n)) [Pat.Var 0]+ [ ( Pat.Con+ (localName (constructorName conName n))+ [Pat.Var 0] , toScope $- fmap absurd encoder `a`- Expr.Var (B (0 :: Int))+ fmap absurd encoder `a`+ Expr.Var (B (0 :: Int)) ) | (n, (conName, encoder)) <- zip [1..] encoders ]@@ -350,44 +355,100 @@ name :: Text name = sym @name-instance (HasType spec, KnownSymbol name) => HasDef '(name, spec) where- defs = do- type_ <- typeOf @spec- dec <- decoderOf @spec- enc <- encoderOf @spec- tell . Set.fromList $- [ Def.Alias- (localName (sym @name))- 0- (Scope type_)- , Def.Constant- (decoderName @name)- 0- ( Scope- (- "Json.Decode.Decoder" `ta`- Type.Global (localName (sym @name))- )- )- dec- , Def.Constant- (encoderName @name)- 0- ( Scope- ( Type.Fun- (Type.Global $ localName (sym @name))- "Json.Encode.Value"+instance {- HasDef '(name, Named consName spec) -}+ ( HasType spec+ , KnownSymbol consName+ , KnownSymbol name+ )+ =>+ HasDef '(name, Named consName spec)+ where+ defs = do+ typ <- typeOf @spec+ dec <- decoderOf @spec+ enc <- encoderOf @spec+ tell . Set.fromList $+ [ Def.Type (localName (sym @name)) 0+ [ ( Name.Constructor (sym @consName)+ , [ lift typ ] )- )- enc- ]+ ]+ , Def.Constant+ (decoderName @name)+ 0+ ( Scope+ (+ "Json.Decode.Decoder" `ta`+ Type.Global (localName (sym @name))+ )+ )+ ( "Json.Decode.map"+ `a` Expr.Global (localName (sym @consName))+ `a` dec+ )+ , Def.Constant+ (encoderName @name)+ 0+ ( Scope+ ( Type.Fun+ (Type.Global $ localName (sym @name))+ "Json.Encode.Value"+ )+ )+ ( lam $ \var ->+ Expr.Case+ var+ [ (Pat.Con+ (localName (sym @consName))+ [ Pat.Var 0 ]+ , toScope $+ (absurd <$> enc) `a` Expr.Var (B 0)+ )+ ]+ )+ ]+instance {- HasDef '(name, spec) -}+ {-# overlaps #-} (HasType spec, KnownSymbol name)+ =>+ HasDef '(name, spec)+ where+ defs = do+ type_ <- typeOf @spec+ dec <- decoderOf @spec+ enc <- encoderOf @spec+ tell . Set.fromList $+ [ Def.Alias+ (localName (sym @name))+ 0+ (Scope type_)+ , Def.Constant+ (decoderName @name)+ 0+ ( Scope+ (+ "Json.Decode.Decoder" `ta`+ Type.Global (localName (sym @name))+ )+ )+ dec+ , Def.Constant+ (encoderName @name)+ 0+ ( Scope+ ( Type.Fun+ (Type.Global $ localName (sym @name))+ "Json.Encode.Value"+ )+ )+ enc+ ] class SumDef (spec :: Specification) where sumDef :: forall v. Definitions [(Maybe Text, Type v)] sumDecoders :: Definitions [(Maybe Text, Expression Void)] sumEncoders :: Definitions [(Maybe Text, Expression Void)]-instance+instance {- SumDef (JsonEither left right) -} (SumDef left, SumDef right) => SumDef (JsonEither left right)@@ -404,7 +465,7 @@ left <- sumEncoders @left right <- sumEncoders @right pure (left ++ right)-instance+instance {- SumDef (JsonLet '[ '(name, def) ] (JsonRef name)) -} ( HasType def , KnownSymbol name )@@ -457,6 +518,7 @@ decoderName :: forall name. (KnownSymbol name) => Qualified decoderName = localName (lower (sym @name) <> "Decoder")+ encoderName :: forall name. (KnownSymbol name) => Qualified encoderName = localName (lower (sym @name) <> "Encoder")
test/test.hs view
@@ -63,10 +63,10 @@ , "dashboardDecoder : Json.Decode.Decoder Dashboard" , "dashboardDecoder =" , " Json.Decode.succeed (\\a b c -> { proposals = a, credits = b, user = c }) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.list (Json.Decode.succeed (\\b c -> { key = b"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"proposals\" (Json.Decode.list (Json.Decode.succeed (\\b c -> { key = b" , " , value = c }) |>"- , " Json.Decode.andThen (\\b -> Json.Decode.map b Json.Decode.string) |>"- , " Json.Decode.andThen (\\b -> Json.Decode.map b (Json.Decode.succeed (\\c d e f g h i j -> { name = c"+ , " Json.Decode.andThen (\\b -> Json.Decode.map b (Json.Decode.field \"key\" Json.Decode.string)) |>"+ , " Json.Decode.andThen (\\b -> Json.Decode.map b (Json.Decode.field \"value\" (Json.Decode.succeed (\\c d e f g h i j -> { name = c" , " , owner = d" , " , availability = e" , " , description = f"@@ -74,22 +74,22 @@ , " , invites = h" , " , created_at = i" , " , attachments = j }) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c Json.Decode.string) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c Json.Decode.string) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.list (Json.Decode.succeed (\\d e -> { interval = d"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"name\" Json.Decode.string)) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"owner\" Json.Decode.string)) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"availability\" (Json.Decode.list (Json.Decode.succeed (\\d e -> { interval = d" , " , users = e }) |>"- , " Json.Decode.andThen (\\d -> Json.Decode.map d (Json.Decode.succeed (\\e f -> { startInclusive = e"+ , " Json.Decode.andThen (\\d -> Json.Decode.map d (Json.Decode.field \"interval\" (Json.Decode.succeed (\\e f -> { startInclusive = e" , " , endExclusive = f }) |>"- , " Json.Decode.andThen (\\e -> Json.Decode.map e Iso8601.decoder) |>"- , " Json.Decode.andThen (\\e -> Json.Decode.map e Iso8601.decoder))) |>"- , " Json.Decode.andThen (\\d -> Json.Decode.map d (Json.Decode.list Json.Decode.string))))) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c Json.Decode.string) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c Json.Decode.string) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.list inviteDecoder)) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c Iso8601.decoder) |>"- , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.list Json.Decode.string))))))) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a Json.Decode.int) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a Json.Decode.string)"+ , " Json.Decode.andThen (\\e -> Json.Decode.map e (Json.Decode.field \"startInclusive\" Iso8601.decoder)) |>"+ , " Json.Decode.andThen (\\e -> Json.Decode.map e (Json.Decode.field \"endExclusive\" Iso8601.decoder))))) |>"+ , " Json.Decode.andThen (\\d -> Json.Decode.map d (Json.Decode.field \"users\" (Json.Decode.list Json.Decode.string))))))) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"description\" Json.Decode.string)) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"venue\" Json.Decode.string)) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"invites\" (Json.Decode.list inviteDecoder))) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"created-at\" Iso8601.decoder)) |>"+ , " Json.Decode.andThen (\\c -> Json.Decode.map c (Json.Decode.field \"attachments\" (Json.Decode.list Json.Decode.string)))))))))) |>"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"credits\" Json.Decode.int)) |>"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"user\" Json.Decode.string))" , "" , "" , "dashboardEncoder : Dashboard -> Json.Encode.Value"@@ -113,25 +113,25 @@ , "inviteDecoder =" , " Json.Decode.oneOf [ Json.Decode.map InviteUser (Json.Decode.succeed (\\a b -> { type_ = a" , " , username = b }) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.string |>"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"type\" (Json.Decode.string |>" , " Json.Decode.andThen (\\b -> if b == \"discord-user\" then" , " Json.Decode.succeed ()" , "" , " else"- , " Json.Decode.fail \"Tag mismatch\"))) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a Json.Decode.string))"+ , " Json.Decode.fail \"Tag mismatch\")))) |>"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"username\" Json.Decode.string)))" , " , Json.Decode.map InviteGuild (Json.Decode.succeed (\\a b -> { type_ = a" , " , guild = b }) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.string |>"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"type\" (Json.Decode.string |>" , " Json.Decode.andThen (\\b -> if b == \"discord-server\" then" , " Json.Decode.succeed ()" , "" , " else"- , " Json.Decode.fail \"Tag mismatch\"))) |>"- , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.succeed (\\b c -> { id = b"+ , " Json.Decode.fail \"Tag mismatch\")))) |>"+ , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"guild\" (Json.Decode.succeed (\\b c -> { id = b" , " , name = c }) |>"- , " Json.Decode.andThen (\\b -> Json.Decode.map b Json.Decode.string) |>"- , " Json.Decode.andThen (\\b -> Json.Decode.map b Json.Decode.string)))) ]"+ , " Json.Decode.andThen (\\b -> Json.Decode.map b (Json.Decode.field \"id\" Json.Decode.string)) |>"+ , " Json.Decode.andThen (\\b -> Json.Decode.map b (Json.Decode.field \"name\" Json.Decode.string)))))) ]" , "" , "" , "inviteEncoder : Invite -> Json.Encode.Value"@@ -294,6 +294,18 @@ , JsonArray JsonString ) ]+ )+ )+ , '( "newtypedObject"+ , Named "NewtypedElmRecord"+ ( Named "Cons"+ ( JsonObject+ '[ '("stringField", JsonString)+ , '( "listOfStrings"+ , JsonArray JsonString+ )+ ]+ ) ) ) ]