From b96c74712dcc407c4cd54c403e62af2bfede8190 Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 20:38:28 +0200 Subject: [PATCH 1/8] rename: DefAlias -> DefRecord; ElmAlias -> ElmRecord --- src/Elm/Ast.hs | 4 ++-- src/Elm/Print/Decoder.hs | 14 +++++++------- src/Elm/Print/Encoder.hs | 6 +++--- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Elm/Ast.hs b/src/Elm/Ast.hs index 451c43d..2074040 100644 --- a/src/Elm/Ast.hs +++ b/src/Elm/Ast.hs @@ -30,9 +30,9 @@ data ElmDefinition | DefPrim !ElmPrim deriving (Show) --- | AST for @record type alias@ in Elm. +-- | AST for @type alias@ in Elm. data ElmRecord = ElmRecord - { elmRecordName :: !Text -- ^ Name of the record + { elmRecordName :: !Text -- ^ Name of the alias , elmRecordFields :: !(NonEmpty ElmRecordField) -- ^ List of fields , elmRecordIsNewtype :: !Bool -- ^ 'True' if Haskell type is a @newtype@ } deriving (Show) diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index e7cb857..d3aad36 100644 --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -70,12 +70,12 @@ userDecoder = -} prettyShowDecoder :: ElmDefinition -> Text prettyShowDecoder def = showDoc $ case def of - DefRecord elmRecord -> recordDecoderDoc elmRecord + DefRecord elmRecord -> aliasDecoderDoc elmRecord DefType elmType -> typeDecoderDoc elmType DefPrim _ -> emptyDoc -recordDecoderDoc :: ElmRecord -> Doc ann -recordDecoderDoc ElmRecord{..} = +aliasDecoderDoc :: ElmRecord -> Doc ann +aliasDecoderDoc ElmRecord{..} = decoderDef elmRecordName [] <> line <> if elmRecordIsNewtype @@ -83,20 +83,20 @@ recordDecoderDoc ElmRecord{..} = else recordDecoder where newtypeDecoder :: Doc ann - newtypeDecoder = name <+> "D.map" <+> qualifiedRecordName + newtypeDecoder = name <+> "D.map" <+> qualifiedAliasName <+> wrapParens (typeRefDecoder $ elmRecordFieldType $ NE.head elmRecordFields) recordDecoder :: Doc ann recordDecoder = nest 4 $ vsep - $ (name <+> "D.succeed" <+> qualifiedRecordName) + $ (name <+> "D.succeed" <+> qualifiedAliasName) : map fieldDecode (toList elmRecordFields) name :: Doc ann name = decoderName elmRecordName <+> equals - qualifiedRecordName :: Doc ann - qualifiedRecordName = mkQualified elmRecordName + qualifiedAliasName :: Doc ann + qualifiedAliasName = mkQualified elmRecordName fieldDecode :: ElmRecordField -> Doc ann fieldDecode ElmRecordField{..} = case elmRecordFieldType of diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index de38e4d..a8adafb 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -41,7 +41,7 @@ TODO -} prettyShowEncoder :: ElmDefinition -> Text prettyShowEncoder def = showDoc $ case def of - DefRecord elmRecord -> recordEncoderDoc elmRecord + DefRecord elmRecord -> aliasEncoderDoc elmRecord DefType elmType -> typeEncoderDoc elmType DefPrim _ -> emptyDoc @@ -115,8 +115,8 @@ typeEncoderDoc t@ElmType{..} = vars = concatWith (surround " ") fields -recordEncoderDoc :: ElmRecord -> Doc ann -recordEncoderDoc ElmRecord{..} = +aliasEncoderDoc :: ElmRecord -> Doc ann +aliasEncoderDoc ElmRecord{..} = encoderDef elmRecordName [] <> line <> if elmRecordIsNewtype From 2bc061494d2410d9c102f7f5d4fbac36776857dd Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 20:52:57 +0200 Subject: [PATCH 2/8] rest of updates --- src/Elm/Ast.hs | 2 +- src/Elm/Print/Decoder.hs | 14 +++++++------- src/Elm/Print/Encoder.hs | 6 +++--- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Elm/Ast.hs b/src/Elm/Ast.hs index 2074040..c4245aa 100644 --- a/src/Elm/Ast.hs +++ b/src/Elm/Ast.hs @@ -30,7 +30,7 @@ data ElmDefinition | DefPrim !ElmPrim deriving (Show) --- | AST for @type alias@ in Elm. +-- | AST for @record type alias@ in Elm. data ElmRecord = ElmRecord { elmRecordName :: !Text -- ^ Name of the alias , elmRecordFields :: !(NonEmpty ElmRecordField) -- ^ List of fields diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index d3aad36..e7cb857 100644 --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -70,12 +70,12 @@ userDecoder = -} prettyShowDecoder :: ElmDefinition -> Text prettyShowDecoder def = showDoc $ case def of - DefRecord elmRecord -> aliasDecoderDoc elmRecord + DefRecord elmRecord -> recordDecoderDoc elmRecord DefType elmType -> typeDecoderDoc elmType DefPrim _ -> emptyDoc -aliasDecoderDoc :: ElmRecord -> Doc ann -aliasDecoderDoc ElmRecord{..} = +recordDecoderDoc :: ElmRecord -> Doc ann +recordDecoderDoc ElmRecord{..} = decoderDef elmRecordName [] <> line <> if elmRecordIsNewtype @@ -83,20 +83,20 @@ aliasDecoderDoc ElmRecord{..} = else recordDecoder where newtypeDecoder :: Doc ann - newtypeDecoder = name <+> "D.map" <+> qualifiedAliasName + newtypeDecoder = name <+> "D.map" <+> qualifiedRecordName <+> wrapParens (typeRefDecoder $ elmRecordFieldType $ NE.head elmRecordFields) recordDecoder :: Doc ann recordDecoder = nest 4 $ vsep - $ (name <+> "D.succeed" <+> qualifiedAliasName) + $ (name <+> "D.succeed" <+> qualifiedRecordName) : map fieldDecode (toList elmRecordFields) name :: Doc ann name = decoderName elmRecordName <+> equals - qualifiedAliasName :: Doc ann - qualifiedAliasName = mkQualified elmRecordName + qualifiedRecordName :: Doc ann + qualifiedRecordName = mkQualified elmRecordName fieldDecode :: ElmRecordField -> Doc ann fieldDecode ElmRecordField{..} = case elmRecordFieldType of diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index a8adafb..de38e4d 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -41,7 +41,7 @@ TODO -} prettyShowEncoder :: ElmDefinition -> Text prettyShowEncoder def = showDoc $ case def of - DefRecord elmRecord -> aliasEncoderDoc elmRecord + DefRecord elmRecord -> recordEncoderDoc elmRecord DefType elmType -> typeEncoderDoc elmType DefPrim _ -> emptyDoc @@ -115,8 +115,8 @@ typeEncoderDoc t@ElmType{..} = vars = concatWith (surround " ") fields -aliasEncoderDoc :: ElmRecord -> Doc ann -aliasEncoderDoc ElmRecord{..} = +recordEncoderDoc :: ElmRecord -> Doc ann +recordEncoderDoc ElmRecord{..} = encoderDef elmRecordName [] <> line <> if elmRecordIsNewtype From 66f0742c58f80c1be992f1be0d3d9819eeb30ccd Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 20:58:20 +0200 Subject: [PATCH 3/8] fix last place --- src/Elm/Ast.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Elm/Ast.hs b/src/Elm/Ast.hs index c4245aa..451c43d 100644 --- a/src/Elm/Ast.hs +++ b/src/Elm/Ast.hs @@ -32,7 +32,7 @@ data ElmDefinition -- | AST for @record type alias@ in Elm. data ElmRecord = ElmRecord - { elmRecordName :: !Text -- ^ Name of the alias + { elmRecordName :: !Text -- ^ Name of the record , elmRecordFields :: !(NonEmpty ElmRecordField) -- ^ List of fields , elmRecordIsNewtype :: !Bool -- ^ 'True' if Haskell type is a @newtype@ } deriving (Show) From ec0124a42a2c506ba3b55a2c101307710e10b773 Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 21:35:00 +0200 Subject: [PATCH 4/8] Allow empty list in record fields --- src/Elm/Ast.hs | 2 +- src/Elm/Generic.hs | 10 +++++++--- src/Elm/Print/Decoder.hs | 5 +++-- src/Elm/Print/Encoder.hs | 10 +++++----- src/Elm/Print/Types.hs | 12 +++++++----- 5 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/Elm/Ast.hs b/src/Elm/Ast.hs index 451c43d..d6f2ea8 100644 --- a/src/Elm/Ast.hs +++ b/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) diff --git a/src/Elm/Generic.hs b/src/Elm/Generic.hs index 72e6ffe..6f444fc 100644 --- a/src/Elm/Generic.hs +++ b/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 diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index e7cb857..a6c2e48 100644 --- a/src/Elm/Print/Decoder.hs +++ b/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 @@ -84,13 +85,13 @@ recordDecoderDoc ElmRecord{..} = where newtypeDecoder :: Doc ann newtypeDecoder = name <+> "D.map" <+> qualifiedRecordName - <+> wrapParens (typeRefDecoder $ elmRecordFieldType $ NE.head elmRecordFields) + <+> wrapParens (Maybe.fromMaybe "ERROR" $ typeRefDecoder <$> elmRecordFieldType <$> Maybe.listToMaybe elmRecordFields) 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 diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index de38e4d..a56d36b 100644 --- a/src/Elm/Print/Encoder.hs +++ b/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 @@ -124,7 +124,7 @@ recordEncoderDoc ElmRecord{..} = else recordEncoder where newtypeEncoder :: Doc ann - newtypeEncoder = leftPart <+> fieldEncoderDoc (NE.head elmRecordFields) + newtypeEncoder = leftPart <+> Maybe.fromMaybe "ERROR" (fieldEncoderDoc <$> (Maybe.listToMaybe elmRecordFields)) recordEncoder :: Doc ann recordEncoder = nest 4 @@ -135,10 +135,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 diff --git a/src/Elm/Print/Types.hs b/src/Elm/Print/Types.hs index 6c1d854..6c65b1e 100644 --- a/src/Elm/Print/Types.hs +++ b/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{..} = From b5c9c9470001d16a71b9d84ab552a3edd3765d45 Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 22:04:20 +0200 Subject: [PATCH 5/8] Support empty records on elm side --- frontend/src/Core/Decoder.elm | 4 ++++ frontend/src/Core/Encoder.elm | 4 ++++ frontend/src/Core/Types.elm | 4 ++++ frontend/tests/Tests.elm | 1 + frontend/tests/Tests/Golden.elm | 3 ++- src/Elm/Print/Decoder.hs | 10 ++++++++-- src/Elm/Print/Encoder.hs | 7 +++++-- test/golden/oneType.json | 5 +++-- types/Types.hs | 26 +++++++++++++++++++++----- 9 files changed, 52 insertions(+), 12 deletions(-) diff --git a/frontend/src/Core/Decoder.elm b/frontend/src/Core/Decoder.elm index 828db7d..04fe71b 100644 --- a/frontend/src/Core/Decoder.elm +++ b/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 = succeed {} diff --git a/frontend/src/Core/Encoder.elm b/frontend/src/Core/Encoder.elm index 78a161f..11bfe8d 100644 --- a/frontend/src/Core/Encoder.elm +++ b/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) [] diff --git a/frontend/src/Core/Types.elm b/frontend/src/Core/Types.elm index 322805d..225db8f 100644 --- a/frontend/src/Core/Types.elm +++ b/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 = + { } diff --git a/frontend/tests/Tests.elm b/frontend/tests/Tests.elm index bd1dcfa..17e1f59 100644 --- a/frontend/tests/Tests.elm +++ b/frontend/tests/Tests.elm @@ -79,4 +79,5 @@ defaultOneType = , example = Just (R.Ok Blocked) } , nonEmpty = (MyUnit (), [MyUnit ()]) + , recordUnit = {} } diff --git a/frontend/tests/Tests/Golden.elm b/frontend/tests/Tests/Golden.elm index 553919a..6506fb9 100644 --- a/frontend/tests/Tests/Golden.elm +++ b/frontend/tests/Tests/Golden.elm @@ -103,6 +103,7 @@ goldenOneTypeJson = "tag": "MyUnit", "contents": [] } - ] + ], + "recordUnit": [] } """ diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index a6c2e48..69f0769 100644 --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -84,8 +84,14 @@ recordDecoderDoc ElmRecord{..} = else recordDecoder where newtypeDecoder :: Doc ann - newtypeDecoder = name <+> "D.map" <+> qualifiedRecordName - <+> wrapParens (Maybe.fromMaybe "ERROR" $ typeRefDecoder <$> elmRecordFieldType <$> Maybe.listToMaybe elmRecordFields) + newtypeDecoder = name <+> + case typeRefDecoder <$> elmRecordFieldType <$> Maybe.listToMaybe elmRecordFields of + Just field -> + "D.map" <+> qualifiedRecordName + <+> wrapParens field + Nothing -> + "succeed {}" + recordDecoder :: Doc ann recordDecoder = nest 4 diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index a56d36b..19ba5bb 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -69,7 +69,7 @@ typeEncoderDoc t@ElmType{..} = where fieldEncoderDoc :: Doc ann fieldEncoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of - [] -> "ERROR" + [] -> "{}" f : _ -> wrapParens (typeRefEncoder f) sumEncoder :: Doc ann @@ -124,7 +124,10 @@ recordEncoderDoc ElmRecord{..} = else recordEncoder where newtypeEncoder :: Doc ann - newtypeEncoder = leftPart <+> Maybe.fromMaybe "ERROR" (fieldEncoderDoc <$> (Maybe.listToMaybe elmRecordFields)) + newtypeEncoder = leftPart <+> + case fieldEncoderDoc <$> (Maybe.listToMaybe elmRecordFields) of + Just rightPart -> rightPart + Nothing -> "list (\\_ -> null) []" recordEncoder :: Doc ann recordEncoder = nest 4 diff --git a/test/golden/oneType.json b/test/golden/oneType.json index c031c7f..419f816 100644 --- a/test/golden/oneType.json +++ b/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": [] } diff --git a/types/Types.hs b/types/Types.hs index 2572ac0..8b8bc1e 100644 --- a/types/Types.hs +++ b/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 = True + } + + -- | 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 From 48d953663f946ffe7300a3186639191ebe912c9d Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 22:23:16 +0200 Subject: [PATCH 6/8] improve implementation --- frontend/src/Core/Decoder.elm | 2 +- src/Elm/Print/Decoder.hs | 19 +++++++++++++------ src/Elm/Print/Encoder.hs | 23 +++++++++++++++++------ types/Types.hs | 2 +- 4 files changed, 32 insertions(+), 14 deletions(-) diff --git a/frontend/src/Core/Decoder.elm b/frontend/src/Core/Decoder.elm index 04fe71b..94f183e 100644 --- a/frontend/src/Core/Decoder.elm +++ b/frontend/src/Core/Decoder.elm @@ -102,4 +102,4 @@ decodeOneType = D.succeed T.OneType |> required "recordUnit" decodeRecordUnit decodeRecordUnit : Decoder T.RecordUnit -decodeRecordUnit = succeed {} +decodeRecordUnit = D.succeed {} diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index 69f0769..c6cf921 100644 --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -79,19 +79,26 @@ 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 <+> + newtypeDecoder = case typeRefDecoder <$> elmRecordFieldType <$> Maybe.listToMaybe elmRecordFields of Just field -> - "D.map" <+> qualifiedRecordName + name <+> "D.map" <+> qualifiedRecordName <+> wrapParens field - Nothing -> - "succeed {}" - + Nothing -> emptyRecordDecoder recordDecoder :: Doc ann recordDecoder = nest 4 diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index 19ba5bb..78637c5 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -119,15 +119,26 @@ 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 <+> + newtypeEncoder = case fieldEncoderDoc <$> (Maybe.listToMaybe elmRecordFields) of - Just rightPart -> rightPart - Nothing -> "list (\\_ -> null) []" + Just rightPart -> leftPart <+> rightPart + Nothing -> emptyRecordEncoder + + emptyRecordEncoder :: Doc ann + emptyRecordEncoder = + leftPart <+> "list (\\_ -> null) []" recordEncoder :: Doc ann recordEncoder = nest 4 diff --git a/types/Types.hs b/types/Types.hs index 8b8bc1e..5d25fa3 100644 --- a/types/Types.hs +++ b/types/Types.hs @@ -165,7 +165,7 @@ instance Elm RecordUnit where toElmDefinition _ = DefRecord $ ElmRecord { elmRecordName = "RecordUnit" , elmRecordFields = [] - , elmRecordIsNewtype = True + , elmRecordIsNewtype = False } From 337c4e966b490f9fca5c52b20de8bd7e94d7670c Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 22:25:33 +0200 Subject: [PATCH 7/8] Update src/Elm/Print/Encoder.hs --- src/Elm/Print/Encoder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index 78637c5..8f46432 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -69,7 +69,7 @@ typeEncoderDoc t@ElmType{..} = where fieldEncoderDoc :: Doc ann fieldEncoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of - [] -> "{}" + [] -> "ERROR" f : _ -> wrapParens (typeRefEncoder f) sumEncoder :: Doc ann From a0695d385bb1d4e1e5b0477f32808be1603d9b23 Mon Sep 17 00:00:00 2001 From: Marek Fajkus Date: Thu, 23 Sep 2021 22:27:23 +0200 Subject: [PATCH 8/8] Apply suggestions from code review --- src/Elm/Print/Decoder.hs | 3 +-- src/Elm/Print/Encoder.hs | 6 ++---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index c6cf921..70d7799 100644 --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -86,8 +86,7 @@ recordDecoderDoc ElmRecord{..} = else recordDecoder where isEmptyRecord :: Bool - isEmptyRecord = - null elmRecordFields + isEmptyRecord = null elmRecordFields emptyRecordDecoder :: Doc ann emptyRecordDecoder = name <+> "D.succeed {}" diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index 8f46432..f15d74b 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -127,8 +127,7 @@ recordEncoderDoc ElmRecord{..} = else recordEncoder where isEmptyRecord :: Bool - isEmptyRecord = - null elmRecordFields + isEmptyRecord = null elmRecordFields newtypeEncoder :: Doc ann newtypeEncoder = @@ -137,8 +136,7 @@ recordEncoderDoc ElmRecord{..} = Nothing -> emptyRecordEncoder emptyRecordEncoder :: Doc ann - emptyRecordEncoder = - leftPart <+> "list (\\_ -> null) []" + emptyRecordEncoder = leftPart <+> "list (\\_ -> null) []" recordEncoder :: Doc ann recordEncoder = nest 4