Record fields list

frontend/src/Core/Decoder.elm

@@ -99,3 +99,7 @@ decodeOneType = D.succeed T.OneType
     |> required "guests" (D.list decodeGuest)
     |> required "userRequest" decodeUserRequest
     |> required "nonEmpty" (elmStreetDecodeNonEmpty decodeMyUnit)
+    |> required "recordUnit" decodeRecordUnit
+
+decodeRecordUnit : Decoder T.RecordUnit
+decodeRecordUnit = D.succeed {}

frontend/src/Core/Encoder.elm

@@ -93,4 +93,8 @@ encodeOneType x = E.object
     , ("guests", (E.list encodeGuest) x.guests)
     , ("userRequest", encodeUserRequest x.userRequest)
     , ("nonEmpty", (elmStreetEncodeNonEmpty encodeMyUnit) x.nonEmpty)
+    , ("recordUnit", encodeRecordUnit x.recordUnit)
     ]
+
+encodeRecordUnit : T.RecordUnit -> Value
+encodeRecordUnit x = list (\_ -> null) []

frontend/src/Core/Types.elm

@@ -117,4 +117,8 @@ type alias OneType =
     , guests : List Guest
     , userRequest : UserRequest
     , nonEmpty : (MyUnit, List MyUnit)
+    , recordUnit : RecordUnit
     }
+
+type alias RecordUnit =
+    { }

frontend/tests/Tests.elm

@@ -79,4 +79,5 @@ defaultOneType =
         , example = Just (R.Ok Blocked)
         }
     , nonEmpty = (MyUnit (), [MyUnit ()])
+    , recordUnit = {}
     }

frontend/tests/Tests/Golden.elm

@@ -103,6 +103,7 @@ goldenOneTypeJson =
                 "tag": "MyUnit",
                 "contents": []
             }
