722d3d4 · rowtype-yoga/purescript-native

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

on golang help sign in

Remove syb dependency #367

722d3d4Phil Freeman13 years ago

purescript.cabal+7−8

compare with golang

unifiedsplit

@@ -1,5 +1,5 @@

1name: purescript

2−version: 0.4.18.2

2+version: 0.4.19

3cabal-version: >=1.8

4build-type: Custom

5license: MIT

@@ -19,15 +19,14 @@ data-dir: ""

20library

21 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,

23 transformers -any, utf8-string -any,

24 pattern-arrows >= 0.0.2 && < 0.1,

25 monad-unify >= 0.2.2 && < 0.3,

26 xdg-basedir -any, time -any

27 if (!os(windows))

28 build-depends: unix -any

29− exposed-modules: Data.Generics.Extras

30− Language.PureScript

29+ exposed-modules: Language.PureScript

31 Language.PureScript.Constants

30 Language.PureScript.Constants

32 Language.PureScript.Options

31 Language.PureScript.Options

33 Language.PureScript.Declarations

32 Language.PureScript.Declarations

@@ -88,7 +87,7 @@ library

88executable psc

87executable psc

89 build-depends: base >=4 && <5, cmdtheline -any, containers -any,

88 build-depends: base >=4 && <5, cmdtheline -any, containers -any,

90 directory -any, filepath -any, mtl -any, parsec -any,

89 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

92 main-is: Main.hs

91 main-is: Main.hs

93 buildable: True

92 buildable: True

94 hs-source-dirs: psc

93 hs-source-dirs: psc

@@ -98,7 +97,7 @@ executable psc

98executable psc-make

97executable psc-make

99 build-depends: base >=4 && <5, cmdtheline -any, containers -any,

98 build-depends: base >=4 && <5, cmdtheline -any, containers -any,

100 directory -any, filepath -any, mtl -any, parsec -any,

99 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

102 main-is: Main.hs

101 main-is: Main.hs

103 buildable: True

102 buildable: True

104 hs-source-dirs: psc-make

103 hs-source-dirs: psc-make

@@ -108,7 +107,7 @@ executable psc-make

108executable psci

107executable psci

109 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

108 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

110 mtl -any, parsec -any, haskeline -any, purescript -any,

109 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,

112 xdg-basedir -any, cmdtheline -any

111 xdg-basedir -any, cmdtheline -any

113 main-is: Main.hs

112 main-is: Main.hs

114 buildable: True

113 buildable: True

@@ -137,7 +136,7 @@ executable hierarchy

137

136

138test-suite tests

137test-suite tests

139 build-depends: base >=4 && <5, containers -any, directory -any,

138 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,

141 transformers -any, utf8-string -any, process -any

140 transformers -any, utf8-string -any, process -any

142 type: exitcode-stdio-1.0

141 type: exitcode-stdio-1.0

143 main-is: Main.hs

142 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)

599 g' (PositionedValue pos v) = (PositionedValue pos <$> g' v) >>= g

600 g' other = g other

601

602− h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM h' bs

602+ h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h

603 h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h

604 h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h

605 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'

736 j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)

737 j' s (PositionedDoNotationElement _ e1) = (j'' s) e1

738

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+

739accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)

803accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)

740accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

804accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

741 where

805 where

src/Language/PureScript/Sugar/Names.hs+59−76

@@ -16,10 +16,8 @@ module Language.PureScript.Sugar.Names (

16 desugarImports

17) where

19−import Data.Data

20import Data.Maybe (fromMaybe, isJust, mapMaybe)

19import Data.Maybe (fromMaybe, isJust, mapMaybe)

21import Data.Monoid ((<>))

20import Data.Monoid ((<>))

