Allow specifying custom code generation settings

CHANGELOG.md

@@ -6,6 +6,7 @@ The changelog is available [on GitHub][2].
 ## Unreleased
 
 * Add GHC 9.4.5 and 9.6.2 to CI / tested-with
+* Introduce CodeGenOptions that allow customizing how record field names are modified.
 
 ## 0.2.0.0 - Mar 29, 2022
 

README.md

@@ -9,9 +9,8 @@ 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
@@ -56,13 +55,13 @@ In order to use `elm-street` features, you need to perform the following steps:
    > **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
@@ -102,7 +101,7 @@ limitations, specifically:
        }
    ```
 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

frontend/src/Core/Decoder.elm

@@ -16,6 +16,7 @@ decodePrims = D.succeed T.Prims
     |> required "int" D.int
     |> required "float" D.float
     |> required "text" D.string
+    |> required "string" D.string
     |> required "time" Iso.decoder
     |> required "value" D.value
     |> required "maybe" (nullable D.int)
@@ -99,3 +100,8 @@ decodeOneType = D.succeed T.OneType
     |> required "guests" (D.list decodeGuest)
     |> required "userRequest" decodeUserRequest
     |> required "nonEmpty" (elmStreetDecodeNonEmpty decodeMyUnit)
+
+decodeCustomCodeGen : Decoder T.CustomCodeGen
+decodeCustomCodeGen = D.succeed T.CustomCodeGen
+    |> required "customFunTestString" D.string
+    |> required "customFunTestInt" D.int

frontend/src/Core/Encoder.elm

@@ -16,6 +16,7 @@ encodePrims x = E.object
     , ("int", E.int x.int)
     , ("float", E.float x.float)
     , ("text", E.string x.text)
+    , ("string", E.string x.string)
     , ("time", Iso.encode x.time)
     , ("value", Basics.identity x.value)
     , ("maybe", (elmStreetEncodeMaybe E.int) x.maybe)
@@ -94,3 +95,10 @@ encodeOneType x = E.object
     , ("userRequest", encodeUserRequest x.userRequest)
     , ("nonEmpty", (elmStreetEncodeNonEmpty encodeMyUnit) x.nonEmpty)
     ]
+
+encodeCustomCodeGen : T.CustomCodeGen -> Value
+encodeCustomCodeGen x = E.object
+    [ ("tag", E.string "CustomCodeGen")
+    , ("customFunTestString", E.string x.customFunTestString)
+    , ("customFunTestInt", E.int x.customFunTestInt)
+    ]

frontend/src/Core/Types.elm

@@ -11,6 +11,7 @@ type alias Prims =
     , int : Int
     , float : Float
     , text : String
+    , string : String
     , time : Posix
     , value : Value
     , maybe : Maybe Int
@@ -118,3 +119,8 @@ type alias OneType =
     , userRequest : UserRequest
     , nonEmpty : (MyUnit, List MyUnit)
     }
+
+type alias CustomCodeGen =
+    { customFunTestString : String
+    , customFunTestInt : Int
+    }

frontend/tests/Tests.elm

@@ -47,6 +47,7 @@ defaultOneType =
         , int      = 42
         , float    = 36.6
         , text     = "heh"
+        , string   = "bye"
         , value    = E.object
             [ ("nullField", E.null)
             , ("boolField", E.bool True)

frontend/tests/Tests/Golden.elm

@@ -36,7 +36,7 @@ goldenOneTypeJson =
             "bool": true,
             "unit": [],
             "nonEmpty": [1],
-            "value" : {
+            "value": {
                 "boolField": true,
                 "numberField": 1,
                 "stringField": "hi",
@@ -67,9 +67,9 @@ goldenOneTypeJson =
             "limit": 123
         },
         "age": 18,
-        "newtype":  666,
+        "newtype": 666,
         "newtypeList": [123],
-        "oneConstructor":  "OneConstructor",
+        "oneConstructor": "OneConstructor",
         "user": {
             "status": "Approved",
             "tag": "User",

src/Elm/Aeson.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
-
 {-# LANGUAGE AllowAmbiguousTypes  #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -10,7 +8,9 @@ comply to @elm-street@ rules regarding names.
 
 module Elm.Aeson
        ( elmStreetParseJson
+       , elmStreetParseJsonWith
        , elmStreetToJson
+       , elmStreetToJsonWith
        , elmStreetJsonOptions
 
        , ElmStreet (..)
@@ -20,39 +20,37 @@ import Data.Aeson (FromJSON (..), GFromJSON, GToJSON, Options (..), ToJSON (..),
                    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\"
 , \"age\": 42
 }
 @
 
-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 @@ it is decoded it the following way for each of the specified types:
 
 >>> 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,57 +86,59 @@ elmStreetParseJson
        (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@.
 
@@ -152,13 +152,8 @@ newtype ElmStreet a = ElmStreet
     { 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

src/Elm/Generate.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}