diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,11 @@ `elm-street` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. -## Unreleased + +## 0.2.1.0 - Aug 3, 2023 + +* Add GHC 9.4.5 and 9.6.2 to CI / tested-with +* Introduce CodeGenOptions to allow customizing record field names. ## 0.2.0.0 - Mar 29, 2022 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,16 +4,13 @@ [![Hackage](https://img.shields.io/hackage/v/elm-street.svg)](https://hackage.haskell.org/package/elm-street) [![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](LICENSE) -[![Stackage Lts](http://stackage.org/package/elm-street/badge/lts)](http://stackage.org/lts/package/elm-street) -[![Stackage Nightly](http://stackage.org/package/elm-street/badge/nightly)](http://stackage.org/nightly/package/elm-street) Crossing the road between Haskell and Elm. ## What is this library about? -`Elm-street` allows you to generate automatically derived from Haskell types -definitions of Elm data types, JSON encoders and decoders. This helps to avoid -writing and maintaining huge chunk of boilerplate code when developing full-stack +`elm-street` allows you to automatically generate definitions of Elm data types and compatible JSON encoders and decoders + from Haskell types. This helps to avoid writing and maintaining huge chunk of boilerplate code when developing full-stack applications. ## Getting started @@ -58,13 +55,13 @@ > **NOTE:** This requires extension `-XDataKinds`. 4. Use `generateElm` function to output definitions to specified directory under specified module prefix. - ``` + ```haskell main :: IO () main = generateElm @Types $ defaultSettings "frontend/src" ["Core", "Generated"] ``` > **NOTE:** This requires extension `-XTypeApplications`. - The above command when called generates the following files: + When executed, the above program generates the following files: + `frontend/src/Core/Generated/Types.elm`: `Core.Generated.Types` module with the definitions of all types + `frontend/src/Core/Generated/Encoder.elm`: `Core.Generated.Encoder` module with the JSON encoders for the types @@ -104,7 +101,7 @@ } ``` 2. Data types with type variables are not supported (see [issue #45](https://github.com/Holmusk/elm-street/issues/45) for more details). - Though, if type variables are phantom, you still can implement `Elm` instance which + Though, if type variables are phantom, you can still implement `Elm` instance which will generate valid Elm defintions. Here is how you can create `Elm` instance for `newtype`s with phantom type variables: ```haskell diff --git a/elm-street.cabal b/elm-street.cabal --- a/elm-street.cabal +++ b/elm-street.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: elm-street -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Crossing the road between Haskell and Elm description: `Elm-street` allows you to generate automatically derived from Haskell types @@ -18,17 +18,18 @@ build-type: Simple extra-doc-files: README.md CHANGELOG.md -tested-with: GHC == 8.8.4 - GHC == 8.10.7 +tested-with: GHC == 8.10.7 GHC == 9.0.2 - GHC == 9.2.2 + GHC == 9.2.8 + GHC == 9.4.5 + GHC == 9.6.2 source-repository head type: git location: https://github.com/Holmusk/elm-street.git common common-options - build-depends: base >= 4.11.1.0 && < 4.17 + build-depends: base >= 4.11.1.0 && < 4.19 ghc-options: -Wall -Wincomplete-uni-patterns @@ -75,7 +76,7 @@ , directory ^>= 1.3 , filepath ^>= 1.4 , prettyprinter >= 1.2.1 && < 1.8 - , text >= 1.2 && <= 2.0 + , text >= 1.2 && <= 2.1 , time library types diff --git a/src/Elm/Aeson.hs b/src/Elm/Aeson.hs --- a/src/Elm/Aeson.hs +++ b/src/Elm/Aeson.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} - {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} @@ -10,7 +8,9 @@ module Elm.Aeson ( elmStreetParseJson + , elmStreetParseJsonWith , elmStreetToJson + , elmStreetToJsonWith , elmStreetJsonOptions , ElmStreet (..) @@ -20,22 +20,20 @@ defaultOptions, genericParseJSON, genericToJSON) import Data.Aeson.Types (Parser) import GHC.Generics (Generic, Rep) -import Type.Reflection (Typeable, typeRep) +import Type.Reflection (Typeable) -import Elm.Ast (TypeName (..)) -import Elm.Generic (Elm (..), GenericElmDefinition (..), HasLessThanEightUnnamedFields, - HasNoNamedSum, HasNoTypeVars, stripTypeNamePrefix) +import Elm.Generic (Elm (..), CodeGenOptions (..), GenericElmDefinition (..), ElmStreetGenericConstraints, defaultCodeGenOptions) import qualified Data.Text as T import qualified GHC.Generics as Generic (from) -{- | Allows to create 'Data.Aeson.FromJSON' instance that strips the supported -by @elm-street@ data type name prefix from every field.. +{- | Allows to create 'Data.Aeson.FromJSON' instance for data types supported by +@elm-street@. Strips data type name prefix from every field. __Example:__ -With the following @JSON@ +The following @JSON@ @ { \"name\": \"John\" @@ -43,16 +41,16 @@ } @ -it is decoded it the following way for each of the specified types: +is decoded in the following way for each of the specified types: +-------------------------------+--------------------------+ | Haskell data type | Parsed type | +===============================+==========================+ | @ | @ | | data User = User | User | -| \ { userName :: String | { userName = \"John\" | -| \ , userAge :: Int | , userAge = 42 | -| \ } | } | +| { userName :: String | { userName = \"John\" | +| , userAge :: Int | , userAge = 42 | +| } | } | | @ | @ | +-------------------------------+--------------------------+ | | | @@ -73,13 +71,13 @@ >>> data User = User { userName :: String, userAge :: Int } deriving (Generic, Show) >>> instance FromJSON User where parseJSON = elmStreetParseJson ->>> decode @User "{ \"name\": \"John\", \"age\": 42 }" +>>> decode @User "{\"age\":42,\"name\":\"John\",\"tag\":\"User\"}" Just (User {userName = "John", userAge = 42}) >>> data VeryLongType = VeryLongType { vltName :: String, vltAge :: Int } deriving (Generic, Show) >>> instance FromJSON VeryLongType where parseJSON = elmStreetParseJson ->>> decode @VeryLongType "{ \"name\": \"John\", \"age\": 42 }" +>>> decode @VeryLongType "{\"age\":42,\"name\":\"John\",\"tag\":\"VeryLongType\"}" Just (VeryLongType {vltName = "John", vltAge = 42}) -} @@ -88,58 +86,60 @@ (Typeable a, Generic a, GFromJSON Zero (Rep a)) => Value -> Parser a -elmStreetParseJson = genericParseJSON (elmStreetJsonOptions @a) +elmStreetParseJson = elmStreetParseJsonWith (defaultCodeGenOptions @a) -{- | Allows to create 'Data.Aeson.ToJSON' instance that strips the supported by -@elm-street@ data type name prefix from every field. +{- | Use custom 'CodeGenOptions' to customize the behavior of derived FromJSON instance. +-} +elmStreetParseJsonWith + :: forall a . + (Generic a, GFromJSON Zero (Rep a)) + => CodeGenOptions + -> Value + -> Parser a +elmStreetParseJsonWith options = genericParseJSON (elmStreetJsonOptions options) +{- | Allows to create 'Data.Aeson.ToJSON' instance for types supported by @elm-street@. +Strips type name prefix from every record field. + >>> data User = User { userName :: String, userAge :: Int } deriving (Generic, Show) >>> instance ToJSON User where toJSON = elmStreetToJson >>> encode $ User { userName = "John", userAge = 42 } -"{\"age\":42,\"name\":\"John\"}" +"{\"age\":42,\"name\":\"John\",\"tag\":\"User\"}" >>> data VeryLongType = VeryLongType { vltName :: String, vltAge :: Int } deriving (Generic, Show) >>> instance ToJSON VeryLongType where toJSON = elmStreetToJson >>> encode $ VeryLongType {vltName = "John", vltAge = 42} -"{\"age\":42,\"name\":\"John\"}" +"{\"age\":42,\"name\":\"John\",\"tag\":\"VeryLongType\"}" >>> data User = User { name :: String, age :: Int } deriving (Generic, Show) >>> instance ToJSON User where toJSON = elmStreetToJson >>> encode $ User { name = "John", age = 42 } -"{\"age\":42,\"name\":\"John\"}" +"{\"age\":42,\"name\":\"John\",\"tag\":\"User\"}" -} elmStreetToJson :: forall a . (Typeable a, Generic a, GToJSON Zero (Rep a)) => a -> Value -elmStreetToJson = genericToJSON (elmStreetJsonOptions @a) - -{- | Options to strip type name from the field names. - -+----------------+----------------+---------------------+ -| Data type name | Field name | Stripped field name | -+================+================+=====================+ -| @User@ | @userName@ | @name@ | -+----------------+----------------+---------------------+ -| @AaaBbbCcc@ | @abcFieldName@ | @fieldName@ | -+----------------+----------------+---------------------+ -| @Foo@ | @field@ | @field@ | -+----------------+----------------+---------------------+ -| @Field@ | @field@ | @field@ | -+----------------+----------------+---------------------+ +elmStreetToJson = elmStreetToJsonWith (defaultCodeGenOptions @a) +{- | Use custom 'CodeGenOptions' to customize the behavior of derived ToJSON instance. -} -elmStreetJsonOptions :: forall a . Typeable a => Options -elmStreetJsonOptions = defaultOptions - { fieldLabelModifier = T.unpack . stripTypeNamePrefix typeName . T.pack +elmStreetToJsonWith + :: forall a . + (Generic a, GToJSON Zero (Rep a)) + => CodeGenOptions + -> a + -> Value +elmStreetToJsonWith options = genericToJSON (elmStreetJsonOptions options) + +-- | Build @elm-street@ compatible 'Data.Aeson.Options' from 'CodeGenOptions'. +elmStreetJsonOptions :: CodeGenOptions -> Options +elmStreetJsonOptions options = defaultOptions + { fieldLabelModifier = T.unpack . cgoFieldLabelModifier options . T.pack , tagSingleConstructors = True } - where - typeName :: TypeName - typeName = TypeName $ T.pack $ show $ typeRep @a - {- | Newtype for reusing in @DerivingVia@. In order to use it with your type @MyType@ add the following deriving to your type: @@ -152,13 +152,8 @@ { unElmStreet :: a } -instance ( HasNoTypeVars a - , HasLessThanEightUnnamedFields a - , HasNoNamedSum a - , Generic a - , GenericElmDefinition (Rep a) - ) => Elm (ElmStreet a) where - toElmDefinition _ = genericToElmDefinition +instance (ElmStreetGenericConstraints a, Typeable a) => Elm (ElmStreet a) where + toElmDefinition _ = genericToElmDefinition (defaultCodeGenOptions @a) $ Generic.from (error "Proxy for generic elm was evaluated" :: a) instance (Typeable a, Generic a, GToJSON Zero (Rep a)) => ToJSON (ElmStreet a) where diff --git a/src/Elm/Generate.hs b/src/Elm/Generate.hs --- a/src/Elm/Generate.hs +++ b/src/Elm/Generate.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} diff --git a/src/Elm/Generic.hs b/src/Elm/Generic.hs --- a/src/Elm/Generic.hs +++ b/src/Elm/Generic.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} - {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} @@ -28,6 +26,9 @@ , GenericConstructor (..) , toElmConstructor + -- * Customizing generated elm code and JSON instances + , CodeGenOptions (..) + , defaultCodeGenOptions -- * Type families for compile-time checks , HasNoTypeVars @@ -42,6 +43,7 @@ , NamedSumError , CheckNamedSum , CheckConst + , ElmStreetGenericConstraints -- * Internals , stripTypeNamePrefix @@ -54,6 +56,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Proxy (Proxy (..)) import Data.Text (Text) +import Type.Reflection (Typeable, typeRep) import Data.Time.Clock (UTCTime) import Data.Type.Bool (If, type (||)) import Data.Void (Void) @@ -77,15 +80,10 @@ toElmDefinition :: Proxy a -> ElmDefinition default toElmDefinition - :: ( HasNoTypeVars a - , HasLessThanEightUnnamedFields a - , HasNoNamedSum a - , Generic a - , GenericElmDefinition (Rep a) - ) + :: (ElmStreetGenericConstraints a, Typeable a) => Proxy a -> ElmDefinition - toElmDefinition _ = genericToElmDefinition + toElmDefinition _ = genericToElmDefinition (defaultCodeGenOptions @a) $ Generic.from (error "Proxy for generic elm was evaluated" :: a) {- | Returns 'TypeRef' for the existing type. This function always returns the @@ -182,10 +180,10 @@ type and decides what to generate. -} class GenericElmDefinition (f :: k -> Type) where - genericToElmDefinition :: f a -> ElmDefinition + genericToElmDefinition :: CodeGenOptions -> f a -> ElmDefinition instance (Datatype d, GenericElmConstructors f) => GenericElmDefinition (D1 d f) where - genericToElmDefinition datatype = case genericToElmConstructors (TypeName typeName) (unM1 datatype) of + genericToElmDefinition options datatype = case genericToElmConstructors options (unM1 datatype) of c :| [] -> case toElmConstructor c of Left fields -> DefRecord $ ElmRecord typeName fields elmIsNewtype Right ctor -> DefType $ ElmType typeName [] elmIsNewtype (ctor :| []) @@ -232,34 +230,34 @@ {- | Typeclass to collect all constructors of the Haskell data type generically. -} class GenericElmConstructors (f :: k -> Type) where genericToElmConstructors - :: TypeName -- ^ Name of the data type; to be stripped + :: CodeGenOptions -> f a -- ^ Generic value -> NonEmpty GenericConstructor -- ^ List of the data type constructors -- | If it's a sum type then just combine constructors instance (GenericElmConstructors f, GenericElmConstructors g) => GenericElmConstructors (f :+: g) where - genericToElmConstructors name _ = - genericToElmConstructors name (error "'f :+:' is evaluated" :: f p) - <> genericToElmConstructors name (error "':+: g' is evaluated" :: g p) + genericToElmConstructors options _ = + genericToElmConstructors options (error "'f :+:' is evaluated" :: f p) + <> genericToElmConstructors options (error "':+: g' is evaluated" :: g p) -- | Create singleton list for case of a one constructor. instance (Constructor c, GenericElmFields f) => GenericElmConstructors (C1 c f) where - genericToElmConstructors name constructor = pure $ GenericConstructor + genericToElmConstructors options constructor = pure $ GenericConstructor (T.pack $ conName constructor) - (genericToElmFields name $ unM1 constructor) + (genericToElmFields options $ unM1 constructor) -- | Collect all fields when inside constructor. class GenericElmFields (f :: k -> Type) where genericToElmFields - :: TypeName -- ^ Name of the data type; to be stripped + :: CodeGenOptions -> f a -- ^ Generic value -> [(TypeRef, Maybe Text)] -- | If multiple fields then just combine all results. instance (GenericElmFields f, GenericElmFields g) => GenericElmFields (f :*: g) where - genericToElmFields name _ = - genericToElmFields name (error "'f :*:' is evaluated" :: f p) - <> genericToElmFields name (error "':*: g' is evaluated" :: g p) + genericToElmFields options _ = + genericToElmFields options (error "'f :*:' is evaluated" :: f p) + <> genericToElmFields options (error "':*: g' is evaluated" :: g p) -- | Constructor without fields. instance GenericElmFields U1 where @@ -267,9 +265,9 @@ -- | Single constructor field. instance (Selector s, Elm a) => GenericElmFields (S1 s (Rec0 a)) where - genericToElmFields typeName selector = case selName selector of + genericToElmFields options selector = case selName selector of "" -> [(elmRef @a, Nothing)] - name -> [(elmRef @a, Just $ stripTypeNamePrefix typeName $ T.pack name)] + name -> [(elmRef @a, Just $ cgoFieldLabelModifier options $ T.pack name)] {- | Strips name of the type name from field name prefix. @@ -303,6 +301,83 @@ leaveIfEmpty :: Text -> Text leaveIfEmpty rest = if T.null rest then fieldName else headToLower rest +{- | CodeGenOptions allow for customizing some aspects of generated Elm code as well as + ToJSON and FromJSON instances derived generically. + +They can be passed to 'elmStreetParseJsonWith', 'elmStreetToJsonWith' and 'genericToElmDefinition' +to influence the behavior of FromJSON \/ ToJSON and Elm instances respectively. + +Note that for Generated Elm encoders \/ decoders to be compatible +with ToJSON \/ FromJSON instances for given type, +__the same CodeGenOptions must be used in Elm \/ ToJSON \/ FromJSON instance declarations__. + +Example: Say you don't like the default behavior (stripping type name prefix from all record fields) +and you would like to keep all record field names unmodified instead. +You can achieve that by declaring custom options: + +@ +myCodeGenOptions :: CodeGenOptions +myCodeGenOptions = CodeGenOptions { cgoFieldLabelModifier = id } +@ + +And then pass these options when defining Elm \/ ToJSON \/ FromJSON instances. +It is recommended to use DerivingVia to reduce the amount of boilerplate needed. +First declare a newtype whose Elm \/ ToJSON \/ FromJSON instances use your custom CodeGenOptions: + +@ +newtype CustomElm a = CustomElm {unCustomElm :: a} + +instance ElmStreetGenericConstraints a => Elm (CustomElm a) where + toElmDefinition _ = genericToElmDefinition myCodeGenOptions $ + GHC.Generics.from (error "Proxy for generic elm was evaluated" :: a) + +instance (Generic a, GToJSON Zero (Rep a)) => ToJSON (CustomElm a) where + toJSON = elmStreetToJsonWith myCodeGenOptions . unCustomElm + +instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomElm a) where + parseJSON = fmap CustomElm . elmStreetParseJsonWith myCodeGenOptions +@ + +Then derive Elm \/ ToJSON \/ FromJSON instance via that newtype: + +@ +data MyType = MyType + { myTypeFieldOne :: String + , myTypeFieldTwo :: Int + } deriving stock (Show, Generic) + deriving (Elm, ToJSON, FromJSON) via CustomElm MyType +@ + +We can check that type name prefix is no longer stripped from record field names: + +>>> encode (MyType "Hello" 10) +"{\"myTypeFieldOne\":\"Hello\",\"myTypeFieldTwo\":10,\"tag\":\"MyType\"}" +-} +newtype CodeGenOptions = CodeGenOptions + { cgoFieldLabelModifier :: Text -> Text -- ^ Function that modifies record field names (e.g. by dropping type name prefix) + } + +{- | Options to strip type name from the field names. + ++----------------+----------------+---------------------+ +| Data type name | Field name | Stripped field name | ++================+================+=====================+ +| @User@ | @userName@ | @name@ | ++----------------+----------------+---------------------+ +| @AaaBbbCcc@ | @abcFieldName@ | @fieldName@ | ++----------------+----------------+---------------------+ +| @Foo@ | @field@ | @field@ | ++----------------+----------------+---------------------+ +| @Field@ | @field@ | @field@ | ++----------------+----------------+---------------------+ + +-} +defaultCodeGenOptions :: forall a. Typeable a => CodeGenOptions +defaultCodeGenOptions = CodeGenOptions (stripTypeNamePrefix typeName) + where + typeName :: TypeName + typeName = TypeName $ T.pack $ show $ typeRep @a + ---------------------------------------------------------------------------- -- ~Magic~ ---------------------------------------------------------------------------- @@ -384,3 +459,13 @@ NamedSumError t = 'Text "'elm-street' doesn't support Sum types with records." ':$$: 'Text "But '" ':<>: 'ShowType t ':<>: 'Text "' has records." + +-- | Convenience grouping of constraints that type has to satisfy +-- in order to be eligible for automatic derivation of Elm instance via generics +type ElmStreetGenericConstraints a = + ( HasNoTypeVars a + , HasLessThanEightUnnamedFields a + , HasNoNamedSum a + , Generic a + , GenericElmDefinition (Rep a) + ) diff --git a/test/Test/Golden.hs b/test/Test/Golden.hs --- a/test/Test/Golden.hs +++ b/test/Test/Golden.hs @@ -1,20 +1,25 @@ -module Test.Golden - ( goldenSpec - ) where - -import Test.Hspec (Spec, describe, it, runIO, shouldBe) +module Test.Golden (goldenSpec) where -import Types (OneType, defaultOneType) +import Test.Hspec (Spec, describe, it, shouldBe, shouldReturn) -import Data.Aeson as A -import Data.ByteString.Lazy as LBS +import Types (CustomCodeGen, OneType, defaultCustomCodeGen, defaultOneType) +import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy as LBS goldenSpec :: Spec goldenSpec = describe "golden tests" $ do - golden <- runIO $ LBS.readFile "test/golden/oneType.json" - - it "Golden JSON -> Haskell == default" $ - A.eitherDecode @OneType golden `shouldBe` Right defaultOneType - it "default -> JSON -> Haskell == default" $ - (A.eitherDecode @OneType $ A.encode defaultOneType) `shouldBe` Right defaultOneType + describe "Default CodeGenOptions" $ do + it "Golden JSON -> Haskell == default" $ + A.eitherDecode @OneType <$> LBS.readFile "test/golden/oneType.json" + `shouldReturn` Right defaultOneType + it "default -> JSON -> Haskell == default" $ + A.eitherDecode @OneType (A.encode defaultOneType) + `shouldBe` Right defaultOneType + describe "Custom CodeGenOptions" $ do + it "should decode type with custom CodeGenOptions" $ + A.eitherDecode @CustomCodeGen "{\"customFunTestInt\": 78,\"customFunTestString\": \"Hello\",\"tag\": \"CustomCodeGen\"}" + `shouldBe` Right defaultCustomCodeGen + it "should encode type with custom CodeGen" $ + A.eitherDecode @CustomCodeGen (A.encode defaultCustomCodeGen) + `shouldBe` Right defaultCustomCodeGen diff --git a/types/Types.hs b/types/Types.hs --- a/types/Types.hs +++ b/types/Types.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} {- | Haskell types used for testing `elm-street` generated Elm types. -} @@ -10,6 +11,7 @@ ( Types , OneType (..) , defaultOneType + , defaultCustomCodeGen -- * All test types , Prims (..) @@ -22,17 +24,22 @@ , User (..) , Guest (..) , UserRequest (..) + , CustomCodeGen (..) ) where -import Data.Aeson (FromJSON (..), ToJSON (..), Value(..), object, (.=)) +import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), object, (.=), GFromJSON, GToJSON, Zero) import Data.List.NonEmpty (NonEmpty(..)) import Data.Text (Text) import Data.Time.Calendar (fromGregorian) import Data.Time.Clock (UTCTime (..)) import Data.Word (Word32) -import Elm (Elm (..), ElmStreet (..), elmNewtype, elmStreetParseJson, elmStreetToJson) -import GHC.Generics (Generic) +import Elm (Elm (..), ElmStreet (..), elmNewtype) +import Elm.Generic (CodeGenOptions (..), ElmStreetGenericConstraints, GenericElmDefinition(..)) +import Elm.Aeson (elmStreetParseJsonWith, elmStreetToJsonWith) +import GHC.Generics (Generic, Rep) +import qualified GHC.Generics as Generic (from) +import qualified Data.Text as Text data Prims = Prims { primsUnit :: !() @@ -79,20 +86,14 @@ data OneConstructor = OneConstructor deriving stock (Generic, Eq, Show) - deriving anyclass (Elm) - -instance ToJSON OneConstructor where toJSON = elmStreetToJson -instance FromJSON OneConstructor where parseJSON = elmStreetParseJson + deriving (Elm, FromJSON, ToJSON) via ElmStreet OneConstructor data RequestStatus = Approved | Rejected | Reviewing deriving (Generic, Eq, Show) - deriving anyclass (Elm) - -instance ToJSON RequestStatus where toJSON = elmStreetToJson -instance FromJSON RequestStatus where parseJSON = elmStreetParseJson + deriving (Elm, FromJSON, ToJSON) via ElmStreet RequestStatus data User = User { userId :: !(Id User) @@ -100,10 +101,7 @@ , userAge :: !Age , userStatus :: !RequestStatus } deriving (Generic, Eq, Show) - deriving anyclass (Elm) - -instance ToJSON User where toJSON = elmStreetToJson -instance FromJSON User where parseJSON = elmStreetParseJson + deriving (Elm, FromJSON, ToJSON) via ElmStreet User data Guest = Regular Text Int @@ -111,20 +109,14 @@ | Special (Maybe [Int]) | Blocked deriving (Generic, Eq, Show) - deriving anyclass (Elm) - -instance ToJSON Guest where toJSON = elmStreetToJson -instance FromJSON Guest where parseJSON = elmStreetParseJson + deriving (Elm, FromJSON, ToJSON) via ElmStreet Guest data UserRequest = UserRequest { userRequestIds :: ![Id User] , userRequestLimit :: !Word32 , userRequestExample :: !(Maybe (Either User Guest)) } deriving (Generic, Eq, Show) - deriving anyclass (Elm) - -instance ToJSON UserRequest where toJSON = elmStreetToJson -instance FromJSON UserRequest where parseJSON = elmStreetParseJson + deriving (Elm, FromJSON, ToJSON) via ElmStreet UserRequest data MyUnit = MyUnit () deriving stock (Show, Eq, Ord, Generic) @@ -135,10 +127,7 @@ = Ok | Err Text deriving (Generic, Eq, Show) - deriving anyclass (Elm) - -instance ToJSON MyResult where toJSON = elmStreetToJson -instance FromJSON MyResult where parseJSON = elmStreetParseJson + deriving (Elm, FromJSON, ToJSON) via ElmStreet MyResult -- | All test types together in one type to play with. data OneType = OneType @@ -156,11 +145,31 @@ , oneTypeUserRequest :: !UserRequest , oneTypeNonEmpty :: !(NonEmpty MyUnit) } deriving (Generic, Eq, Show) - deriving anyclass (Elm) + deriving (Elm, FromJSON, ToJSON) via ElmStreet OneType -instance ToJSON OneType where toJSON = elmStreetToJson -instance FromJSON OneType where parseJSON = elmStreetParseJson +data CustomCodeGen = CustomCodeGen + { customCodeGenString :: String + , customCodeGenInt :: Int + } deriving stock (Generic, Eq, Show) + deriving (Elm, FromJSON, ToJSON) via CustomElm CustomCodeGen +-- Settings which do some custom modifications of record filed names +customCodeGenOptions :: CodeGenOptions +customCodeGenOptions = CodeGenOptions (Text.replace "CodeGen" "FunTest") + +-- Newtype whose Elm/ToJSON/FromJSON instance use custom CodeGenOptions +newtype CustomElm a = CustomElm {unCustomElm :: a} + +instance ElmStreetGenericConstraints a => Elm (CustomElm a) where + toElmDefinition _ = genericToElmDefinition customCodeGenOptions + $ Generic.from (error "Proxy for generic elm was evaluated" :: a) + +instance (Generic a, GToJSON Zero (Rep a)) => ToJSON (CustomElm a) where + toJSON = elmStreetToJsonWith customCodeGenOptions . unCustomElm + +instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomElm a) where + parseJSON = fmap CustomElm . elmStreetParseJsonWith customCodeGenOptions + -- | Type level list of all test types. type Types = '[ Prims @@ -176,6 +185,7 @@ , Guest , UserRequest , OneType + , CustomCodeGen ] @@ -233,3 +243,9 @@ , userRequestLimit = 123 , userRequestExample = Just (Right Blocked) } + +defaultCustomCodeGen :: CustomCodeGen +defaultCustomCodeGen = CustomCodeGen + { customCodeGenString = "Hello" + , customCodeGenInt = 78 + }