@@ -1,232 +1,232 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Sugar.TypeClasses.Deriving
4−-- Copyright : (c) Gershom Bazerman 2015
5−-- License : MIT (http://opensource.org/licenses/MIT)
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module implements the generic deriving elaboration that takes place during desugaring.
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE MultiParamTypeClasses #-}
18−{-# LANGUAGE OverloadedStrings #-}
19−{-# LANGUAGE PatternGuards #-}
20−{-# LANGUAGE RankNTypes #-}
21−{-# LANGUAGE ScopedTypeVariables #-}
22−
23−module Language.PureScript.Sugar.TypeClasses.Deriving (
24− deriveInstances
25−) where
26−
27−import Prelude ()
28−import Prelude.Compat
29−
30−import Data.List (foldl', find, sortBy)
31−import Data.Maybe (fromMaybe)
32−import Data.Ord (comparing)
33−
34−import Control.Monad (replicateM)
35−import Control.Monad.Supply.Class (MonadSupply, freshName)
36−import Control.Monad.Error.Class (MonadError(..))
37−
38−import Language.PureScript.Crash
39−import Language.PureScript.AST
40−import Language.PureScript.Environment
41−import Language.PureScript.Errors
42−import Language.PureScript.Names
43−import Language.PureScript.Types
44−import qualified Language.PureScript.Constants as C
45−
46−-- | Elaborates deriving instance declarations by code generation.
47−deriveInstances :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadSupply m) => Module -> m Module
48−deriveInstances (Module ss coms mn ds exts) = Module ss coms mn <$> mapM (deriveInstance mn ds) ds <*> pure exts
49−
50−-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,
51−-- elaborates that into an instance declaration via code generation.
52−deriveInstance :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> Declaration -> m Declaration
53−deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[ty] DerivedInstance)
54− | className == Qualified (Just dataGeneric) (ProperName C.generic)
55− , Just (Qualified mn' tyCon) <- unwrapTypeConstructor ty
56− , mn == fromMaybe mn mn'
57− = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn ds tyCon
58−deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)
59− = throwError . errorMessage $ CannotDerive className tys
60−deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d
61−deriveInstance _ _ e = return e
62−
63−unwrapTypeConstructor :: Type -> Maybe (Qualified ProperName)
64−unwrapTypeConstructor (TypeConstructor tyCon) = Just tyCon
65−unwrapTypeConstructor (TypeApp ty (TypeVar _)) = unwrapTypeConstructor ty
66−unwrapTypeConstructor _ = Nothing
67−
68−dataGeneric :: ModuleName
69−dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
70−
71−dataMaybe :: ModuleName
72−dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]
73−
74−deriveGeneric :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> ProperName -> m [Declaration]
75−deriveGeneric mn ds tyConNm = do
76− tyCon <- findTypeDecl tyConNm ds
77− toSpine <- mkSpineFunction mn tyCon
78− fromSpine <- mkFromSpineFunction mn tyCon
79− let toSignature = mkSignatureFunction mn tyCon
80− return [ ValueDeclaration (Ident C.toSpine) Public [] (Right toSpine)
81− , ValueDeclaration (Ident C.fromSpine) Public [] (Right fromSpine)
82− , ValueDeclaration (Ident C.toSignature) Public [] (Right toSignature)
83− ]
84−
85−findTypeDecl :: (Functor m, MonadError MultipleErrors m) => ProperName -> [Declaration] -> m Declaration
86−findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType tyConNm) return . find isTypeDecl
87− where
88− isTypeDecl :: Declaration -> Bool
89− isTypeDecl (DataDeclaration _ nm _ _) | nm == tyConNm = True
90− isTypeDecl (PositionedDeclaration _ _ d) = isTypeDecl d
91− isTypeDecl _ = False
92−
93−mkSpineFunction :: forall m. (Functor m, MonadSupply m) => ModuleName -> Declaration -> m Expr
94−mkSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> mapM mkCtorClause args
95− where
96− prodConstructor :: Expr -> Expr
97− prodConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SProd")))
98−
99− recordConstructor :: Expr -> Expr
100− recordConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SRecord")))
101−
102− mkCtorClause :: (ProperName, [Type]) -> m CaseAlternative
103− mkCtorClause (ctorName, tys) = do
104− idents <- replicateM (length tys) (fmap Ident freshName)
105− return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
106− where
107− caseResult idents =
108− App (prodConstructor (StringLiteral . runProperName $ ctorName))
109− . ArrayLiteral
110− $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
111−
112− toSpineFun :: Expr -> Type -> Expr
113− toSpineFun i r | Just rec <- objectType r =
114− lamNull . recordConstructor . ArrayLiteral .
115− map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", toSpineFun (Accessor str i) typ)])
116− $ decomposeRec rec
117− toSpineFun i _ = lamNull $ App (mkGenVar C.toSpine) i
118−mkSpineFunction mn (PositionedDeclaration _ _ d) = mkSpineFunction mn d
119−mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"
120−
121−mkSignatureFunction :: ModuleName -> Declaration -> Expr
122−mkSignatureFunction _ (DataDeclaration _ _ _ args) = lamNull . mkSigProd $ map mkProdClause args
123− where
124− mkSigProd :: [Expr] -> Expr
125− mkSigProd = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd"))) . ArrayLiteral
126−
127− mkSigRec :: [Expr] -> Expr
128− mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral
129−
130− proxy :: Type -> Type
131− proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))
132−
133− mkProdClause :: (ProperName, [Type]) -> Expr
134− mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (runProperName ctorName))
135− , ("sigValues", ArrayLiteral . map mkProductSignature $ tys)
136− ]
137−
138− mkProductSignature :: Type -> Expr
139− mkProductSignature r | Just rec <- objectType r =
140− lamNull . mkSigRec $ [ ObjectLiteral [ ("recLabel", StringLiteral str)
141− , ("recValue", mkProductSignature typ)
142− ]
143− | (str, typ) <- decomposeRec rec
144− ]
145− mkProductSignature typ = lamNull $ App (mkGenVar C.toSignature)
146− (TypedValue False (mkGenVar "anyProxy") (proxy typ))
147−mkSignatureFunction mn (PositionedDeclaration _ _ d) = mkSignatureFunction mn d
148−mkSignatureFunction _ _ = internalError "mkSignatureFunction: expected DataDeclaration"
149−
150−mkFromSpineFunction :: forall m. (Functor m, MonadSupply m) => ModuleName -> Declaration -> m Expr
151−mkFromSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch <$> mapM mkAlternative args)
152− where
153− mkJust :: Expr -> Expr
154− mkJust = App (Constructor (Qualified (Just dataMaybe) (ProperName "Just")))
155−
156− mkNothing :: Expr
157− mkNothing = Constructor (Qualified (Just dataMaybe) (ProperName "Nothing"))
158−
159− prodBinder :: [Binder] -> Binder
160− prodBinder = ConstructorBinder (Qualified (Just dataGeneric) (ProperName "SProd"))
161−
162− recordBinder :: [Binder] -> Binder
163− recordBinder = ConstructorBinder (Qualified (Just dataGeneric) (ProperName "SRecord"))
164−
165− mkAlternative :: (ProperName, [Type]) -> m CaseAlternative
166− mkAlternative (ctorName, tys) = do
167− idents <- replicateM (length tys) (fmap Ident freshName)
168− return $ CaseAlternative [ prodBinder [ StringBinder (runProperName ctorName), ArrayBinder (map VarBinder idents)]]
169− . Right
170− $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))
171− (zipWith fromSpineFun (map (Var . (Qualified Nothing)) idents) tys)
172−
173− addCatch :: [CaseAlternative] -> [CaseAlternative]
174− addCatch = (++ [catchAll])
175− where
176− catchAll = CaseAlternative [NullBinder] (Right mkNothing)
177−
178− fromSpineFun e r
179− | Just rec <- objectType r
180− = App (lamCase "r" [ mkRecCase (decomposeRec rec)
181− , CaseAlternative [NullBinder] (Right mkNothing)
182− ])
183− (App e (mkPrelVar "unit"))
184−
185− fromSpineFun e _ = App (mkGenVar C.fromSpine) (App e (mkPrelVar "unit"))
186−
187− mkRecCase rs = CaseAlternative [ recordBinder [ ArrayBinder (map (VarBinder . Ident . fst) rs)
188− ]
189− ]
190− . Right
191− $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar x)) y) rs)
192−
193− mkRecFun :: [(String, Type)] -> Expr
194− mkRecFun xs = mkJust $ foldr (\s e -> lam s e) recLiteral (map fst xs)
195− where recLiteral = ObjectLiteral $ map (\(s,_) -> (s,mkVar s)) xs
196−mkFromSpineFunction mn (PositionedDeclaration _ _ d) = mkFromSpineFunction mn d
197−mkFromSpineFunction _ _ = internalError "mkFromSpineFunction: expected DataDeclaration"
198−
199−-- Helpers
200−
201−objectType :: Type -> Maybe Type
202−objectType (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Object"))) rec) = Just rec
203−objectType _ = Nothing
204−
205−lam :: String -> Expr -> Expr
206−lam s = Abs (Left (Ident s))
207−
208−lamNull :: Expr -> Expr
209−lamNull = lam "$q"
210−
211−lamCase :: String -> [CaseAlternative] -> Expr
212−lamCase s = lam s . Case [mkVar s]
213−
214−liftApplicative :: Expr -> [Expr] -> Expr
215−liftApplicative = foldl' (\x e -> App (App (mkPrelVar "apply") x) e)
216−
217−mkVarMn :: Maybe ModuleName -> String -> Expr
218−mkVarMn mn s = Var (Qualified mn (Ident s))
219−
220−mkVar :: String -> Expr
221−mkVar s = mkVarMn Nothing s
222−
223−mkPrelVar :: String -> Expr
224−mkPrelVar s = mkVarMn (Just (ModuleName [ProperName C.prelude])) s
225−
226−mkGenVar :: String -> Expr
227−mkGenVar s = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic])) s
228−
229−decomposeRec :: Type -> [(String, Type)]
230−decomposeRec = sortBy (comparing fst) . go
231− where go (RCons str typ typs) = (str, typ) : decomposeRec typs
232− go _ = []
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Sugar.TypeClasses.Deriving
4+-- Copyright : (c) Gershom Bazerman 2015
5+-- License : MIT (http://opensource.org/licenses/MIT)
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- This module implements the generic deriving elaboration that takes place during desugaring.
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE MultiParamTypeClasses #-}
18+{-# LANGUAGE OverloadedStrings #-}
19+{-# LANGUAGE PatternGuards #-}
20+{-# LANGUAGE RankNTypes #-}
21+{-# LANGUAGE ScopedTypeVariables #-}
22+
23+module Language.PureScript.Sugar.TypeClasses.Deriving (
24+ deriveInstances
25+) where
26+
27+import Prelude ()
28+import Prelude.Compat
29+
30+import Data.List (foldl', find, sortBy)
31+import Data.Maybe (fromMaybe)
32+import Data.Ord (comparing)
33+
34+import Control.Monad (replicateM)
35+import Control.Monad.Supply.Class (MonadSupply, freshName)
36+import Control.Monad.Error.Class (MonadError(..))
37+
38+import Language.PureScript.Crash
39+import Language.PureScript.AST
40+import Language.PureScript.Environment
41+import Language.PureScript.Errors
42+import Language.PureScript.Names
43+import Language.PureScript.Types
44+import qualified Language.PureScript.Constants as C
45+
46+-- | Elaborates deriving instance declarations by code generation.
47+deriveInstances :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadSupply m) => Module -> m Module
48+deriveInstances (Module ss coms mn ds exts) = Module ss coms mn <$> mapM (deriveInstance mn ds) ds <*> pure exts
49+
50+-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,
51+-- elaborates that into an instance declaration via code generation.
52+deriveInstance :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> Declaration -> m Declaration
53+deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[ty] DerivedInstance)
54+ | className == Qualified (Just dataGeneric) (ProperName C.generic)
55+ , Just (Qualified mn' tyCon) <- unwrapTypeConstructor ty
56+ , mn == fromMaybe mn mn'
57+ = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn ds tyCon
58+deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)
59+ = throwError . errorMessage $ CannotDerive className tys
60+deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d
61+deriveInstance _ _ e = return e
62+
63+unwrapTypeConstructor :: Type -> Maybe (Qualified ProperName)
64+unwrapTypeConstructor (TypeConstructor tyCon) = Just tyCon
65+unwrapTypeConstructor (TypeApp ty (TypeVar _)) = unwrapTypeConstructor ty
66+unwrapTypeConstructor _ = Nothing
67+
68+dataGeneric :: ModuleName
69+dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
70+
71+dataMaybe :: ModuleName
72+dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]
73+
74+deriveGeneric :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> ProperName -> m [Declaration]
75+deriveGeneric mn ds tyConNm = do
76+ tyCon <- findTypeDecl tyConNm ds
77+ toSpine <- mkSpineFunction mn tyCon
78+ fromSpine <- mkFromSpineFunction mn tyCon
79+ let toSignature = mkSignatureFunction mn tyCon
80+ return [ ValueDeclaration (Ident C.toSpine) Public [] (Right toSpine)
81+ , ValueDeclaration (Ident C.fromSpine) Public [] (Right fromSpine)
82+ , ValueDeclaration (Ident C.toSignature) Public [] (Right toSignature)
83+ ]
84+
85+findTypeDecl :: (Functor m, MonadError MultipleErrors m) => ProperName -> [Declaration] -> m Declaration
86+findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType tyConNm) return . find isTypeDecl
87+ where
88+ isTypeDecl :: Declaration -> Bool
89+ isTypeDecl (DataDeclaration _ nm _ _) | nm == tyConNm = True
90+ isTypeDecl (PositionedDeclaration _ _ d) = isTypeDecl d
91+ isTypeDecl _ = False
92+
93+mkSpineFunction :: forall m. (Functor m, MonadSupply m) => ModuleName -> Declaration -> m Expr
94+mkSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> mapM mkCtorClause args
95+ where
96+ prodConstructor :: Expr -> Expr
97+ prodConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SProd")))
98+
99+ recordConstructor :: Expr -> Expr
100+ recordConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SRecord")))
101+
102+ mkCtorClause :: (ProperName, [Type]) -> m CaseAlternative
103+ mkCtorClause (ctorName, tys) = do
104+ idents <- replicateM (length tys) (fmap Ident freshName)
105+ return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
106+ where
107+ caseResult idents =
108+ App (prodConstructor (StringLiteral . runProperName $ ctorName))
109+ . ArrayLiteral
110+ $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
111+
112+ toSpineFun :: Expr -> Type -> Expr
113+ toSpineFun i r | Just rec <- objectType r =
114+ lamNull . recordConstructor . ArrayLiteral .
115+ map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", toSpineFun (Accessor str i) typ)])
116+ $ decomposeRec rec
117+ toSpineFun i _ = lamNull $ App (mkGenVar C.toSpine) i
118+mkSpineFunction mn (PositionedDeclaration _ _ d) = mkSpineFunction mn d
119+mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"
120+
121+mkSignatureFunction :: ModuleName -> Declaration -> Expr
122+mkSignatureFunction _ (DataDeclaration _ _ _ args) = lamNull . mkSigProd $ map mkProdClause args
123+ where
124+ mkSigProd :: [Expr] -> Expr
125+ mkSigProd = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd"))) . ArrayLiteral
126+
127+ mkSigRec :: [Expr] -> Expr
128+ mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral
129+
130+ proxy :: Type -> Type
131+ proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))
132+
133+ mkProdClause :: (ProperName, [Type]) -> Expr
134+ mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (runProperName ctorName))
135+ , ("sigValues", ArrayLiteral . map mkProductSignature $ tys)
136+ ]
137+
138+ mkProductSignature :: Type -> Expr
139+ mkProductSignature r | Just rec <- objectType r =
140+ lamNull . mkSigRec $ [ ObjectLiteral [ ("recLabel", StringLiteral str)
141+ , ("recValue", mkProductSignature typ)
142+ ]
143+ | (str, typ) <- decomposeRec rec
144+ ]
145+ mkProductSignature typ = lamNull $ App (mkGenVar C.toSignature)
146+ (TypedValue False (mkGenVar "anyProxy") (proxy typ))
147+mkSignatureFunction mn (PositionedDeclaration _ _ d) = mkSignatureFunction mn d
148+mkSignatureFunction _ _ = internalError "mkSignatureFunction: expected DataDeclaration"
149+
150+mkFromSpineFunction :: forall m. (Functor m, MonadSupply m) => ModuleName -> Declaration -> m Expr
151+mkFromSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch <$> mapM mkAlternative args)
152+ where
153+ mkJust :: Expr -> Expr
154+ mkJust = App (Constructor (Qualified (Just dataMaybe) (ProperName "Just")))
155+
156+ mkNothing :: Expr
157+ mkNothing = Constructor (Qualified (Just dataMaybe) (ProperName "Nothing"))
158+
159+ prodBinder :: [Binder] -> Binder
160+ prodBinder = ConstructorBinder (Qualified (Just dataGeneric) (ProperName "SProd"))
161+
162+ recordBinder :: [Binder] -> Binder
163+ recordBinder = ConstructorBinder (Qualified (Just dataGeneric) (ProperName "SRecord"))
164+
165+ mkAlternative :: (ProperName, [Type]) -> m CaseAlternative
166+ mkAlternative (ctorName, tys) = do
167+ idents <- replicateM (length tys) (fmap Ident freshName)
168+ return $ CaseAlternative [ prodBinder [ StringBinder (runProperName ctorName), ArrayBinder (map VarBinder idents)]]
169+ . Right
170+ $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))
171+ (zipWith fromSpineFun (map (Var . (Qualified Nothing)) idents) tys)
172+
173+ addCatch :: [CaseAlternative] -> [CaseAlternative]
174+ addCatch = (++ [catchAll])
175+ where
176+ catchAll = CaseAlternative [NullBinder] (Right mkNothing)
177+
178+ fromSpineFun e r
179+ | Just rec <- objectType r
180+ = App (lamCase "r" [ mkRecCase (decomposeRec rec)
181+ , CaseAlternative [NullBinder] (Right mkNothing)
182+ ])
183+ (App e (mkPrelVar "unit"))
184+
185+ fromSpineFun e _ = App (mkGenVar C.fromSpine) (App e (mkPrelVar "unit"))
186+
187+ mkRecCase rs = CaseAlternative [ recordBinder [ ArrayBinder (map (VarBinder . Ident . fst) rs)
188+ ]
189+ ]
190+ . Right
191+ $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar x)) y) rs)
192+
193+ mkRecFun :: [(String, Type)] -> Expr
194+ mkRecFun xs = mkJust $ foldr (\s e -> lam s e) recLiteral (map fst xs)
195+ where recLiteral = ObjectLiteral $ map (\(s,_) -> (s,mkVar s)) xs
196+mkFromSpineFunction mn (PositionedDeclaration _ _ d) = mkFromSpineFunction mn d
197+mkFromSpineFunction _ _ = internalError "mkFromSpineFunction: expected DataDeclaration"
198+
199+-- Helpers
200+
201+objectType :: Type -> Maybe Type
202+objectType (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Object"))) rec) = Just rec
203+objectType _ = Nothing
204+
205+lam :: String -> Expr -> Expr
206+lam s = Abs (Left (Ident s))
207+
208+lamNull :: Expr -> Expr
209+lamNull = lam "$q"
210+
211+lamCase :: String -> [CaseAlternative] -> Expr
212+lamCase s = lam s . Case [mkVar s]
213+
214+liftApplicative :: Expr -> [Expr] -> Expr
215+liftApplicative = foldl' (\x e -> App (App (mkPrelVar "apply") x) e)
216+
217+mkVarMn :: Maybe ModuleName -> String -> Expr
218+mkVarMn mn s = Var (Qualified mn (Ident s))
219+
220+mkVar :: String -> Expr
221+mkVar s = mkVarMn Nothing s
222+
223+mkPrelVar :: String -> Expr
224+mkPrelVar s = mkVarMn (Just (ModuleName [ProperName C.prelude])) s
225+
226+mkGenVar :: String -> Expr
227+mkGenVar s = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic])) s
228+
229+decomposeRec :: Type -> [(String, Type)]
230+decomposeRec = sortBy (comparing fst) . go
231+ where go (RCons str typ typs) = (str, typ) : decomposeRec typs
232+ go _ = []