[#66] Patch generated JSON encoders and decoders (#68)

Resolves #66

CHANGELOG.md

@@ -3,10 +3,16 @@
 `elm-street` uses [PVP Versioning][1].
 The changelog is available [on GitHub][2].
 
-0.0.0
-=====
+## Unreleased: 0.0.1
+
+* [#64](https://github.com/holmusk/elm-street/issues/64):
+  Fix indentation for the generated enums.
+* [#66](https://github.com/holmusk/elm-street/issues/66):
+  Patch JSON encoders and decoders for sum types with a single field.
+
+## 0.0.0
 
 * Initially created.
 
 [1]: https://pvp.haskell.org
-[2]: https://github.com/Holmusk/elm-street/releases
+[2]: https://github.com/Holmusk/elm-street/releases

README.md

@@ -182,7 +182,7 @@ data User = User
     { userName :: Text
     , userAge  :: Int
     } deriving (Generic)
-      deriving anyclass (Elm)
+      deriving (Elm, ToJSON, FromJSON) via ElmStreet User
 ```
 
 **Elm**
@@ -215,7 +215,7 @@ data RequestStatus
     | Rejected
     | Reviewing
     deriving (Generic)
-    deriving anyclass (Elm)
+    deriving (Elm, ToJSON, FromJSON) via ElmStreet RequestStatus
 ```
 
 **Elm**
@@ -257,6 +257,7 @@ decodeRequestStatus = elmStreetDecodeEnum readRequestStatus
 newtype Age = Age
     { unAge :: Int
     } deriving (Generic)
+      deriving newtype (FromJSON, ToJSON)
       deriving anyclass (Elm)
 ```
 
@@ -279,7 +280,10 @@ decodeAge = D.map Age D.int
 **Haskell**
 
 ```haskell
-newtype Id a = Id { unId :: Text }
+newtype Id a = Id
+    { unId :: Text
+    } deriving (Generic)
+      deriving newtype (FromJSON, ToJSON)
 
 instance Elm (Id a) where
     toElmDefinition _ = elmNewtype @Text "Id" "unId"
@@ -309,7 +313,7 @@ data Guest
     | Visitor Text
     | Blocked
     deriving (Generic)
-    deriving anyclass (Elm)
+    deriving (Elm, ToJSON, FromJSON) via ElmStreet Guest
 ```
 
 **Elm**
@@ -323,15 +327,15 @@ type Guest
 encodeGuest : Guest -> Value
 encodeGuest x = E.object <| case x of
     Regular x1 x2 -> [("tag", E.string "Regular"), ("contents", E.list identity [E.string x1, E.int x2])]
-    Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.list identity [E.string x1])]
+    Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.string x1)]
     Blocked  -> [("tag", E.string "Blocked"), ("contents", E.list identity [])]
 
 decodeGuest : Decoder Guest
 decodeGuest =
     let decide : String -> Decoder Guest
         decide x = case x of
             "Regular" -> D.field "contents" <| D.map2 Regular (D.index 0 D.string) (D.index 1 D.int)
-            "Visitor" -> D.field "contents" <| D.map Visitor (D.index 0 D.string)
+            "Visitor" -> D.field "contents" <| D.map Visitor D.string
             "Blocked" -> D.succeed Blocked
             c -> D.fail <| "Guest doesn't have such constructor: " ++ c
     in D.andThen decide (D.field "tag" D.string)

elm-street.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.0
 name:                elm-street
-version:             0.0.0
+version:             0.0.1
 synopsis:            Crossing the road between Haskell and Elm
 description:
     `Elm-street` allows you to generate automatically derived from Haskell types
@@ -128,8 +128,8 @@ executable run-backend
   other-modules:       Api
 
   build-depends:       base
-                     , servant >= 0.14 && < 0.16
-                     , servant-server >= 0.14 && < 0.16
+                     , servant >= 0.14 && < 0.17
+                     , servant-server >= 0.14 && < 0.17
                      , types
                      , wai ^>= 3.2
                      , warp ^>= 3.2

frontend/src/Core/Decoder.elm

@@ -43,7 +43,7 @@ decodeGuest =
     let decide : String -> Decoder Guest
         decide x = case x of
             "Regular" -> D.field "contents" <| D.map2 Regular (D.index 0 D.string) (D.index 1 D.int)
-            "Visitor" -> D.field "contents" <| D.map Visitor (D.index 0 D.string)
+            "Visitor" -> D.field "contents" <| D.map Visitor D.string
             "Blocked" -> D.succeed Blocked
             c -> D.fail <| "Guest doesn't have such constructor: " ++ c
     in D.andThen decide (D.field "tag" D.string)
@@ -61,5 +61,5 @@ decodeOneType = D.succeed OneType
     |> required "age" decodeAge
     |> required "requestStatus" decodeRequestStatus
     |> required "user" decodeUser
-    |> required "guest" decodeGuest
+    |> required "guests" (D.list decodeGuest)
     |> required "userRequest" decodeUserRequest

frontend/src/Core/Encoder.elm

@@ -42,7 +42,7 @@ encodeUser x = E.object
 encodeGuest : Guest -> Value
 encodeGuest x = E.object <| case x of
     Regular x1 x2 -> [("tag", E.string "Regular"), ("contents", E.list identity [E.string x1, E.int x2])]
-    Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.list identity [E.string x1])]
+    Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.string x1)]
     Blocked  -> [("tag", E.string "Blocked"), ("contents", E.list identity [])]
 
 encodeUserRequest : UserRequest -> Value
@@ -59,6 +59,6 @@ encodeOneType x = E.object
     , ("age", encodeAge x.age)
     , ("requestStatus", encodeRequestStatus x.requestStatus)
     , ("user", encodeUser x.user)
-    , ("guest", encodeGuest x.guest)
+    , ("guests", E.list encodeGuest x.guests)
     , ("userRequest", encodeUserRequest x.userRequest)
     ]

frontend/src/Core/Types.elm

@@ -70,6 +70,6 @@ type alias OneType =
     , age : Age
     , requestStatus : RequestStatus
     , user : User
-    , guest : Guest
+    , guests : List Guest
     , userRequest : UserRequest
     }

src/Elm/Print.hs

@@ -346,7 +346,13 @@ typeEncoderDoc t@ElmType{..} =
             map (pretty . mkText "x") [1..]
 
         contents :: Doc ann
-        contents = "," <+> parens (dquotes "contents" <> comma <+> "E.list identity" <+> brackets fieldEncs)
+        contents = "," <+> parens (dquotes "contents" <> comma <+> contentsEnc)
+
+        -- JSON encoder for the "contents" key
+        contentsEnc :: Doc ann
+        contentsEnc = case elmConstructorFields of
+            [_] -> fieldEncs
+            _   -> "E.list identity" <+> brackets fieldEncs
 
         -- | @encoderA x1@
         fieldEncs :: Doc ann
@@ -581,10 +587,10 @@ typeDecoderDoc  t@ElmType{..} =
 
     cases :: ElmConstructor -> Doc ann
     cases ElmConstructor{..} = dquotes cName <+> arrow <+>
-        case length elmConstructorFields of
-            0 -> "D.succeed" <+> cName
-            n -> "D.field \"contents\" <| D.map" <> mapNum n <+> cName <+> createIndexes
-
+        case elmConstructorFields of
+            []  -> "D.succeed" <+> cName
+            [f] -> "D.field \"contents\" <| D.map" <+> cName <+> typeRefDecoder f
+            l   -> "D.field \"contents\" <| D.map" <> mapNum (length l) <+> cName <+> createIndexes
       where
         cName :: Doc ann
         cName = pretty elmConstructorName

types/Types.hs

@@ -34,17 +34,17 @@ import GHC.Generics (Generic)
 
 
 data Prims = Prims
-    { primsUnit   :: ()
-    , primsBool   :: Bool
-    , primsChar   :: Char
-    , primsInt    :: Int
-    , primsFloat  :: Double
-    , primsString :: String
-    , primsTime   :: UTCTime
-    , primsMaybe  :: Maybe Word
-    , primsResult :: Either Int String
-    , primsPair   :: (Char, Bool)
-    , primsList   :: [Int]
+    { primsUnit   :: !()
+    , primsBool   :: !Bool
+    , primsChar   :: !Char
+    , primsInt    :: !Int
+    , primsFloat  :: !Double
+    , primsString :: !String
+    , primsTime   :: !UTCTime
+    , primsMaybe  :: !(Maybe Word)
+    , primsResult :: !(Either Int String)
+    , primsPair   :: !(Char, Bool)
+    , primsList   :: ![Int]
     } deriving (Generic, Eq, Show)
 #if ( __GLASGOW_HASKELL__ >= 806 )
       deriving (Elm, ToJSON, FromJSON) via ElmStreet Prims
@@ -77,10 +77,10 @@ data RequestStatus
     deriving anyclass (Elm, FromJSON, ToJSON)
 
 data User = User
-    { userId     :: Id User
-    , userName   :: Text
-    , userAge    :: Age
-    , userStatus :: RequestStatus
+    { userId     :: !(Id User)
+    , userName   :: !Text
+    , userAge    :: !Age
+    , userStatus :: !RequestStatus
     } deriving (Generic, Eq, Show)
       deriving anyclass (Elm)
 
@@ -95,9 +95,9 @@ data Guest
     deriving anyclass (Elm, FromJSON, ToJSON)
 
 data UserRequest = UserRequest
-    { userRequestIds     :: [Id User]
-    , userRequestLimit   :: Word32
-    , userRequestExample :: Maybe (Either User Guest)
+    { userRequestIds     :: ![Id User]
+    , userRequestLimit   :: !Word32
+    , userRequestExample :: !(Maybe (Either User Guest))
     } deriving (Generic, Eq, Show)
       deriving anyclass (Elm)
 
@@ -106,13 +106,13 @@ instance FromJSON UserRequest where parseJSON = elmStreetParseJson
 
 -- | All test types together in one type to play with.
 data OneType = OneType
-    { oneTypePrims         :: Prims
-    , oneTypeId            :: Id OneType
-    , oneTypeAge           :: Age
-    , oneTypeRequestStatus :: RequestStatus
-    , oneTypeUser          :: User
-    , oneTypeGuest         :: Guest
-    , oneTypeUserRequest   :: UserRequest
+    { oneTypePrims         :: !Prims
+    , oneTypeId            :: !(Id OneType)
+    , oneTypeAge           :: !Age
+    , oneTypeRequestStatus :: !RequestStatus
+    , oneTypeUser          :: !User
+    , oneTypeGuests        :: ![Guest]
+    , oneTypeUserRequest   :: !UserRequest
     } deriving (Generic, Eq, Show)
       deriving anyclass (Elm)
 
@@ -139,7 +139,7 @@ defaultOneType = OneType
     , oneTypeAge = Age 18
     , oneTypeRequestStatus = Reviewing
     , oneTypeUser = User (Id "1") "not-me" (Age 100) Approved
-    , oneTypeGuest = Regular "nice" 7
+    , oneTypeGuests = [guestRegular, guestVisitor, guestBlocked]
     , oneTypeUserRequest = defaultUserRequest
     }
   where
@@ -158,6 +158,11 @@ defaultOneType = OneType
         , primsList   = [1..5]
         }
 
+    guestRegular, guestVisitor, guestBlocked :: Guest
+    guestRegular = Regular "nice" 7
+    guestVisitor = Visitor "new-guest"
+    guestBlocked = Blocked
+
     defaultUserRequest :: UserRequest
     defaultUserRequest = UserRequest
         { userRequestIds     = [Id "1", Id "2"]