git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Derive Data.Generic.Rep.Generic (#2356)
fe6a709Phil Freeman
examples/failing/NonWildcardNewtypeInstance.purs+1−1
compare with golang
unifiedsplit
@@ -1,4 +1,4 @@
1−-- @shouldFailWith NonWildcardNewtypeInstance
1+-- @shouldFailWith ExpectedWildcard
2module NonWildcardNewtypeInstance where
2module NonWildcardNewtypeInstance where
3
3
4import Data.Newtype
4import Data.Newtype
examples/passing/GHCGenerics.pursdeleted−140
@@ -1,140 +0,0 @@
1−-- An example to show how we could implement GHC-style Generics using
2−-- functional dependencies.
3−--
4−-- See https://hackage.haskell.org/package/base-4.9.0.0/docs/GHC-Generics.html
5−
6−module Main where
7−
8−import Prelude
9−import Control.Monad.Eff (Eff)
10−import Control.Monad.Eff.Console (CONSOLE, log, logShow)
11−
12−-- Representation for types with no constructors
13−data V1
14−
15−-- Representation for constructors with no arguments
16−data U1 = U1
17−
18−-- Representation for sum types
19−data Sum a b = Inl a | Inr b
20−
21−infixr 5 type Sum as +
22−
23−-- Representation for product types
24−data Product a b = Product a b
25−
26−infixr 6 type Product as *
27−
28−-- Representation for data constructors, with the data constructor name indicated
29−-- at the type level.
30−data Ctor (name :: Symbol) a = Ctor a
31−
32−-- Representation for occurrences of other types in a data type definition.
33−data K a = K a
34−
35−-- The Generic class asserts the existence of a type function from "real" types
36−-- to representation types, and an isomorphism between them.
37−class Generic a repr | a -> repr where
38− to :: a -> repr
39− from :: repr -> a
40−
41−-- We can write an instance for the (recursive) type of lists. Note that these
42−-- instances would be generated by the compiler ideally.
43−data List a = Nil | Cons a (List a)
44−
45−instance genericList :: Generic (List a) (Ctor "Nil" U1 + Ctor "Cons" (K a * K (List a))) where
46− to Nil = Inl (Ctor U1)
47− to (Cons x xs) = Inr (Ctor (Product (K x) (K xs)))
48− from (Inl (Ctor U1)) = Nil
49− from (Inr (Ctor (Product (K x) (K xs)))) = Cons x xs
50−
51−-- We'd like to refect type level strings (for data constructor names) at the value
52−-- level, so that we can "show" them. Again, these instances would ideally be derived
53−-- for us.
54−class KnownSymbol (sym :: Symbol) where
55− symbol :: forall proxy. proxy sym -> String
56−
57−instance knownSymbolNil :: KnownSymbol "Nil" where
58− symbol _ = "Nil"
59−
60−instance knownSymbolCons :: KnownSymbol "Cons" where
61− symbol _ = "Cons"
62−
63−-- A proxy for a type-level string.
64−data SProxy (sym :: Symbol) = SProxy
65−
66−-- To write generic functions, we create a corresponding type class, and use the
67−-- type class machinery to infer the correct function based on the representation
68−-- type.
69−class GShow a where
70− gShow :: a -> String
71−
72−-- Now provide instances for GShow for the appropriate representation types.
73−-- Note: we don't have to implement all instances here.
74−
75−instance gShowU1 :: GShow U1 where
76− gShow _ = ""
77−
78−instance gShowSum :: (GShow a, GShow b) => GShow (a + b) where
79− gShow (Inl a) = gShow a
80− gShow (Inr b) = gShow b
81−
82−instance gShowProduct :: (GShow a, GShow b) => GShow (a * b) where
83− gShow (Product a b) = gShow a <> gShow b
84−
85−instance gShowCtor :: (KnownSymbol ctor, GShow a) => GShow (Ctor ctor a) where
86− gShow (Ctor a) = "(" <> symbol (SProxy :: SProxy ctor) <> gShow a <> ")"
87−
88−instance gShowK :: Show a => GShow (K a) where
89− gShow (K a) = " " <> show a
90−
91−-- Now we can implement a generic show function which uses the GShow instance
92−-- on the representation type.
93−genericShow :: forall a repr. (Generic a repr, GShow repr) => a -> String
94−genericShow x = gShow (to x)
95−
96−-- Note how the required instance here is Show a, and not Generic a.
97−-- This allows us to use generic programming on a wider variety of types
98−-- (including types which contain foreign types) than we can use now.
99−instance showList :: Show a => Show (List a) where
100− show xs = genericShow xs -- (we need to eta expand here to avoid stack overflow
101− -- due to recursion implicit in the instance lookup)
102−
103−-- Another example: Eq
104−
105−class GEq a where
106− gEq :: a -> a -> Boolean
107−
108−instance gEqU1 :: GEq U1 where
109− gEq _ _ = true
110−
111−instance gEqSum :: (GEq a, GEq b) => GEq (a + b) where
112− gEq (Inl a1) (Inl a2) = gEq a1 a2
113− gEq (Inr b1) (Inr b2) = gEq b1 b2
114− gEq _ _ = false
115−
116−instance gEqProduct :: (GEq a, GEq b) => GEq (a * b) where
117− gEq (Product a1 b1) (Product a2 b2) = gEq a1 a2 && gEq b1 b2
118−
119−instance gEqCtor :: (KnownSymbol ctor, GEq a) => GEq (Ctor ctor a) where
120− gEq (Ctor a1) (Ctor a2) = gEq a1 a2
121−
122−instance gEqK :: Eq a => GEq (K a) where
123− gEq (K a1) (K a2) = a1 == a2
124−
125−genericEq :: forall a repr. (Generic a repr, GEq repr) => a -> a -> Boolean
126−genericEq x y = gEq (to x) (to y)
127−
128−instance eqList :: Eq a => Eq (List a) where
129− eq xs ys = genericEq xs ys
130−
131−main :: Eff (console :: CONSOLE) Unit
132−main = do
133− logShow (Cons 1 Nil)
134− logShow (Cons 1 (Cons 2 Nil))
135− logShow (Cons 'x' (Cons 'y' (Cons 'z' Nil)))
136−
137− logShow (Cons 1 (Cons 2 Nil) == Cons 1 (Cons 2 Nil))
138− logShow (Cons 1 (Cons 2 Nil) == Cons 1 Nil)
139−
140− log "Done"
examples/passing/GenericsRep.pursnew file+53
@@ -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+1−1
@@ -133,7 +133,7 @@ data SimpleErrorMessage
133 | DeprecatedRequirePath
133 | DeprecatedRequirePath
134 | CannotGeneralizeRecursiveFunction Ident Type
134 | CannotGeneralizeRecursiveFunction Ident Type
135 | CannotDeriveNewtypeForData (ProperName 'TypeName)
135 | CannotDeriveNewtypeForData (ProperName 'TypeName)
136− | NonWildcardNewtypeInstance (ProperName 'TypeName)
136+ | ExpectedWildcard (ProperName 'TypeName)
137 deriving (Show)
137 deriving (Show)
138
138
139-- | Error message hints, providing more detailed information about failure.
139-- | Error message hints, providing more detailed information about failure.
src/Language/PureScript/Errors.hs+3−3
@@ -168,7 +168,7 @@ errorCode em = case unwrapErrorMessage em of
168 DeprecatedRequirePath{} -> "DeprecatedRequirePath"
168 DeprecatedRequirePath{} -> "DeprecatedRequirePath"
169 CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"
169 CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"
170 CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"
170 CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"
171− NonWildcardNewtypeInstance{} -> "NonWildcardNewtypeInstance"
171+ ExpectedWildcard{} -> "ExpectedWildcard"
172
172
173-- |
173-- |
174-- A stack trace for an error
174-- A stack trace for an error
@@ -865,8 +865,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
865 paras [ line $ "Cannot derive an instance of the " ++ markCode "Newtype" ++ " class for non-newtype " ++ markCode (runProperName tyName) ++ "."
865 paras [ line $ "Cannot derive an instance of the " ++ markCode "Newtype" ++ " class for non-newtype " ++ markCode (runProperName tyName) ++ "."
866 ]
866 ]
867
867
868− renderSimpleErrorMessage (NonWildcardNewtypeInstance tyName) =
868+ renderSimpleErrorMessage (ExpectedWildcard tyName) =
869− paras [ line $ "A type wildcard (_) should be used for the inner type when deriving the " ++ markCode "Newtype" ++ " instance for " ++ markCode (runProperName tyName) ++ "."
869+ paras [ line $ "Expected a type wildcard (_) when deriving an instance for " ++ markCode (runProperName tyName) ++ "."
870 ]
870 ]
871
871
872 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
872 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+194−11
@@ -13,7 +13,7 @@ import Control.Monad (replicateM)
13import Control.Monad.Error.Class (MonadError(..))
13import Control.Monad.Error.Class (MonadError(..))
14import Control.Monad.Supply.Class (MonadSupply)
14import Control.Monad.Supply.Class (MonadSupply)
15
15
16−import Data.List (foldl', find, sortBy)
16+import Data.List (foldl', find, sortBy, unzip5)
17import Data.Maybe (fromMaybe)
17import Data.Maybe (fromMaybe)
18import Data.Ord (comparing)
18import Data.Ord (comparing)
19
19
@@ -58,9 +58,14 @@ deriveInstance mn ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwr
58 | className == Qualified (Just dataNewtype) (ProperName "Newtype")
58 | className == Qualified (Just dataNewtype) (ProperName "Newtype")
59 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy
59 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy
60 , mn == fromMaybe mn mn'
60 , mn == fromMaybe mn mn'
61− = do
62− (inst, actualUnwrappedTy) <- deriveNewtype mn ds tyCon args unwrappedTy
61+ = do (inst, actualUnwrappedTy) <- deriveNewtype mn ds tyCon args unwrappedTy
63− return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)
62+ return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)
63+deriveInstance mn ds (TypeInstanceDeclaration nm deps className [actualTy, repTy] DerivedInstance)
64+ | className == Qualified (Just dataGenericRep) (ProperName C.generic)
65+ , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy
66+ , mn == fromMaybe mn mn'
67+ = do (inst, inferredRepTy) <- deriveGenericRep mn ds tyCon args repTy
68+ return $ TypeInstanceDeclaration nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)
64deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)
69deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)
65 = throwError . errorMessage $ CannotDerive className tys
70 = throwError . errorMessage $ CannotDerive className tys
66deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@(_ : _) NewtypeInstance)
71deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@(_ : _) NewtypeInstance)
@@ -122,6 +127,9 @@ deriveNewtypeInstance className ds tys tyConNm dargs = do
122dataGeneric :: ModuleName
127dataGeneric :: ModuleName
123dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
128dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
124
129
130+dataGenericRep :: ModuleName
131+dataGenericRep = ModuleName [ ProperName "Data", ProperName "Generic", ProperName "Rep" ]
132+
125dataMaybe :: ModuleName
133dataMaybe :: ModuleName
126dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]
134dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]
127
135
@@ -304,6 +312,187 @@ deriveGeneric mn ds tyConNm dargs = do
304 mkGenVar :: Ident -> Expr
312 mkGenVar :: Ident -> Expr
305 mkGenVar = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic]))
313 mkGenVar = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic]))
306
314
315+deriveGenericRep
316+ :: forall m
317+ . (MonadError MultipleErrors m, MonadSupply m)
318+ => ModuleName
319+ -> [Declaration]
320+ -> ProperName 'TypeName
321+ -> [Type]
322+ -> Type
323+ -> m ([Declaration], Type)
324+deriveGenericRep mn ds tyConNm tyConArgs repTy = do
325+ checkIsWildcard tyConNm repTy
326+ go =<< findTypeDecl tyConNm ds
327+ where
328+ go :: Declaration -> m ([Declaration], Type)
329+ go (DataDeclaration _ _ args dctors) = do
330+ x <- freshIdent "x"
331+ (reps, to, from) <- unzip3 <$> traverse makeInst dctors
332+ let rep = toRepTy reps
333+ inst | null reps =
334+ -- If there are no cases, spin
335+ [ ValueDeclaration (Ident "to") Public [] $ Right $
336+ lamCase x [ CaseAlternative [NullBinder]
337+ (Right (App toName (Var (Qualified Nothing x))))
338+ ]
339+ , ValueDeclaration (Ident "from") Public [] $ Right $
340+ lamCase x [ CaseAlternative [NullBinder]
341+ (Right (App fromName (Var (Qualified Nothing x))))
342+ ]
343+ ]
344+ | otherwise =
345+ [ ValueDeclaration (Ident "to") Public [] $ Right $
346+ lamCase x (zipWith ($) (map underBinder (sumBinders (length dctors))) to)
347+ , ValueDeclaration (Ident "from") Public [] $ Right $
348+ lamCase x (zipWith ($) (map underExpr (sumExprs (length dctors))) from)
349+ ]
350+
351+ subst = zipWith ((,) . fst) args tyConArgs
352+ return (inst, replaceAllTypeVars subst rep)
353+ go (PositionedDeclaration _ _ d) = go d
354+ go _ = internalError "deriveGenericRep go: expected DataDeclaration"
355+
356+ select :: (a -> a) -> (a -> a) -> Int -> [a -> a]
357+ select _ _ 0 = []
358+ select _ _ 1 = [id]
359+ select l r n = take (n - 1) (iterate (r .) l) ++ [compN (n - 1) r]
360+
361+ sumBinders :: Int -> [Binder -> Binder]
362+ sumBinders = select (ConstructorBinder inl . pure) (ConstructorBinder inr . pure)
363+
364+ sumExprs :: Int -> [Expr -> Expr]
365+ sumExprs = select (App (Constructor inl)) (App (Constructor inr))
366+
367+ compN :: Int -> (a -> a) -> a -> a
368+ compN 0 _ = id
369+ compN n f = f . compN (n - 1) f
370+
371+ makeInst
372+ :: (ProperName 'ConstructorName, [Type])
373+ -> m (Type, CaseAlternative, CaseAlternative)
374+ makeInst (ctorName, args) = do
375+ (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args
376+ return ( TypeApp (TypeApp (TypeConstructor constructor)
377+ (TypeLevelString (runProperName ctorName)))
378+ ctorTy
379+ , CaseAlternative [ ConstructorBinder constructor [matchProduct] ]
380+ (Right (foldl App (Constructor (Qualified (Just mn) ctorName)) ctorArgs))
381+ , CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) matchCtor ]
382+ (Right (constructor' mkProduct))
383+ )
384+
385+ makeProduct
386+ :: [Type]
387+ -> m (Type, Binder, [Expr], [Binder], Expr)
388+ makeProduct [] =
389+ pure (noArgs, NullBinder, [], [], noArgs')
390+ makeProduct args = do
391+ (tys, bs1, es1, bs2, es2) <- unzip5 <$> traverse makeArg args
392+ pure ( foldr1 (\f -> TypeApp (TypeApp (TypeConstructor productName) f)) tys
393+ , foldr1 (\b1 b2 -> ConstructorBinder productName [b1, b2]) bs1
394+ , es1
395+ , bs2
396+ , foldr1 (\e1 -> App (App (Constructor productName) e1)) es2
397+ )
398+
399+ makeArg :: Type -> m (Type, Binder, Expr, Binder, Expr)
400+ makeArg arg | Just rec <- objectType arg = do
401+ let fields = decomposeRec rec
402+ fieldNames <- traverse freshIdent (map fst fields)
403+ pure ( TypeApp (TypeConstructor record)
404+ (foldr1 (\f -> TypeApp (TypeApp (TypeConstructor productName) f))
405+ (map (\(name, ty) ->
406+ TypeApp (TypeApp (TypeConstructor field) (TypeLevelString name)) ty) fields))
407+ , ConstructorBinder record
408+ [ foldr1 (\b1 b2 -> ConstructorBinder productName [b1, b2])
409+ (map (\ident -> ConstructorBinder field [VarBinder ident]) fieldNames)
410+ ]
411+ , Literal . ObjectLiteral $
412+ zipWith (\(name, _) ident -> (name, Var (Qualified Nothing ident))) fields fieldNames
413+ , LiteralBinder . ObjectLiteral $
414+ zipWith (\(name, _) ident -> (name, VarBinder ident)) fields fieldNames
415+ , record' $
416+ foldr1 (\e1 -> App (App (Constructor productName) e1))
417+ (map (field' . Var . Qualified Nothing) fieldNames)
418+ )
419+ makeArg arg = do
420+ argName <- freshIdent "arg"
421+ pure ( TypeApp (TypeConstructor argument) arg
422+ , ConstructorBinder argument [ VarBinder argName ]
423+ , Var (Qualified Nothing argName)
424+ , VarBinder argName
425+ , argument' (Var (Qualified Nothing argName))
426+ )
427+
428+ underBinder :: (Binder -> Binder) -> CaseAlternative -> CaseAlternative
429+ underBinder f (CaseAlternative bs e) = CaseAlternative (map f bs) e
430+
431+ underExpr :: (Expr -> Expr) -> CaseAlternative -> CaseAlternative
432+ underExpr f (CaseAlternative b (Right e)) = CaseAlternative b (Right (f e))
433+ underExpr _ _ = internalError "underExpr: expected Right"
434+
435+ toRepTy :: [Type] -> Type
436+ toRepTy [] = noCtors
437+ toRepTy [only] = only
438+ toRepTy ctors = foldr1 (\f -> TypeApp (TypeApp sumCtor f)) ctors
439+
440+ toName :: Expr
441+ toName = Var (Qualified (Just dataGenericRep) (Ident "to"))
442+
443+ fromName :: Expr
444+ fromName = Var (Qualified (Just dataGenericRep) (Ident "from"))
445+
446+ noCtors :: Type
447+ noCtors = TypeConstructor (Qualified (Just dataGenericRep) (ProperName "NoConstructors"))
448+
449+ noArgs :: Type
450+ noArgs = TypeConstructor (Qualified (Just dataGenericRep) (ProperName "NoArguments"))
451+
452+ noArgs' :: Expr
453+ noArgs' = Constructor (Qualified (Just dataGenericRep) (ProperName "NoArguments"))
454+
455+ sumCtor :: Type
456+ sumCtor = TypeConstructor (Qualified (Just dataGenericRep) (ProperName "Sum"))
457+
458+ inl :: Qualified (ProperName 'ConstructorName)
459+ inl = Qualified (Just dataGenericRep) (ProperName "Inl")
460+
461+ inr :: Qualified (ProperName 'ConstructorName)
462+ inr = Qualified (Just dataGenericRep) (ProperName "Inr")
463+
464+ productName :: Qualified (ProperName ty)
465+ productName = Qualified (Just dataGenericRep) (ProperName "Product")
466+
467+ constructor :: Qualified (ProperName ty)
468+ constructor = Qualified (Just dataGenericRep) (ProperName "Constructor")
469+
470+ constructor' :: Expr -> Expr
471+ constructor' = App (Constructor constructor)
472+
473+ argument :: Qualified (ProperName ty)
474+ argument = Qualified (Just dataGenericRep) (ProperName "Argument")
475+
476+ argument' :: Expr -> Expr
477+ argument' = App (Constructor argument)
478+
479+ record :: Qualified (ProperName ty)
480+ record = Qualified (Just dataGenericRep) (ProperName "Rec")
481+
482+ record' :: Expr -> Expr
483+ record' = App (Constructor record)
484+
485+ field :: Qualified (ProperName ty)
486+ field = Qualified (Just dataGenericRep) (ProperName "Field")
487+
488+ field' :: Expr -> Expr
489+ field' = App (Constructor field)
490+
491+checkIsWildcard :: MonadError MultipleErrors m => ProperName 'TypeName -> Type -> m ()
492+checkIsWildcard _ (TypeWildcard _) = return ()
493+checkIsWildcard tyConNm _ =
494+ throwError . errorMessage $ ExpectedWildcard tyConNm
495+
307deriveEq ::
496deriveEq ::
308 forall m. (MonadError MultipleErrors m, MonadSupply m)
497 forall m. (MonadError MultipleErrors m, MonadSupply m)
309 => ModuleName
498 => ModuleName
@@ -451,7 +640,7 @@ deriveNewtype
451 -> Type
640 -> Type
452 -> m ([Declaration], Type)
641 -> m ([Declaration], Type)
453deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do
642deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do
454− checkIsWildcard unwrappedTy
643+ checkIsWildcard tyConNm unwrappedTy
455 go =<< findTypeDecl tyConNm ds
644 go =<< findTypeDecl tyConNm ds
456 where
645 where
457 go :: Declaration -> m ([Declaration], Type)
646 go :: Declaration -> m ([Declaration], Type)
@@ -477,12 +666,6 @@ deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do
477 go (PositionedDeclaration _ _ d) = go d
666 go (PositionedDeclaration _ _ d) = go d
478 go _ = internalError "deriveNewtype go: expected DataDeclaration"
667 go _ = internalError "deriveNewtype go: expected DataDeclaration"
479
668
480− checkIsWildcard :: Type -> m ()
481− checkIsWildcard (TypeWildcard _) =
482− return ()
483− checkIsWildcard _ =
484− throwError . errorMessage $ NonWildcardNewtypeInstance tyConNm
485−
486findTypeDecl
669findTypeDecl
487 :: (MonadError MultipleErrors m)
670 :: (MonadError MultipleErrors m)
488 => ProperName 'TypeName
671 => ProperName 'TypeName
tests/TestUtils.hs+27−5
@@ -53,16 +53,24 @@ updateSupportCode = do
53--
53--
54supportModules :: [String]
54supportModules :: [String]
55supportModules =
55supportModules =
56+ [ "Control.Alt"
57+ , "Control.Alternative"
56− [ "Control.Applicative"
58+ , "Control.Applicative"
57 , "Control.Apply"
59 , "Control.Apply"
58 , "Control.Bind"
60 , "Control.Bind"
59 , "Control.Category"
61 , "Control.Category"
62+ , "Control.Comonad"
63+ , "Control.Extend"
64+ , "Control.Lazy"
65+ , "Control.Monad"
66+ , "Control.Monad.Eff"
60 , "Control.Monad.Eff.Class"
67 , "Control.Monad.Eff.Class"
61 , "Control.Monad.Eff.Console"
68 , "Control.Monad.Eff.Console"
62 , "Control.Monad.Eff.Unsafe"
69 , "Control.Monad.Eff.Unsafe"
63− , "Control.Monad.Eff"
64 , "Control.Monad.ST"
70 , "Control.Monad.ST"
65− , "Control.Monad"
71+ , "Control.MonadPlus"
72+ , "Control.MonadZero"
73+ , "Control.Plus"
66 , "Control.Semigroupoid"
74 , "Control.Semigroupoid"
67 , "Data.Boolean"
75 , "Data.Boolean"
68 , "Data.BooleanAlgebra"
76 , "Data.BooleanAlgebra"
@@ -71,14 +79,27 @@ supportModules =
71 , "Data.Eq"
79 , "Data.Eq"
72 , "Data.EuclideanRing"
80 , "Data.EuclideanRing"
73 , "Data.Field"
81 , "Data.Field"
74− , "Data.Function.Uncurried"
75 , "Data.Function"
82 , "Data.Function"
83+ , "Data.Function.Uncurried"
76 , "Data.Functor"
84 , "Data.Functor"
85+ , "Data.Functor.Invariant"
86+ , "Data.Generic.Rep"
87+ , "Data.Generic.Rep.Monoid"
88+ , "Data.Generic.Rep.Eq"
89+ , "Data.Generic.Rep.Ord"
90+ , "Data.Generic.Rep.Semigroup"
77 , "Data.HeytingAlgebra"
91 , "Data.HeytingAlgebra"
92+ , "Data.Monoid"
93+ , "Data.Monoid.Additive"
94+ , "Data.Monoid.Conj"
95+ , "Data.Monoid.Disj"
96+ , "Data.Monoid.Dual"
97+ , "Data.Monoid.Endo"
98+ , "Data.Monoid.Multiplicative"
78 , "Data.NaturalTransformation"
99 , "Data.NaturalTransformation"
79 , "Data.Newtype"
100 , "Data.Newtype"
80− , "Data.Ord.Unsafe"
81 , "Data.Ord"
101 , "Data.Ord"
102+ , "Data.Ord.Unsafe"
82 , "Data.Ordering"
103 , "Data.Ordering"
83 , "Data.Ring"
104 , "Data.Ring"
84 , "Data.Semigroup"
105 , "Data.Semigroup"
@@ -90,6 +111,7 @@ supportModules =
90 , "Partial.Unsafe"
111 , "Partial.Unsafe"
91 , "Prelude"
112 , "Prelude"
92 , "Test.Assert"
113 , "Test.Assert"
114+ , "Test.Main"
93 ]
115 ]
94
116
95pushd :: forall a. FilePath -> IO a -> IO a
117pushd :: forall a. FilePath -> IO a -> IO a
tests/support/bower.json+2−1
@@ -8,6 +8,7 @@
8 "purescript-prelude": "1.1.0",
8 "purescript-prelude": "1.1.0",
9 "purescript-st": "1.0.0-rc.1",
9 "purescript-st": "1.0.0-rc.1",
10 "purescript-partial": "1.1.2",
10 "purescript-partial": "1.1.2",
11− "purescript-newtype": "0.1.0"
11+ "purescript-newtype": "0.1.0",
12+ "purescript-generics-rep": "2.0.0"
12 }
13 }
13}
14}