1db4a4f · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Support deriving with type arguments

commit1db4a4f8c6ee082661e9621024eb2993fead1172 authorPhil Freeman <paf31@cantab.net> dateThu 13 Aug 2015, 10:36 (11 years ago) parent205508e

2 files changed+13−6

unifiedsplit

core-tests/tests/generic-deriving/Main.purs+6−4

@@ -4,10 +4,12 @@ import Prelude

55import Data.Generic

7−data A

7+data A a

88 = A Number String

99 | B Int

10− | C (Array A)

11− | D { a :: A }

10+ | C (Array (A a))

11+ | D { a :: a }

1212

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

4747-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,

4848-- elaborates that into an instance declaration via code generation.

4949deriveInstance :: (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)

5151 | className == Qualified (Just dataGeneric) (ProperName C.generic)

52− , Qualified mn' tyCon <- tyName

52+ , Just (Qualified mn' tyCon) <- unwrapTypeConstructor ty

5353 , mn == fromMaybe mn mn'

5454 = TypeInstanceDeclaration nm deps className tys . Just <$> deriveGeneric mn ds tyCon

5555deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys Nothing)

@@ -57,6 +57,11 @@ deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys Nothing)

5757deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d

5858deriveInstance _ _ e = return e

5959

60+unwrapTypeConstructor :: Type -> Maybe (Qualified ProperName)

61+unwrapTypeConstructor (TypeConstructor tyCon) = Just tyCon

62+unwrapTypeConstructor (TypeApp ty (TypeVar _)) = unwrapTypeConstructor ty

63+unwrapTypeConstructor _ = Nothing

64+

6065dataGeneric :: ModuleName

6166dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]

6267