@@ -13,7 +13,7 @@
1313--
1414-----------------------------------------------------------------------------
1515
16−{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings, PatternSynonyms #-}
16+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings, PatternGuards #-}
1717
1818module Language.PureScript.TypeChecker.Deriving (
1919 elaborateInstance
@@ -56,7 +56,7 @@ mkSpineFunction t = do
5656 where caseResult = App (prodConstructor (StringLiteral . runProperName . unQualify $ ctorName)) . ArrayLiteral $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) (argTypes typ)
5757
5858 toSpineFun :: Expr -> Type -> Expr
59− toSpineFun i (ObjectType rec) =
59+ toSpineFun i r | Just rec <- objectType r =
6060 lamNull . recordConstructor . ArrayLiteral .
6161 map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", toSpineFun (Accessor str i) typ)])
6262 $ decomposeRec rec
@@ -73,7 +73,7 @@ mkSignatureFunction t = do
7373
7474 mkProdClause (ctorName, (_,_,typ,_)) = ObjectLiteral [("sigConstructor",StringLiteral (runProperName . unQualify $ ctorName)),("sigValues", ArrayLiteral . map mkProductSignature . argTypes $ typ)]
7575
76− mkProductSignature (ObjectType rec) =
76+ mkProductSignature r | Just rec <- objectType r =
7777 lamNull . mkSigRec .
7878 map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", mkProductSignature typ)])
7979 $ decomposeRec rec
@@ -93,7 +93,7 @@ mkFromSpineFunction t = do
9393 CaseAlternative [ConstructorBinder (findName "SProd" ctors) [StringBinder ctorName, ArrayBinder (map VarBinder idents)]]
9494 . Right $ liftApplicative (mkJust $ Constructor ctor) (zipWith fromSpineFun (map (Var . (Qualified Nothing))idents) (argTypes typ))
9595
96− fromSpineFun e (ObjectType rec) = App (lamCase "r" [mkRecCase (decomposeRec rec), CaseAlternative [NullBinder] (Right mkNothing)]) (App e (mkPrelVar "unit"))
96+ fromSpineFun e r | Just rec <- objectType r = App (lamCase "r" [mkRecCase (decomposeRec rec), CaseAlternative [NullBinder] (Right mkNothing)]) (App e (mkPrelVar "unit"))
9797
9898 fromSpineFun e _ = App (mkGenVar C.fromSpine) (App e (mkPrelVar "unit"))
9999
@@ -107,7 +107,9 @@ mkFromSpineFunction t = do
107107
108108-- Helpers
109109
110−pattern ObjectType rec = TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Object"))) rec
110+objectType :: Type -> Maybe Type
111+objectType (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Object"))) rec) = Just rec
112+objectType _ = Nothing
111113
112114lam :: String -> Expr -> Expr
113115lam s = Abs (Left (Ident s))