git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1635 from purescript/deriving-fixes

Update generic deriving for latest purescript-generics changes

commit9fc5b589a87fa65e867acc1be77935ad9b5eed98 authorPhil Freeman <paf31@cantab.net> dateTue 17 Nov 2015, 20:46 (11 years ago) parente047dfafc4090f
2 files changed+9−7
compare with golang
unifiedsplit
core-tests/tests/generic-deriving/Main.purs+2−2 src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+7−5
core-tests/tests/generic-deriving/Main.purs+2−2
@@ -14,7 +14,7 @@ data A a
1414 = A Number String
1515 | B Int
1616 | C (Array (A a))
17− | D { a :: a }
17+ | D { "asgård" :: a }
1818 | E Void
1919
2020derive instance genericA :: (Generic b) => Generic (A b)
@@ -24,4 +24,4 @@ newtype X b = X b
2424derive instance genericX :: Generic (X String)
2525
2626main :: 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
107107 return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
108108 where
109109 caseResult idents =
110− App (prodConstructor (StringLiteral . runProperName $ ctorName))
110+ App (prodConstructor (StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))
111111 . ArrayLiteral
112112 $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
113113
@@ -121,10 +121,12 @@ mkSpineFunction mn (PositionedDeclaration _ _ d) = mkSpineFunction mn d
121121mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"
122122
123123mkSignatureFunction :: 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
125125 where
126126 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
128130
129131 mkSigRec :: [Expr] -> Expr
130132 mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral
@@ -133,7 +135,7 @@ mkSignatureFunction _ (DataDeclaration _ _ tyArgs args) classArgs = lamNull . mk
133135 proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))
134136
135137 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)))
137139 , ("sigValues", ArrayLiteral . map (mkProductSignature . instantiate) $ tys)
138140 ]
139141
@@ -168,7 +170,7 @@ mkFromSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch
168170 mkAlternative :: (ProperName, [Type]) -> m CaseAlternative
169171 mkAlternative (ctorName, tys) = do
170172 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)]]
172174 . Right
173175 $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))
174176 (zipWith fromSpineFun (map (Var . Qualified Nothing) idents) tys)