git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Remove syb dependency #367
commit722d3d4402658949b7641807da8cdff4af9e024e authorPhil Freeman <paf31@cantab.net> dateWed 16 Apr 2014, 21:30 (13 years ago) parent037f361
5 files changed+138−150
compare with golang
unifiedsplit
purescript.cabal+7−8 src/Data/Generics/Extras.hs−65 src/Language/PureScript/Declarations.hs+65−1 src/Language/PureScript/Sugar/Names.hs+59−76 src/Language/PureScript/Traversals.hs+7
purescript.cabal+7−8
@@ -1,5 +1,5 @@
11name: purescript
2−version: 0.4.18.2
2+version: 0.4.19
33cabal-version: >=1.8
44build-type: Custom
55license: MIT
@@ -19,15 +19,14 @@ data-dir: ""
1919
2020library
2121 build-depends: base >=4 && <5, cmdtheline -any, containers -any, unordered-containers -any,
22− directory >= 1.2, filepath -any, mtl -any, parsec -any, syb >= 0.4.1 && < 0.5,
22+ directory >= 1.2, filepath -any, mtl -any, parsec -any,
2323 transformers -any, utf8-string -any,
2424 pattern-arrows >= 0.0.2 && < 0.1,
2525 monad-unify >= 0.2.2 && < 0.3,
2626 xdg-basedir -any, time -any
2727 if (!os(windows))
2828 build-depends: unix -any
29− exposed-modules: Data.Generics.Extras
30− Language.PureScript
29+ exposed-modules: Language.PureScript
3130 Language.PureScript.Constants
3231 Language.PureScript.Options
3332 Language.PureScript.Declarations
@@ -88,7 +87,7 @@ library
8887executable psc
8988 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
9089 directory -any, filepath -any, mtl -any, parsec -any,
91− purescript -any, syb >= 0.4.1 && < 0.5, transformers -any, utf8-string -any
90+ purescript -any, transformers -any, utf8-string -any
9291 main-is: Main.hs
9392 buildable: True
9493 hs-source-dirs: psc
@@ -98,7 +97,7 @@ executable psc
9897executable psc-make
9998 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
10099 directory -any, filepath -any, mtl -any, parsec -any,
101− purescript -any, syb >= 0.4.1 && < 0.5, transformers -any, utf8-string -any
100+ purescript -any, transformers -any, utf8-string -any
102101 main-is: Main.hs
103102 buildable: True
104103 hs-source-dirs: psc-make
@@ -108,7 +107,7 @@ executable psc-make
108107executable psci
109108 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
110109 mtl -any, parsec -any, haskeline -any, purescript -any,
111− syb >= 0.4.1 && < 0.5, transformers -any, utf8-string -any, process -any,
110+ transformers -any, utf8-string -any, process -any,
112111 xdg-basedir -any, cmdtheline -any
113112 main-is: Main.hs
114113 buildable: True
@@ -137,7 +136,7 @@ executable hierarchy
137136
138137test-suite tests
139138 build-depends: base >=4 && <5, containers -any, directory -any,
140− filepath -any, mtl -any, parsec -any, purescript -any, syb >= 0.4.1 && < 0.5,
139+ filepath -any, mtl -any, parsec -any, purescript -any,
141140 transformers -any, utf8-string -any, process -any
142141 type: exitcode-stdio-1.0
143142 main-is: Main.hs
src/Data/Generics/Extras.hsdeleted−65
@@ -1,65 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Data.Generics.Extras
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Additional SYB combinators
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE Rank2Types #-}
17−
18−module Data.Generics.Extras where
19−
20−import Data.Data
21−
22−-- |
23−-- Apply a top-down transformation, mutating a state when descending from parents to children
24−--
25−-- For example, if we want to relabel bound variables with a different data constructor, we can do so:
26−--
27−-- > data Expr = Var String
28−-- > | Lam String Test
29−-- > | App Test Test
30−-- > | LocalVar String deriving (Show, Data, Typeable)
31−-- >
32−-- > test = App (Lam "a" (App (Var "a") (Var "b"))) (Var "a")
33−-- >
34−-- > varsToLocals :: Expr -> Expr
35−-- > varsToLocals = everywhereWithContext' [] (mkS go)
36−-- > where
37−-- > go locals (Var v) | v `elem` locals = (locals, LocalVar v)
38−-- > go locals lam@(Lam local _) = (local : locals, lam)
39−-- > go locals other = (locals, other)
40−--
41−everywhereWithContextM' :: (Monad m, Data d) => s -> (forall d1. (Data d1) => s -> d1 -> m (s, d1)) -> d -> m d
42−everywhereWithContextM' s0 f x = do
43− (s, y) <- f s0 x
44− gmapM (everywhereWithContextM' s f) y
45−
46−-- |
47−-- Make a stateful transformation function
48−--
49−mkS :: (Monad m, Data a, Data b) => (s -> a -> m (s, a)) -> s -> b -> m (s, b)
50−mkS = extS (curry return)
51−
52−-- |
53−-- Extend a stateful transformation function
54−--
55−extS :: (Monad m, Data a, Data b) => (s -> a -> m (s, a)) -> (s -> b -> m (s, b)) -> (s -> a -> m (s, a))
56−extS f g s a = do
57− (s', a') <- f s a
58− case cast a' of
59− Just b -> do
60− (s'', b') <- g s' b
61− case cast b' of
62− Just a'' -> return (s'', a'')
63− Nothing -> return (s', a')
64− Nothing -> return (s', a')
65−
src/Language/PureScript/Declarations.hs+65−1
@@ -599,7 +599,7 @@ everywhereOnValuesM f g h = (f' <=< f, g' <=< g, h' <=< h)
599599 g' (PositionedValue pos v) = (PositionedValue pos <$> g' v) >>= g
600600 g' other = g other
601601
602− h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM h' bs
602+ h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
603603 h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h
604604 h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
605605 h' (ConsBinder b1 b2) = (ConsBinder <$> h' b1 <*> h' b2) >>= h
@@ -736,6 +736,70 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
736736 j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
737737 j' s (PositionedDoNotationElement _ e1) = (j'' s) e1
738738
739+everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
740+ s ->
741+ (s -> Declaration -> m (s, Declaration)) ->
742+ (s -> Value -> m (s, Value)) ->
743+ (s -> Binder -> m (s, Binder)) ->
744+ (s -> CaseAlternative -> m (s, CaseAlternative)) ->
745+ (s -> DoNotationElement -> m (s, DoNotationElement)) ->
746+ ( Declaration -> m Declaration
747+ , Value -> m Value
748+ , Binder -> m Binder
749+ , CaseAlternative -> m CaseAlternative
750+ , DoNotationElement -> m DoNotationElement)
751+everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
752+ where
753+ f'' s = uncurry f' <=< f s
754+
755+ f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f'' s) ds
756+ f' s (ValueDeclaration name nameKind bs grd val) = ValueDeclaration name nameKind <$> mapM (h'' s) bs <*> maybeM (g'' s) grd <*> g'' s val
757+ f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds
758+ f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds
759+ f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f'' s) ds
760+ f' s (PositionedDeclaration pos d1) = PositionedDeclaration pos <$> f'' s d1
761+ f' _ other = return other
762+
763+ g'' s = uncurry g' <=< g s
764+
765+ g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
766+ g' s (BinaryNoParens op v1 v2) = BinaryNoParens op <$> g'' s v1 <*> g'' s v2
767+ g' s (Parens v) = Parens <$> g'' s v
768+ g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs
769+ g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs
770+ g' s (Accessor prop v) = Accessor prop <$> g'' s v
771+ g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs
772+ g' s (Abs name v) = Abs name <$> g'' s v
773+ g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
774+ g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
775+ g' s (Case vs alts) = Case <$> mapM (g'' s) vs <*> mapM (i'' s) alts
776+ g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
777+ g' s (Let ds v) = Let <$> mapM (f'' s) ds <*> g'' s v
778+ g' s (Do es) = Do <$> mapM (j'' s) es
779+ g' s (PositionedValue pos v) = PositionedValue pos <$> g'' s v
780+ g' _ other = return other
781+
782+ h'' s = uncurry h' <=< h s
783+
784+ h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs
785+ h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs
786+ h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
787+ h' s (ConsBinder b1 b2) = ConsBinder <$> h'' s b1 <*> h'' s b2
788+ h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
789+ h' s (PositionedBinder pos b) = PositionedBinder pos <$> h'' s b
790+ h' _ other = return other
791+
792+ i'' s = uncurry i' <=< i s
793+
794+ i' s (CaseAlternative bs grd val) = CaseAlternative <$> mapM (h'' s) bs <*> maybeM (g'' s) grd <*> g'' s val
795+
796+ j'' s = uncurry j' <=< j s
797+
798+ j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
799+ j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
800+ j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds
801+ j' s (PositionedDoNotationElement pos e1) = PositionedDoNotationElement pos <$> j'' s e1
802+
739803accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
740804accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
741805 where
src/Language/PureScript/Sugar/Names.hs+59−76
@@ -16,10 +16,8 @@ module Language.PureScript.Sugar.Names (
1616 desugarImports
1717) where
1818
19−import Data.Data
2019import Data.Maybe (fromMaybe, isJust, mapMaybe)
2120import Data.Monoid ((<>))
22−import Data.Generics.Extras (mkS, extS, everywhereWithContextM')
2321
2422import Control.Applicative (Applicative(..), (<$>), (<*>))
2523import Control.Monad.Error
@@ -31,6 +29,7 @@ import Language.PureScript.Names
3129import Language.PureScript.Types
3230import Language.PureScript.Environment
3331import Language.PureScript.Errors
32+import Language.PureScript.Traversals
3433
3534-- |
3635-- The global export environment - every declaration exported from every module.
@@ -177,83 +176,67 @@ renameInModule :: ImportEnvironment -> ExportEnvironment -> Module -> Either Err
177176renameInModule imports exports (Module mn decls exps) =
178177 Module mn <$> mapM go decls <*> pure exps
179178 where
180− go :: Declaration -> Either ErrorStack Declaration
181− go (PositionedDeclaration pos d) = rethrowWithPosition pos $ PositionedDeclaration pos <$> go d
182− go (DataDeclaration name args dctors) =
183− rethrow (strMsg ("Error in data declaration " ++ show name) <>) $
184− DataDeclaration <$> pure name <*> pure args <*> updateAll dctors
185− go (DataBindingGroupDeclaration decls') =
186− DataBindingGroupDeclaration <$> mapM go decls'
187− go (TypeSynonymDeclaration name ps ty) =
188− rethrow (strMsg ("Error in type synonym " ++ show name) <>) $
189− TypeSynonymDeclaration <$> pure name <*> pure ps <*> updateType' ty
190− go (TypeClassDeclaration className args implies ds) =
191− TypeClassDeclaration className args <$> updateConstraints Nothing implies <*> mapM go ds
192− go (TypeInstanceDeclaration name cs cn ts ds) =
193− TypeInstanceDeclaration name <$> updateConstraints Nothing cs <*> updateClassName cn Nothing <*> updateType' ts <*> mapM go ds
194− go (ExternInstanceDeclaration name cs cn ts) =
195− ExternInstanceDeclaration name <$> updateConstraints Nothing cs <*> updateClassName cn Nothing <*> updateType' ts
196− go (ValueDeclaration name nameKind [] Nothing val) = do
197− val' <- everywhereWithContextM' (Nothing, []) (mkS bindFunctionArgs `extS` bindBinders) val
198− rethrow (strMsg ("Error in declaration " ++ show name) <>) $
199− ValueDeclaration name nameKind [] Nothing <$> updateAll val'
200− where
201− bindFunctionArgs :: (Maybe SourcePos, [Ident]) -> Value -> Either ErrorStack ((Maybe SourcePos, [Ident]), Value)
202− bindFunctionArgs (_, bound) v@(PositionedValue pos' _) = return ((Just pos', bound), v)
203− bindFunctionArgs (pos, bound) (Abs (Left arg) val') = return ((pos, arg : bound), Abs (Left arg) val')
204− bindFunctionArgs (pos, bound) (Let ds val') =
179+ (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS
180+
181+ updateDecl :: (Maybe SourcePos, [Ident]) -> Declaration -> Either ErrorStack ((Maybe SourcePos, [Ident]), Declaration)
182+ updateDecl (_, bound) d@(PositionedDeclaration pos _) = return ((Just pos, bound), d)
183+ updateDecl (pos, bound) (DataDeclaration name args dctors) =
184+ (,) (pos, bound) <$> (DataDeclaration name args <$> mapM (sndM (mapM (updateTypesEverywhere pos))) dctors)
185+ updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =
186+ (,) (pos, bound) <$> (TypeSynonymDeclaration name ps <$> updateTypesEverywhere pos ty)
187+ updateDecl (pos, bound) (TypeClassDeclaration className args implies ds) =
188+ (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure ds)
189+ updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =
190+ (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> mapM (updateTypesEverywhere pos) ts <*> pure ds)
191+ updateDecl (pos, bound) (ExternInstanceDeclaration name cs cn ts) =
192+ (,) (pos, bound) <$> (ExternInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn Nothing <*> mapM (updateTypesEverywhere pos) ts)
193+ updateDecl (pos, bound) (TypeDeclaration name ty) =
194+ (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)
195+ updateDecl (pos, bound) (ExternDeclaration fit name js ty) =
196+ (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)
197+ updateDecl s d = return (s, d)
198+
199+ updateValue :: (Maybe SourcePos, [Ident]) -> Value -> Either ErrorStack ((Maybe SourcePos, [Ident]), Value)
200+ updateValue (_, bound) v@(PositionedValue pos' _) = return ((Just pos', bound), v)
201+ updateValue (pos, bound) (Abs (Left arg) val') = return ((pos, arg : bound), Abs (Left arg) val')
202+ updateValue (pos, bound) (Let ds val') =
205203 let args = mapMaybe letBoundVariable ds
206204 in return ((pos, args ++ bound), Let ds val')
207− bindFunctionArgs (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =
208− (,) (pos, bound) <$> (Var <$> updateValueName name' pos)
209− bindFunctionArgs (pos, bound) (Var name'@(Qualified (Just _) _)) =
210− (,) (pos, bound) <$> (Var <$> updateValueName name' pos)
211− bindFunctionArgs (pos, bound) (BinaryNoParens name'@(Qualified Nothing ident) v1 v2) | ident `notElem` bound =
212− (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)
213− bindFunctionArgs (pos, bound) (BinaryNoParens name'@(Qualified (Just _) _) v1 v2) =
214− (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)
215− bindFunctionArgs pb other = return (pb, other)
216−
217− bindBinders :: (Maybe SourcePos, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourcePos, [Ident]), CaseAlternative)
218− bindBinders (pos, bound) c@(CaseAlternative bs _ _) = return ((pos, concatMap binderNames bs ++ bound), c)
219−
220− letBoundVariable :: Declaration -> Maybe Ident
221− letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident
222− letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d
223− letBoundVariable _ = Nothing
224− go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name
225− go (ExternDeclaration fit name js ty) =
226− rethrow (strMsg ("Error in declaration " ++ show name) <>) $
227− ExternDeclaration <$> pure fit <*> pure name <*> pure js <*> updateType' ty
228− go (BindingGroupDeclaration decls') = BindingGroupDeclaration <$> mapM go' decls'
229− where
230− go' (name, nk, value) = rethrow (strMsg ("Error in declaration " ++ show name) <>) $
231− (,,) <$> pure name <*> pure nk <*> updateAll value
232− go d = updateAll d
233−
234− updateAll :: Data d => d -> Either ErrorStack d
235− updateAll = everywhereWithContextM' Nothing (mkS updateType `extS` updateValue `extS` updateBinder)
236−
237− updateValue :: Maybe SourcePos -> Value -> Either ErrorStack (Maybe SourcePos, Value)
238− updateValue _ v@(PositionedValue pos _) = return (Just pos, v)
239− updateValue pos (Constructor name) = (,) <$> pure pos <*> (Constructor <$> updateDataConstructorName name pos)
240− updateValue pos v = return (pos, v)
241−
242− updateBinder :: Maybe SourcePos -> Binder -> Either ErrorStack (Maybe SourcePos, Binder)
243− updateBinder _ v@(PositionedBinder pos _) = return (Just pos, v)
244− updateBinder pos (ConstructorBinder name b) = (,) <$> pure pos <*> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)
245− updateBinder pos v = return (pos, v)
246−
247− updateType :: Maybe SourcePos -> Type -> Either ErrorStack (Maybe SourcePos, Type)
248− updateType pos (TypeConstructor name) = (,) <$> pure pos <*> (TypeConstructor <$> updateTypeName name pos)
249− updateType pos (SaturatedTypeSynonym name tys) = (,) <$> pure pos <*> (SaturatedTypeSynonym <$> updateTypeName name pos <*> updateType' tys)
250− updateType pos (ConstrainedType cs t) = (,) <$> pure pos <*> (ConstrainedType <$> updateConstraints pos cs <*> pure t)
251− updateType pos t = return (pos, t)
252−
253− updateType' :: Data d => d -> Either ErrorStack d
254− updateType' = everywhereWithContextM' Nothing (mkS updateType)
205+ updateValue (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =
206+ (,) (pos, bound) <$> (Var <$> updateValueName name' pos)
207+ updateValue (pos, bound) (Var name'@(Qualified (Just _) _)) =
208+ (,) (pos, bound) <$> (Var <$> updateValueName name' pos)
209+ updateValue (pos, bound) (BinaryNoParens name'@(Qualified Nothing ident) v1 v2) | ident `notElem` bound =
210+ (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)
211+ updateValue (pos, bound) (BinaryNoParens name'@(Qualified (Just _) _) v1 v2) =
212+ (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)
213+ updateValue s@(pos, _) (Constructor name) = (,) s <$> (Constructor <$> updateDataConstructorName name pos)
214+ updateValue s@(pos, _) (TypedValue check val ty) = (,) s <$> (TypedValue check val <$> updateTypesEverywhere pos ty)
215+ updateValue s v = return (s, v)
216+
217+ updateBinder :: (Maybe SourcePos, [Ident]) -> Binder -> Either ErrorStack ((Maybe SourcePos, [Ident]), Binder)
218+ updateBinder (_, bound) v@(PositionedBinder pos _) = return ((Just pos, bound), v)
219+ updateBinder s@(pos, _) (ConstructorBinder name b) = (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)
220+ updateBinder s v = return (s, v)
221+
222+ updateCase :: (Maybe SourcePos, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourcePos, [Ident]), CaseAlternative)
223+ updateCase (pos, bound) c@(CaseAlternative bs _ _) = return ((pos, concatMap binderNames bs ++ bound), c)
224+
225+ letBoundVariable :: Declaration -> Maybe Ident
226+ letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident
227+ letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d
228+ letBoundVariable _ = Nothing
229+
230+ updateTypesEverywhere :: Maybe SourcePos -> Type -> Either ErrorStack Type
231+ updateTypesEverywhere pos0 = everywhereOnTypesM (updateType pos0)
232+ where
233+ updateType :: Maybe SourcePos -> Type -> Either ErrorStack Type
234+ updateType pos (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos
235+ updateType pos (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name pos <*> pure tys
236+ updateType pos (ConstrainedType cs t) = ConstrainedType <$> updateConstraints pos cs <*> pure t
237+ updateType _ t = return t
255238
256− updateConstraints pos = mapM (\(name, ts) -> (,) <$> updateClassName name pos <*> pure ts)
239+ updateConstraints pos = mapM (\(name, ts) -> (,) <$> updateClassName name pos <*> mapM (updateTypesEverywhere pos) ts)
257240
258241 updateTypeName = update "type" importedTypes (\mes -> isJust . (`lookup` exportedTypes mes))
259242 updateClassName = update "type class" importedTypeClasses (flip elem . exportedTypeClasses)
src/Language/PureScript/Traversals.hs+7
@@ -22,6 +22,13 @@ fstM f (a, b) = flip (,) b <$> f a
2222sndM :: (Functor f) => (b -> f c) -> (a, b) -> f (a, c)
2323sndM f (a, b) = (,) a <$> f b
2424
25+thirdM :: (Functor f) => (c -> f d) -> (a, b, c) -> f (a, b, d)
26+thirdM f (a, b, c) = (,,) a b <$> f c
27+
2528maybeM :: (Applicative f) => (a -> f b) -> Maybe a -> f (Maybe b)
2629maybeM _ Nothing = pure Nothing
2730maybeM f (Just a) = Just <$> f a
31+
32+defS :: (Monad m) => st -> val -> m (st, val)
33+defS s val = return (s, val)
34+