-        ]
+        ],
+        "recordUnit": []
     }
     """

src/Elm/Ast.hs

@@ -33,7 +33,7 @@ data ElmDefinition
 -- | AST for @record type alias@ in Elm.
 data ElmRecord = ElmRecord
     { elmRecordName      :: !Text  -- ^ Name of the record
-    , elmRecordFields    :: !(NonEmpty ElmRecordField)  -- ^ List of fields
+    , elmRecordFields    :: ![ElmRecordField]  -- ^ List of fields
     , elmRecordIsNewtype :: !Bool  -- ^ 'True' if Haskell type is a @newtype@
     } deriving (Show)
 

src/Elm/Generic.hs

@@ -163,7 +163,7 @@ __instance__ Elm (Id a) __where__
 elmNewtype :: forall a . Elm a => Text -> Text -> ElmDefinition
 elmNewtype typeName fieldName = DefRecord $ ElmRecord
     { elmRecordName      = typeName
-    , elmRecordFields    = ElmRecordField (elmRef @a) fieldName :| []
+    , elmRecordFields    = ElmRecordField (elmRef @a) fieldName : []
     , elmRecordIsNewtype = True
     }
 
@@ -213,10 +213,14 @@ data GenericConstructor = GenericConstructor
 2. All fields have names: record constructor.
 3. Not all fields have names: plain constructor.
 -}
-toElmConstructor :: GenericConstructor -> Either (NonEmpty ElmRecordField) ElmConstructor
+toElmConstructor :: GenericConstructor -> Either [ElmRecordField] ElmConstructor
 toElmConstructor GenericConstructor{..} = case genericConstructorFields of
+    -- Even though elm supports records with no field {} we don't ever derive these
+    -- Haskell records are in fact just type field accessors so there is ambiguity for zero fields constructors
+    -- Usually it makes more sense to derive Single constructor type for the Elm side so that's what we do
+    -- However it's possible to manually define instance of Elm class that would produce empty records (the other unit) type on Elm side
     []   -> Right $ ElmConstructor genericConstructorName []
-    f:fs -> case traverse toRecordField (f :| fs) of
+    f:fs -> case traverse toRecordField (f : fs) of
         Nothing     -> Right $ ElmConstructor genericConstructorName $ map fst genericConstructorFields
         Just fields -> Left fields
   where

src/Elm/Print/Decoder.hs

@@ -24,6 +24,7 @@ import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord
 import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens)
 
 import qualified Data.List.NonEmpty as NE
+import qualified Data.Maybe as Maybe
 import qualified Data.Text as T
 
 
@@ -78,19 +79,31 @@ recordDecoderDoc :: ElmRecord -> Doc ann
 recordDecoderDoc ElmRecord{..} =
     decoderDef elmRecordName []
     <> line
-    <> if elmRecordIsNewtype
+    <> if isEmptyRecord
+       then emptyRecordDecoder
+       else if elmRecordIsNewtype
        then newtypeDecoder
        else recordDecoder
   where
+    isEmptyRecord :: Bool
+    isEmptyRecord = null elmRecordFields
+
+    emptyRecordDecoder :: Doc ann
+    emptyRecordDecoder = name <+> "D.succeed {}"
+
     newtypeDecoder :: Doc ann
-    newtypeDecoder = name <+> "D.map" <+> qualifiedRecordName
-        <+> wrapParens (typeRefDecoder $ elmRecordFieldType $ NE.head elmRecordFields)
+    newtypeDecoder =
+        case typeRefDecoder <$> elmRecordFieldType <$> Maybe.listToMaybe elmRecordFields of
+          Just field ->
+                name <+> "D.map" <+> qualifiedRecordName
+                <+> wrapParens field
+          Nothing -> emptyRecordDecoder
 
     recordDecoder :: Doc ann
     recordDecoder = nest 4
         $ vsep
         $ (name <+> "D.succeed" <+> qualifiedRecordName)
-        : map fieldDecode (toList elmRecordFields)
+        : map fieldDecode elmRecordFields
 
     name :: Doc ann
     name = decoderName elmRecordName <+> equals

src/Elm/Print/Encoder.hs

@@ -13,7 +13,6 @@ module Elm.Print.Encoder
        , encodeNonEmpty
        ) where
 
-import Data.List.NonEmpty (NonEmpty, toList)
 import Data.Text (Text)
 import Data.Text.Prettyprint.Doc (Doc, brackets, colon, comma, concatWith, dquotes, emptyDoc,
                                   equals, lbracket, line, nest, parens, pretty, rbracket, surround,
@@ -24,6 +23,7 @@ import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord
 import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens)
 
 import qualified Data.List.NonEmpty as NE
+import qualified Data.Maybe as Maybe
 import qualified Data.Text as T
 
 
@@ -76,7 +76,7 @@ typeEncoderDoc t@ElmType{..} =
     sumEncoder = nest 4
         $ vsep
         $ (name <+> "x" <+> equals <+> "E.object <| case x of")
-        : map mkCase (toList elmTypeConstructors)
+        : map mkCase (NE.toList elmTypeConstructors)
 
     -- | Encoder function name
     name :: Doc ann
@@ -119,12 +119,24 @@ recordEncoderDoc :: ElmRecord -> Doc ann
 recordEncoderDoc ElmRecord{..} =
     encoderDef elmRecordName []
     <> line
-    <> if elmRecordIsNewtype
-       then newtypeEncoder
-       else recordEncoder
+    <>
+       if isEmptyRecord
+       then emptyRecordEncoder
+       else if elmRecordIsNewtype
+            then newtypeEncoder
+            else recordEncoder
   where
+    isEmptyRecord :: Bool
+    isEmptyRecord = null elmRecordFields
+
     newtypeEncoder :: Doc ann
-    newtypeEncoder = leftPart <+> fieldEncoderDoc (NE.head elmRecordFields)
+    newtypeEncoder =
+        case fieldEncoderDoc <$> (Maybe.listToMaybe elmRecordFields) of
+          Just rightPart -> leftPart <+> rightPart
+          Nothing        -> emptyRecordEncoder
+
+    emptyRecordEncoder :: Doc ann
+    emptyRecordEncoder = leftPart <+> "list (\\_ -> null) []"
 
     recordEncoder :: Doc ann
     recordEncoder = nest 4
@@ -135,10 +147,10 @@ recordEncoderDoc ElmRecord{..} =
     leftPart :: Doc ann
     leftPart = encoderName elmRecordName <+> "x" <+> equals
 
-    fieldsEncode :: NonEmpty ElmRecordField -> [Doc ann]
+    fieldsEncode :: [ElmRecordField] -> [Doc ann]
     fieldsEncode fields =
         lbracket <+> mkTag elmRecordName
-      : map ((comma <+>) . recordFieldDoc) (NE.toList fields)
+      : map ((comma <+>) . recordFieldDoc) fields
      ++ [rbracket]
 
     recordFieldDoc :: ElmRecordField -> Doc ann

src/Elm/Print/Types.hs

@@ -133,11 +133,13 @@ elmRecordDoc ElmRecord{..} = nest 4 $
     vsep $ ("type alias" <+> pretty elmRecordName <+> equals)
          : fieldsDoc elmRecordFields
   where
-    fieldsDoc :: NonEmpty ElmRecordField -> [Doc ann]
-    fieldsDoc (fstR :| rest) =
-        lbrace <+> recordFieldDoc fstR
-      : map ((comma <+>) . recordFieldDoc) rest
-     ++ [rbrace]
+    fieldsDoc :: [ElmRecordField] -> [Doc ann]
+    fieldsDoc = \case
+                [] -> [lbrace <+> rbrace]
+                fstR : rest ->
+                    lbrace <+> recordFieldDoc fstR
+                    : map ((comma <+>) . recordFieldDoc) rest
+                    ++ [rbrace]
 
     recordFieldDoc :: ElmRecordField -> Doc ann
     recordFieldDoc ElmRecordField{..} =

test/golden/oneType.json

@@ -37,7 +37,7 @@
             "objectField": {},
             "arrayField": [1,2,3],
             "nullField": null
-        }        
+        }
     },
     "myUnit": {
         "tag": "MyUnit",
@@ -98,5 +98,6 @@
             "tag": "MyUnit",
             "contents": []
         }
-    ]
+    ],
+    "recordUnit": []
 }

types/Types.hs

@@ -27,13 +27,14 @@ module Types
        , UserRequest (..)
        ) where
 
-import Data.Aeson (FromJSON (..), ToJSON (..), Value(..), object, (.=))
-import Data.List.NonEmpty (NonEmpty(..))
+import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.=))
+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 Elm (Elm (..), ElmDefinition (..), ElmRecord (..), ElmStreet (..), elmNewtype,
+            elmStreetParseJson, elmStreetToJson)
 import GHC.Generics (Generic)
 
 
@@ -45,7 +46,7 @@ data Prims = Prims
     , primsFloat    :: !Double
     , primsText     :: !Text
     , primsTime     :: !UTCTime
-    , primsValue  :: !Value
+    , primsValue    :: !Value
     , primsMaybe    :: !(Maybe Word)
     , primsResult   :: !(Either Int Text)
     , primsPair     :: !(Char, Bool)
@@ -150,12 +151,24 @@ instance FromJSON MyUnit where parseJSON = elmStreetParseJson
 data MyResult
     = Ok
     | Err Text
-    deriving (Generic, Eq, Show)
+    deriving stock (Generic, Eq, Show)
     deriving anyclass (Elm)
 
 instance ToJSON   MyResult where toJSON = elmStreetToJson
 instance FromJSON MyResult where parseJSON = elmStreetParseJson
 
+data RecordUnit = RecordUnit
+    deriving stock (Generic, Eq, Show)
+    deriving anyclass (FromJSON, ToJSON)
+
+instance Elm RecordUnit where
+    toElmDefinition _ = DefRecord $ ElmRecord
+                            { elmRecordName = "RecordUnit"
+                            , elmRecordFields = []
+                            , elmRecordIsNewtype = False
+                            }
+
+
 -- | All test types together in one type to play with.
 data OneType = OneType
     { oneTypePrims          :: !Prims
@@ -171,6 +184,7 @@ data OneType = OneType
     , oneTypeGuests         :: ![Guest]
     , oneTypeUserRequest    :: !UserRequest
     , oneTypeNonEmpty       :: !(NonEmpty MyUnit)
+    , oneTypeRecordUnit     :: !RecordUnit
     } deriving (Generic, Eq, Show)
       deriving anyclass (Elm)
 
@@ -192,6 +206,7 @@ type Types =
     , Guest
     , UserRequest
     , OneType
+    , RecordUnit
     ]
 
 
@@ -210,6 +225,7 @@ defaultOneType = OneType
     , oneTypeGuests = [guestRegular, guestVisitor, guestBlocked]
     , oneTypeUserRequest = defaultUserRequest
     , oneTypeNonEmpty = MyUnit () :| [ MyUnit () ]
+    , oneTypeRecordUnit = RecordUnit
     }
   where
     defaultPrims :: Prims