22−import Data.Generics.Extras (mkS, extS, everywhereWithContextM')

24import Control.Applicative (Applicative(..), (<$>), (<*>))

22import Control.Applicative (Applicative(..), (<$>), (<*>))

25import Control.Monad.Error

23import Control.Monad.Error

@@ -31,6 +29,7 @@ import Language.PureScript.Names

31import Language.PureScript.Types

29import Language.PureScript.Types

32import Language.PureScript.Environment

30import Language.PureScript.Environment

33import Language.PureScript.Errors

31import Language.PureScript.Errors

32+import Language.PureScript.Traversals

35-- |

34-- |

36-- The global export environment - every declaration exported from every module.

35-- The global export environment - every declaration exported from every module.

@@ -177,83 +176,67 @@ renameInModule :: ImportEnvironment -> ExportEnvironment -> Module -> Either Err

177renameInModule imports exports (Module mn decls exps) =

176renameInModule imports exports (Module mn decls exps) =

178 Module mn <$> mapM go decls <*> pure exps

177 Module mn <$> mapM go decls <*> pure exps

179 where

178 where

179+ (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS

180+

180− go :: Declaration -> Either ErrorStack Declaration

181+ updateDecl :: (Maybe SourcePos, [Ident]) -> Declaration -> Either ErrorStack ((Maybe SourcePos, [Ident]), Declaration)

181− go (PositionedDeclaration pos d) = rethrowWithPosition pos $ PositionedDeclaration pos <$> go d

182+ updateDecl (_, bound) d@(PositionedDeclaration pos _) = return ((Just pos, bound), d)

182− go (DataDeclaration name args dctors) =

183+ updateDecl (pos, bound) (DataDeclaration name args dctors) =

183− rethrow (strMsg ("Error in data declaration " ++ show name) <>) $

184+ (,) (pos, bound) <$> (DataDeclaration name args <$> mapM (sndM (mapM (updateTypesEverywhere pos))) dctors)

184− DataDeclaration <$> pure name <*> pure args <*> updateAll dctors

185− go (DataBindingGroupDeclaration decls') =

186− DataBindingGroupDeclaration <$> mapM go decls'

187− go (TypeSynonymDeclaration name ps ty) =

185+ updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =

188− rethrow (strMsg ("Error in type synonym " ++ show name) <>) $

186+ (,) (pos, bound) <$> (TypeSynonymDeclaration name ps <$> updateTypesEverywhere pos ty)

189− TypeSynonymDeclaration <$> pure name <*> pure ps <*> updateType' ty

190− go (TypeClassDeclaration className args implies ds) =

187+ updateDecl (pos, bound) (TypeClassDeclaration className args implies ds) =

191− TypeClassDeclaration className args <$> updateConstraints Nothing implies <*> mapM go ds

188+ (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure ds)

192− go (TypeInstanceDeclaration name cs cn ts ds) =

189+ updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =

193− TypeInstanceDeclaration name <$> updateConstraints Nothing cs <*> updateClassName cn Nothing <*> updateType' ts <*> mapM go ds

190+ (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> mapM (updateTypesEverywhere pos) ts <*> pure ds)

194− go (ExternInstanceDeclaration name cs cn ts) =

191+ updateDecl (pos, bound) (ExternInstanceDeclaration name cs cn ts) =

195− ExternInstanceDeclaration name <$> updateConstraints Nothing cs <*> updateClassName cn Nothing <*> updateType' ts

192+ (,) (pos, bound) <$> (ExternInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn Nothing <*> mapM (updateTypesEverywhere pos) ts)

196− go (ValueDeclaration name nameKind [] Nothing val) = do

193+ updateDecl (pos, bound) (TypeDeclaration name ty) =

197− val' <- everywhereWithContextM' (Nothing, []) (mkS bindFunctionArgs `extS` bindBinders) val

194+ (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)

198− rethrow (strMsg ("Error in declaration " ++ show name) <>) $

195+ updateDecl (pos, bound) (ExternDeclaration fit name js ty) =

199− ValueDeclaration name nameKind [] Nothing <$> updateAll val'

196+ (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)

200− where

197+ updateDecl s d = return (s, d)

198+

201− bindFunctionArgs :: (Maybe SourcePos, [Ident]) -> Value -> Either ErrorStack ((Maybe SourcePos, [Ident]), Value)

199+ updateValue :: (Maybe SourcePos, [Ident]) -> Value -> Either ErrorStack ((Maybe SourcePos, [Ident]), Value)

202− bindFunctionArgs (_, bound) v@(PositionedValue pos' _) = return ((Just pos', bound), v)

200+ updateValue (_, 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')

201+ updateValue (pos, bound) (Abs (Left arg) val') = return ((pos, arg : bound), Abs (Left arg) val')

204− bindFunctionArgs (pos, bound) (Let ds val') =

202+ updateValue (pos, bound) (Let ds val') =

205 let args = mapMaybe letBoundVariable ds

203 let args = mapMaybe letBoundVariable ds

206 in return ((pos, args ++ bound), Let ds val')

204 in return ((pos, args ++ bound), Let ds val')

207− bindFunctionArgs (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =

205+ updateValue (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =

208− (,) (pos, bound) <$> (Var <$> updateValueName name' pos)

206+ (,) (pos, bound) <$> (Var <$> updateValueName name' pos)

209− bindFunctionArgs (pos, bound) (Var name'@(Qualified (Just _) _)) =

207+ updateValue (pos, bound) (Var name'@(Qualified (Just _) _)) =

210− (,) (pos, bound) <$> (Var <$> updateValueName name' pos)

208+ (,) (pos, bound) <$> (Var <$> updateValueName name' pos)

211− bindFunctionArgs (pos, bound) (BinaryNoParens name'@(Qualified Nothing ident) v1 v2) | ident `notElem` bound =

209+ updateValue (pos, bound) (BinaryNoParens name'@(Qualified Nothing ident) v1 v2) | ident `notElem` bound =

212− (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)

210+ (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)

213− bindFunctionArgs (pos, bound) (BinaryNoParens name'@(Qualified (Just _) _) v1 v2) =

211+ updateValue (pos, bound) (BinaryNoParens name'@(Qualified (Just _) _) v1 v2) =

214− (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)

212+ (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)

215− bindFunctionArgs pb other = return (pb, other)

213+ updateValue s@(pos, _) (Constructor name) = (,) s <$> (Constructor <$> updateDataConstructorName name pos)

216−

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+

217− bindBinders :: (Maybe SourcePos, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourcePos, [Ident]), CaseAlternative)

222+ updateCase :: (Maybe SourcePos, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourcePos, [Ident]), CaseAlternative)

218− bindBinders (pos, bound) c@(CaseAlternative bs _ _) = return ((pos, concatMap binderNames bs ++ bound), c)

223+ updateCase (pos, bound) c@(CaseAlternative bs _ _) = return ((pos, concatMap binderNames bs ++ bound), c)

219−

224+

220− letBoundVariable :: Declaration -> Maybe Ident

225+ letBoundVariable :: Declaration -> Maybe Ident

221− letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident

226+ letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident

222− letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

227+ letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

223− letBoundVariable _ = Nothing

228+ letBoundVariable _ = Nothing

224− go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name

229+

225− go (ExternDeclaration fit name js ty) =

230+ updateTypesEverywhere :: Maybe SourcePos -> Type -> Either ErrorStack Type

226− rethrow (strMsg ("Error in declaration " ++ show name) <>) $

231+ updateTypesEverywhere pos0 = everywhereOnTypesM (updateType pos0)

227− ExternDeclaration <$> pure fit <*> pure name <*> pure js <*> updateType' ty

228− go (BindingGroupDeclaration decls') = BindingGroupDeclaration <$> mapM go' decls'

229− where

232+ 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)

233+ updateType :: Maybe SourcePos -> Type -> Either ErrorStack Type

248− updateType pos (TypeConstructor name) = (,) <$> pure pos <*> (TypeConstructor <$> updateTypeName name pos)

234+ updateType pos (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos

249− updateType pos (SaturatedTypeSynonym name tys) = (,) <$> pure pos <*> (SaturatedTypeSynonym <$> updateTypeName name pos <*> updateType' tys)

235+ updateType pos (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name pos <*> pure tys

250− updateType pos (ConstrainedType cs t) = (,) <$> pure pos <*> (ConstrainedType <$> updateConstraints pos cs <*> pure t)

236+ updateType pos (ConstrainedType cs t) = ConstrainedType <$> updateConstraints pos cs <*> pure t

251− updateType pos t = return (pos, t)

237+ updateType _ t = return t

252−

253− updateType' :: Data d => d -> Either ErrorStack d

254− updateType' = everywhereWithContextM' Nothing (mkS updateType)

255

238

256− updateConstraints pos = mapM (\(name, ts) -> (,) <$> updateClassName name pos <*> pure ts)

239+ updateConstraints pos = mapM (\(name, ts) -> (,) <$> updateClassName name pos <*> mapM (updateTypesEverywhere pos) ts)

257

240

258 updateTypeName = update "type" importedTypes (\mes -> isJust . (`lookup` exportedTypes mes))

241 updateTypeName = update "type" importedTypes (\mes -> isJust . (`lookup` exportedTypes mes))

259 updateClassName = update "type class" importedTypeClasses (flip elem . exportedTypeClasses)

242 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

22sndM :: (Functor f) => (b -> f c) -> (a, b) -> f (a, c)

23sndM f (a, b) = (,) a <$> f b

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+

25maybeM :: (Applicative f) => (a -> f b) -> Maybe a -> f (Maybe b)

28maybeM :: (Applicative f) => (a -> f b) -> Maybe a -> f (Maybe b)

26maybeM _ Nothing = pure Nothing

29maybeM _ Nothing = pure Nothing

27maybeM f (Just a) = Just <$> f a

30maybeM f (Just a) = Just <$> f a

31+

32+defS :: (Monad m) => st -> val -> m (st, val)

33+defS s val = return (s, val)

34+