git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Support deriving with type arguments
1db4a4fPhil Freeman
core-tests/tests/generic-deriving/Main.purs+6−4
compare with golang
unifiedsplit
@@ -4,10 +4,12 @@ import Prelude
4
4
5import Data.Generic
5import Data.Generic
6
6
7−data A
7+data A a
8 = A Number String
8 = A Number String
9 | B Int
9 | B Int
10− | C (Array A)
10+ | C (Array (A a))
11− | D { a :: A }
11+ | D { a :: a }
12
12
13−derive instance genericA :: Generic A
13+derive instance genericA :: (Generic a) => Generic (A a)
14+
15+main = Control.Monad.Eff.Console.log (gShow (D { a: C [ A 1.0 "test", B 42, D { a: true } ] }))
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+7−2
@@ -47,9 +47,9 @@ deriveInstances (Module coms mn ds exts) = Module coms mn <$> mapM (deriveInstan
47-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,
47-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,
48-- elaborates that into an instance declaration via code generation.
48-- elaborates that into an instance declaration via code generation.
49deriveInstance :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> Declaration -> m Declaration
49deriveInstance :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> Declaration -> m Declaration
50−deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[TypeConstructor tyName] Nothing)
50+deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[ty] Nothing)
51 | className == Qualified (Just dataGeneric) (ProperName C.generic)
51 | className == Qualified (Just dataGeneric) (ProperName C.generic)
52− , Qualified mn' tyCon <- tyName
52+ , Just (Qualified mn' tyCon) <- unwrapTypeConstructor ty
53 , mn == fromMaybe mn mn'
53 , mn == fromMaybe mn mn'
54 = TypeInstanceDeclaration nm deps className tys . Just <$> deriveGeneric mn ds tyCon
54 = TypeInstanceDeclaration nm deps className tys . Just <$> deriveGeneric mn ds tyCon
55deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys Nothing)
55deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys Nothing)
@@ -57,6 +57,11 @@ deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys Nothing)
57deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d
57deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d
58deriveInstance _ _ e = return e
58deriveInstance _ _ e = return e
59
59
60+unwrapTypeConstructor :: Type -> Maybe (Qualified ProperName)
61+unwrapTypeConstructor (TypeConstructor tyCon) = Just tyCon
62+unwrapTypeConstructor (TypeApp ty (TypeVar _)) = unwrapTypeConstructor ty
63+unwrapTypeConstructor _ = Nothing
64+
60dataGeneric :: ModuleName
65dataGeneric :: ModuleName
61dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
66dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
62
67