git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1635 from purescript/deriving-fixes
9fc5b58Phil Freeman
core-tests/tests/generic-deriving/Main.purs+2−2
compare with golang
unifiedsplit
@@ -14,7 +14,7 @@ data A a
14 = A Number String
14 = A Number String
15 | B Int
15 | B Int
16 | C (Array (A a))
16 | C (Array (A a))
17− | D { a :: a }
17+ | D { "asgård" :: a }
18 | E Void
18 | E Void
19
19
20derive instance genericA :: (Generic b) => Generic (A b)
20derive instance genericA :: (Generic b) => Generic (A b)
@@ -24,4 +24,4 @@ newtype X b = X b
24derive instance genericX :: Generic (X String)
24derive instance genericX :: Generic (X String)
25
25
26main :: forall eff. Eff (console :: CONSOLE | eff) Unit
26main :: forall eff. Eff (console :: CONSOLE | eff) Unit
27−main = Control.Monad.Eff.Console.log (gShow (D { a: C [ A 1.0 "test", B 42, D { a: true } ] }))
27+main = Control.Monad.Eff.Console.log (gShow (D { "asgård": C [ A 1.0 "test", B 42, D { "asgård": true } ] }))
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+7−5
@@ -107,7 +107,7 @@ mkSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> mapM mkCtorCl
107 return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
107 return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
108 where
108 where
109 caseResult idents =
109 caseResult idents =
110− App (prodConstructor (StringLiteral . runProperName $ ctorName))
110+ App (prodConstructor (StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))
111 . ArrayLiteral
111 . ArrayLiteral
112 $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
112 $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
113
113
@@ -121,10 +121,12 @@ mkSpineFunction mn (PositionedDeclaration _ _ d) = mkSpineFunction mn d
121mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"
121mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"
122
122
123mkSignatureFunction :: ModuleName -> Declaration -> [Type] -> Expr
123mkSignatureFunction :: ModuleName -> Declaration -> [Type] -> Expr
124−mkSignatureFunction _ (DataDeclaration _ _ tyArgs args) classArgs = lamNull . mkSigProd $ map mkProdClause args
124+mkSignatureFunction mn (DataDeclaration _ name tyArgs args) classArgs = lamNull . mkSigProd $ map mkProdClause args
125 where
125 where
126 mkSigProd :: [Expr] -> Expr
126 mkSigProd :: [Expr] -> Expr
127− mkSigProd = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd"))) . ArrayLiteral
127+ mkSigProd = App (App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd")))
128+ (StringLiteral (showQualified runProperName (Qualified (Just mn) name)))
129+ ) . ArrayLiteral
128
130
129 mkSigRec :: [Expr] -> Expr
131 mkSigRec :: [Expr] -> Expr
130 mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral
132 mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral
@@ -133,7 +135,7 @@ mkSignatureFunction _ (DataDeclaration _ _ tyArgs args) classArgs = lamNull . mk
133 proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))
135 proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))
134
136
135 mkProdClause :: (ProperName, [Type]) -> Expr
137 mkProdClause :: (ProperName, [Type]) -> Expr
136− mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (runProperName ctorName))
138+ mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (showQualified runProperName (Qualified (Just mn) ctorName)))
137 , ("sigValues", ArrayLiteral . map (mkProductSignature . instantiate) $ tys)
139 , ("sigValues", ArrayLiteral . map (mkProductSignature . instantiate) $ tys)
138 ]
140 ]
139
141
@@ -168,7 +170,7 @@ mkFromSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch
168 mkAlternative :: (ProperName, [Type]) -> m CaseAlternative
170 mkAlternative :: (ProperName, [Type]) -> m CaseAlternative
169 mkAlternative (ctorName, tys) = do
171 mkAlternative (ctorName, tys) = do
170 idents <- replicateM (length tys) (fmap Ident freshName)
172 idents <- replicateM (length tys) (fmap Ident freshName)
171− return $ CaseAlternative [ prodBinder [ StringBinder (runProperName ctorName), ArrayBinder (map VarBinder idents)]]
173+ return $ CaseAlternative [ prodBinder [ StringBinder (showQualified runProperName (Qualified (Just mn) ctorName)), ArrayBinder (map VarBinder idents)]]
172 . Right
174 . Right
173 $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))
175 $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))
174 (zipWith fromSpineFun (map (Var . Qualified Nothing) idents) tys)
176 (zipWith fromSpineFun (map (Var . Qualified Nothing) idents) tys)