diff --git a/json-spec-elm.cabal b/json-spec-elm.cabal --- a/json-spec-elm.cabal +++ b/json-spec-elm.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-elm -version: 0.4.0.0 +version: 0.4.0.1 synopsis: Elm code generate for `json-spec`. description: Produce elm types, encoders, and decoders from a @@ -34,7 +34,6 @@ -Wmissing-export-lists -Wmissing-import-lists -Wredundant-constraints - -Wunused-packages library import: dependencies, warnings @@ -44,21 +43,32 @@ -- other-extensions: hs-source-dirs: src default-language: Haskell2010 + ghc-options: + -Wunused-packages build-depends: , bound >= 2.0.7 && < 2.1 , mtl >= 2.2.2 && < 2.4 -test-suite test +flag compile-elm + description: + Set this flag to run the Elm compilation tests, which requires + Elm to be installed on the system. + default: False + +test-suite compile-elm import: dependencies, warnings - main-is: test.hs - type: exitcode-stdio-1.0 hs-source-dirs: test default-language: Haskell2010 - build-depends: - , json-spec-elm - , directory >= 1.3.7.1 && < 1.4 - , hspec >= 2.11.1 && < 2.12 - , prettyprinter >= 1.7.1 && < 1.8 - , process >= 1.6.16.0 && < 1.7 - , unordered-containers >= 0.2.19.1 && < 0.3 - + if flag(compile-elm) + type: exitcode-stdio-1.0 + main-is: test.hs + build-depends: + , json-spec-elm + , directory >= 1.3.7.1 && < 1.4 + , hspec >= 2.11.1 && < 2.12 + , prettyprinter >= 1.7.1 && < 1.8 + , process >= 1.6.16.0 && < 1.7 + , unordered-containers >= 0.2.19.1 && < 0.3 + else + type: exitcode-stdio-1.0 + main-is: test-pass.hs diff --git a/src/Data/JsonSpec/Elm.hs b/src/Data/JsonSpec/Elm.hs --- a/src/Data/JsonSpec/Elm.hs +++ b/src/Data/JsonSpec/Elm.hs @@ -1,9 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -121,8 +124,7 @@ import Language.Elm.Type (Type) import Prelude (Applicative(pure), Bool(False, True), Foldable(foldl, foldr), Functor(fmap), Maybe(Just, Nothing), Monad((>>)), - Semigroup((<>)), Show(show), ($), (++), (.), (<$>), Int, error, fst, - snd, zip) + Semigroup((<>)), Show(show), ($), (++), (.), (<$>), Int, error, zip) import qualified Data.Char as Char import qualified Data.Set as Set import qualified Data.Text as Text @@ -148,10 +150,46 @@ execWriter $ typeOf @spec >> decoderOf @spec +{-| Describes how a field in a record should be encoded in Elm. -} +data FieldEncoding = FieldEncoding + { required :: Bool + {-^ + 'True' if the fields presence is required in the JSON + object, 'False' if it is not (which implies that the + field is a @Maybe something@, though that information + is not tracked here. + -} + , jsonField :: Text {-^ The name of the encoded JSON field. -} + , elmField :: Name.Field {-^ The name of the Elm record field. -} + , encoderFun :: Expression Void + {-^ + The Elm function which can decode field value. The + expression will be a lambda expression that accepts + an Elm value and produces Elm's representation of a + JSON value (i.e. @Json.Encode.Value@) + -} + } + + +{-| Describes how a field in a record should be decoded. -} +data FieldDecoding = FieldDecoding + { jsonField :: Text {-^ The name of the decoded field in JSON -} + , decoder :: Expression Void + {-^ + An Elm expression containing the decoder for the + field value. I.e. of the Elm type @Json.Decode.Decoder + something@. + -} + } + +{-| + How to define, encode, and decode an Elm record from a list of JSON + object field specifications. +-} class Record (spec :: [FieldSpec]) where recordDefs :: forall v. Definitions [(Name.Field, Type v)] - recordEncoders :: Definitions [(Bool, Text, Name.Field, Expression Void)] - recordDecoders :: Definitions [(Text, Expression Void)] + recordEncoders :: Definitions [FieldEncoding] + recordDecoders :: Definitions [FieldDecoding] instance Record '[] where recordDefs = pure [] recordEncoders = pure [] @@ -171,14 +209,23 @@ recordEncoders = do encoder <- encoderOf @spec moreFields <- recordEncoders @more - pure $ (True, sym @name, fieldName (sym @name), encoder) : moreFields + pure $ + FieldEncoding + { required = True + , jsonField = sym @name + , elmField = fieldName (sym @name) + , encoderFun = encoder + } + : moreFields recordDecoders = do dec <- decoderOf @spec more <- recordDecoders @more pure $ - ( sym @name - , "Json.Decode.field" `a` Expr.String (sym @name) `a` dec - ) : more + FieldDecoding + { jsonField = sym @name + , decoder = "Json.Decode.field" `a` Expr.String (sym @name) `a` dec + } + : more instance ( HasType spec , KnownSymbol name @@ -194,15 +241,25 @@ recordEncoders = do encoder <- encoderOf @spec moreFields <- recordEncoders @more - pure $ (False, sym @name, fieldName (sym @name), encoder) : moreFields + pure $ + FieldEncoding + { required = False + , jsonField = sym @name + , elmField = fieldName (sym @name) + , encoderFun = encoder + } + : moreFields recordDecoders = do dec <- decoderOf @spec more <- recordDecoders @more pure $ - ( sym @name - , "Json.Decode.maybe" - `a` ("Json.Decode.field" `a` Expr.String (sym @name) `a` dec) - ) : more + FieldDecoding + { jsonField = sym @name + , decoder = + "Json.Decode.maybe" + `a` ("Json.Decode.field" `a` Expr.String (sym @name) `a` dec) + } + : more {-| @@ -246,7 +303,7 @@ instance (Record fields) => HasType (JsonObject fields) where typeOf = Type.Record <$> recordDefs @fields decoderOf = do - decoders <- recordDecoders @fields + decodings <- recordDecoders @fields pure $ foldl (\expr decoder -> @@ -256,8 +313,8 @@ lam (\var -> "Json.Decode.map" `a` var `a` (absurd <$> decoder)) ) ) - ("Json.Decode.succeed" `a` recordConstructor (fst <$> decoders)) - (snd <$> decoders) + ("Json.Decode.succeed" `a` recordConstructor ((.jsonField) <$> decodings)) + ((.decoder) <$> decodings) encoderOf = do fields <- recordEncoders @fields pure $ @@ -272,7 +329,7 @@ Expr.apps "Basics.," [ Expr.String jsonField, - fmap absurd encoder `a` + fmap absurd encoderFun `a` (Expr.Proj elmField `a` var) ] else @@ -281,11 +338,13 @@ Expr.apps "Basics.," [ Expr.String jsonField, - fmap absurd encoder `a` inner + fmap absurd encoderFun `a` inner ] ) `a` (Expr.Proj elmField `a` var) - | (required, jsonField, elmField, encoder) <- fields + | FieldEncoding {required, jsonField, elmField, encoderFun} + <- fields + ] ) ) diff --git a/test/test-pass.hs b/test/test-pass.hs new file mode 100644 --- /dev/null +++ b/test/test-pass.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = pure () diff --git a/test/test.hs b/test/test.hs deleted file mode 100644 --- a/test/test.hs +++ /dev/null @@ -1,434 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} - -module Main (main) where - -import Data.Foldable (traverse_) -import Data.HashMap.Strict (HashMap) -import Data.JsonSpec (FieldSpec(Optional, Required), - Specification(JsonArray, JsonDateTime, JsonEither, JsonInt, JsonLet, - JsonNullable, JsonNum, JsonObject, JsonRef, JsonString, JsonTag)) -import Data.JsonSpec.Elm (Named, elmDefs) -import Data.Maybe (fromMaybe) -import Data.Proxy (Proxy(Proxy)) -import Data.Text (Text) -import Language.Elm.Name (Module) -import Language.Elm.Pretty (modules) -import Prelude (Bool(True), Functor(fmap), Semigroup((<>)), ($), (.), - FilePath, IO, init) -import Prettyprinter (defaultLayoutOptions, layoutPretty) -import Prettyprinter.Render.Text (renderStrict) -import System.Directory (createDirectoryIfMissing) -import System.IO (stderr) -import System.Process (callCommand) -import Test.Hspec (describe, hspec, it, shouldBe) -import qualified Data.HashMap.Strict as HM -import qualified Data.Set as Set -import qualified Data.Text as Text -import qualified Data.Text.IO as TIO - - -main :: IO () -main = - hspec $ do - describe "Code generation" $ do - it "works with a complicated schema" $ - let - actual :: HashMap Module Text - actual = - fmap ((<> "\n") . renderStrict . layoutPretty defaultLayoutOptions) - . modules - . Set.toList - $ elmDefs (Proxy @TestSpec) - - expected :: HashMap Module Text - expected = - HM.singleton - ["Api", "Data"] - ( Text.unlines - [ "module Api.Data exposing" - , " ( dashboardDecoder" - , " , dashboardEncoder" - , " , inviteDecoder" - , " , inviteEncoder" - , " , Invite(..)" - , " , Dashboard" - , " )" - , "" - , "import Iso8601" - , "import Json.Decode" - , "import Json.Encode" - , "import Time" - , "" - , "" - , "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.field \"proposals\" (Json.Decode.list (Json.Decode.succeed (\\b c -> { key = b" - , " , value = 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" - , " , venue = g" - , " , invites = h" - , " , created_at = i" - , " , attachments = j }) |>" - , " 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.field \"interval\" (Json.Decode.succeed (\\e f -> { startInclusive = e" - , " , endExclusive = f }) |>" - , " 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.maybe (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" - , "dashboardEncoder a =" - , " Json.Encode.object (List.filterMap identity [ Just (\"proposals\" , Json.Encode.list (\\b -> Json.Encode.object (List.filterMap identity [ Just (\"key\" , Json.Encode.string b.key)" - , " , Just (\"value\" , (\\c -> Json.Encode.object (List.filterMap identity [ Just (\"name\" , Json.Encode.string c.name)" - , " , Just (\"owner\" , Json.Encode.string c.owner)" - , " , Just (\"availability\" , Json.Encode.list (\\d -> Json.Encode.object (List.filterMap identity [ Just (\"interval\" , (\\e -> Json.Encode.object (List.filterMap identity [ Just (\"startInclusive\" , Iso8601.encode e.startInclusive)" - , " , Just (\"endExclusive\" , Iso8601.encode e.endExclusive) ])) d.interval)" - , " , Just (\"users\" , Json.Encode.list Json.Encode.string d.users) ])) c.availability)" - , " , Just (\"description\" , Json.Encode.string c.description)" - , " , Just (\"venue\" , Json.Encode.string c.venue)" - , " , Just (\"invites\" , Json.Encode.list inviteEncoder c.invites)" - , " , Just (\"created-at\" , Iso8601.encode c.created_at)" - , " , Just (\"attachments\" , Json.Encode.list Json.Encode.string c.attachments) ])) b.value) ])) a.proposals)" - , " , Maybe.map (\\b -> (\"credits\" , Json.Encode.int b)) a.credits" - , " , Just (\"user\" , Json.Encode.string a.user) ])" - , "" - , "" - , "inviteDecoder : Json.Decode.Decoder Invite" - , "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.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.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.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.field \"guild\" (Json.Decode.succeed (\\b c -> { id = b" - , " , name = c }) |>" - , " 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" - , "inviteEncoder a =" - , " case a of" - , " InviteUser b ->" - , " (\\c -> Json.Encode.object (List.filterMap identity [ Just (\"type\" , always (Json.Encode.string \"discord-user\") c.type_)" - , " , Just (\"username\" , Json.Encode.string c.username) ])) b" - , "" - , " InviteGuild b ->" - , " (\\c -> Json.Encode.object (List.filterMap identity [ Just (\"type\" , always (Json.Encode.string \"discord-server\") c.type_)" - , " , Just (\"guild\" , (\\d -> Json.Encode.object (List.filterMap identity [ Just (\"id\" , Json.Encode.string d.id)" - , " , Just (\"name\" , Json.Encode.string d.name) ])) c.guild) ])) b" - , "" - , "" - , "type Invite " - , " = InviteUser { type_ : (), username : String }" - , " | InviteGuild { type_ : (), guild : { id : String, name : String } }" - , "" - , "" - , "type alias Dashboard =" - , " { proposals : List { key : String" - , " , value : { name : String" - , " , owner : String" - , " , availability : List { interval : { startInclusive : Time.Posix" - , " , endExclusive : Time.Posix }" - , " , users : List String }" - , " , description : String" - , " , venue : String" - , " , invites : List Invite" - , " , created_at : Time.Posix" - , " , attachments : List String } }" - , " , credits : Maybe Int" - , " , user : String }" - ] - ) - in do - TIO.hPutStrLn stderr "==========================================\n\n" - TIO.hPutStrLn stderr (fromMaybe "" (HM.lookup ["Api", "Data"] actual)) - TIO.hPutStrLn stderr "\n\n==========================================\n\n" - actual `shouldBe` expected - compileElm actual - it "works with the example schema" $ - let - actual :: HashMap Module Text - actual = - fmap ((<> "\n") . renderStrict . layoutPretty defaultLayoutOptions) - . modules - . Set.toList - $ elmDefs (Proxy @ExampleSpec) - - in do - compileElm actual - it "works with nullable values" $ - let - actual :: HashMap Module Text - actual = - fmap ((<> "\n") . renderStrict . layoutPretty defaultLayoutOptions) - . modules - . Set.toList - $ elmDefs (Proxy @NullableSpec) - - expected :: HashMap Module Text - expected = - HM.singleton - ["Api", "Data"] - ( Text.unlines - [ "module Api.Data exposing" - , " ( nullableIntDecoder" - , " , nullableIntEncoder" - , " , NullableInt" - , " )" - , "" - , "import Json.Decode" - , "import Json.Encode" - , "" - , "" - , "nullableIntDecoder : Json.Decode.Decoder NullableInt" - , "nullableIntDecoder =" - , " Json.Decode.nullable Json.Decode.int" - , "" - , "" - , "nullableIntEncoder : NullableInt -> Json.Encode.Value" - , "nullableIntEncoder a =" - , " Maybe.withDefault Json.Encode.null (Maybe.map Json.Encode.int a)" - , "" - , "" - , "type alias NullableInt =" - , " Maybe Int" - ] - ) - in do - actual `shouldBe` expected - compileElm actual - it "works with optionality" $ - let - actual :: HashMap Module Text - actual = - fmap ((<> "\n") . renderStrict . layoutPretty defaultLayoutOptions) - . modules - . Set.toList - $ elmDefs (Proxy @( - JsonLet - '[ '("TestObj", JsonObject '[ - Optional "foo" JsonInt, - Optional "bar" (JsonNullable JsonInt), - Required "baz" JsonInt, - Required "qux" (JsonNullable JsonInt) - ]) - ] - (JsonRef "TestObj") - )) - - expected :: HashMap Module Text - expected = - HM.singleton - ["Api", "Data"] - ( Text.unlines - [ "module Api.Data exposing" - , " ( testObjDecoder" - , " , testObjEncoder" - , " , TestObj" - , " )" - , "" - , "import Json.Decode" - , "import Json.Encode" - , "" - , "" - , "testObjDecoder : Json.Decode.Decoder TestObj" - , "testObjDecoder =" - , " Json.Decode.succeed (\\a b c d -> { foo = a, bar = b, baz = c, qux = d }) |>" - , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.maybe (Json.Decode.field \"foo\" Json.Decode.int))) |>" - , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.maybe (Json.Decode.field \"bar\" (Json.Decode.nullable Json.Decode.int)))) |>" - , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"baz\" Json.Decode.int)) |>" - , " Json.Decode.andThen (\\a -> Json.Decode.map a (Json.Decode.field \"qux\" (Json.Decode.nullable Json.Decode.int)))" - , "" - , "" - , "testObjEncoder : TestObj -> Json.Encode.Value" - , "testObjEncoder a =" - , " Json.Encode.object (List.filterMap identity [ Maybe.map (\\b -> (\"foo\" , Json.Encode.int b)) a.foo" - , " , Maybe.map (\\b -> (\"bar\" , (\\c -> Maybe.withDefault Json.Encode.null (Maybe.map Json.Encode.int c)) b)) a.bar" - , " , Just (\"baz\" , Json.Encode.int a.baz)" - , " , Just (\"qux\" , (\\b -> Maybe.withDefault Json.Encode.null (Maybe.map Json.Encode.int b)) a.qux) ])" - , "" - , "" - , "type alias TestObj =" - , " { foo : Maybe Int, bar : Maybe (Maybe Int), baz : Int, qux : Maybe Int }" - ] - ) - in do - actual `shouldBe` expected - compileElm actual - - -compileElm :: HashMap Module Text -> IO () -compileElm code = do - traverse_ writeModule (HM.toList code) - callCommand "(cd elm-test; elm-format src/ --yes)" - callCommand - "(\ - \cd elm-test; \ - \yes Y | (\ - \elm init; \ - \elm install rtfeldman/elm-iso8601-date-strings; \ - \elm install elm/json; \ - \elm install elm/url; \ - \elm install elm/time; \ - \elm install elm/http\ - \); \ - \elm make src/Api/Data.elm\ - \)" - callCommand "rm -rf elm-test" - - -{- - This spec is copied from an as-yet uncompleted personal project. I - just used it because it is fairly complex. Probably something known - to be exhaustive is in order. --} -type TestSpec = - JsonLet - '[ - '("Dashboard", JsonObject '[ - Required "proposals" (JsonArray ( - JsonObject '[ - Required "key" JsonString, - Required "value" (JsonObject '[ - Required "name" JsonString, - Required "owner" JsonString, - Required "availability" (JsonArray ( - JsonObject '[ - Required "interval" (JsonObject '[ - Required "startInclusive" JsonDateTime, - Required "endExclusive" JsonDateTime - ]), - Required "users" (JsonArray JsonString) - ] - )), - Required "description" JsonString, - Required "venue" JsonString, - Required "invites" ( - JsonLet '[ - '("Invite", - JsonEither - (Named "InviteUser" (JsonObject '[ - Required "type" (JsonTag "discord-user"), - Required "username" JsonString - ])) - (Named "InviteGuild" (JsonObject '[ - Required "type" (JsonTag "discord-server"), - Required "guild" (JsonObject '[ - Required "id" JsonString, - Required "name" JsonString - ]) - ])) - ) - ] - (JsonArray (JsonRef "Invite")) - ), - Required "created-at" JsonDateTime, - Required "attachments" (JsonArray JsonString) - ]) - ] - )), - Optional "credits" JsonInt, - Required "user" JsonString - ]) - ] ( JsonRef "Dashboard") - - -type ExampleSpec = - Named "ExampleType" - ( JsonObject '[ - Required "stringField" JsonString, - Required "anonymousObject" (JsonObject '[ - Required "floatField" JsonNum, - Required "dateField" JsonDateTime, - Required "sumType1" ( - Named "SumTypeWithCustomConstructorNames" ( - JsonEither - ( - JsonEither - (Named "IntConstructor" JsonInt) - (Named "StringConstructor" JsonString) - ) - (Named "FloatConstructor" JsonNum) - ) - ), - Required "sumType2" ( - Named "SumTypeWithAutomaticConstructorNames" ( - JsonEither - ( JsonEither JsonInt JsonString) - JsonNum - ) - ) - ]), - Required "namedObject" ( - Named "NamedElmRecord" ( - JsonObject '[ - Required "stringField" JsonString, - Required "listOfStrings" (JsonArray JsonString) - ] - ) - ), - Required "newtypedObject" ( - Named "NewtypedElmRecord" ( - Named "Cons" ( - JsonObject '[ - Required "stringField" JsonString, - Required "listOfStrings" (JsonArray JsonString) - ] - ) - ) - ) - ] - ) - - -type NullableSpec = - Named "NullableInt" - (JsonNullable JsonInt) - - -writeModule :: (Module, Text) -> IO () -writeModule (module_, content) = do - createDirectoryIfMissing True dirname - TIO.writeFile filename content - where - pathName :: [Text] -> FilePath - pathName = ("elm-test/src/" <>) . Text.unpack . Text.intercalate "/" - - filename :: FilePath - filename = pathName module_ <> ".elm" - - dirname :: FilePath - dirname = pathName (init module_) - -