Skip to content

Commit fe6a709

Browse files
paf31paf31
authored
Derive Data.Generic.Rep.Generic (purescript#2356)
* Derive Data.Generic.Rep.Generic * Remove redundant case * Refactor * Fix tests * More refactoring * Basic support for records * Generate fresh names for record fields * Allow multiple record fields * Fix tests
1 parent 0072f25 commit fe6a709

File tree

8 files changed

+281
-162
lines changed

8 files changed

+281
-162
lines changed

‎examples/failing/NonWildcardNewtypeInstance.purs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
-- @shouldFailWith NonWildcardNewtypeInstance
1+
-- @shouldFailWith ExpectedWildcard
22
module NonWildcardNewtypeInstance where
33

44
import Data.Newtype

‎examples/passing/GHCGenerics.purs‎

Lines changed: 0 additions & 140 deletions
This file was deleted.

‎examples/passing/GenericsRep.purs‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
module Main where
2+
3+
import Prelude
4+
import Control.Monad.Eff (Eff)
5+
import Control.Monad.Eff.Console (CONSOLE, log, logShow)
6+
import Data.Generic.Rep (class Generic)
7+
import Data.Generic.Rep.Eq (genericEq)
8+
9+
data X a = X a
10+
11+
derive instance genericX :: Generic (X a) _
12+
13+
instance eqX :: Eq a => Eq (X a) where
14+
eq xs ys = genericEq xs ys
15+
16+
data Y a = Y | Z a (Y a)
17+
18+
derive instance genericY :: Generic (Y a) _
19+
20+
instance eqY :: Eq a => Eq (Y a) where
21+
eq xs ys = genericEq xs ys
22+
23+
data Z
24+
25+
derive instance genericZ :: Generic Z _
26+
27+
instance eqZ :: Eq Z where
28+
eq x y = genericEq x y
29+
30+
newtype W = W { x :: Int, y :: String }
31+
32+
derive instance genericW :: Generic W _
33+
34+
instance eqW :: Eq W where
35+
eq x y = genericEq x y
36+
37+
data V = V { x :: Int } { x :: Int }
38+
39+
derive instance genericV :: Generic V _
40+
41+
instance eqV :: Eq V where
42+
eq x y = genericEq x y
43+
44+
main :: Eff (console :: CONSOLE) Unit
45+
main = do
46+
logShow (X 0 == X 1)
47+
logShow (X 1 == X 1)
48+
logShow (Z 1 Y == Z 1 Y)
49+
logShow (Z 1 Y == Y)
50+
logShow (Y == Y :: Y Z)
51+
logShow (W { x: 0, y: "A" } == W { x: 0, y: "A" })
52+
logShow (V { x: 0 } { x: 0 } == V { x: 0 } { x: 0 })
53+
log "Done"

‎src/Language/PureScript/AST/Declarations.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,7 @@ data SimpleErrorMessage
133133
| DeprecatedRequirePath
134134
| CannotGeneralizeRecursiveFunction Ident Type
135135
| CannotDeriveNewtypeForData (ProperName 'TypeName)
136-
| NonWildcardNewtypeInstance (ProperName 'TypeName)
136+
| ExpectedWildcard (ProperName 'TypeName)
137137
deriving (Show)
138138

139139
-- | Error message hints, providing more detailed information about failure.

‎src/Language/PureScript/Errors.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,7 @@ errorCode em = case unwrapErrorMessage em of
168168
DeprecatedRequirePath{} -> "DeprecatedRequirePath"
169169
CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"
170170
CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"
171-
NonWildcardNewtypeInstance{} -> "NonWildcardNewtypeInstance"
171+
ExpectedWildcard{} -> "ExpectedWildcard"
172172

173173
-- |
174174
-- A stack trace for an error
@@ -865,8 +865,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
865865
paras [ line $ "Cannot derive an instance of the " ++ markCode "Newtype" ++ " class for non-newtype " ++ markCode (runProperName tyName) ++ "."
866866
]
867867

868-
renderSimpleErrorMessage (NonWildcardNewtypeInstance tyName) =
869-
paras [ line $ "A type wildcard (_) should be used for the inner type when deriving the " ++ markCode "Newtype" ++ " instance for " ++ markCode (runProperName tyName) ++ "."
868+
renderSimpleErrorMessage (ExpectedWildcard tyName) =
869+
paras [ line $ "Expected a type wildcard (_) when deriving an instance for " ++ markCode (runProperName tyName) ++ "."
870870
]
871871

872872
renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

0 commit comments

Comments
 (0)