556b945 · rowtype-yoga/purescript-native

src/Language/PureScript/CodeGen/JS.hs+3−2

compare with golang

unifiedsplit

@@ -26,7 +26,6 @@ module Language.PureScript.CodeGen.JS (

26import Data.Maybe (fromJust, fromMaybe, mapMaybe)

27import Data.Function (on)

28import Data.List (nub, (\\))

29−import Data.Generics (mkQ, everything)

30

29

31import Control.Arrow (second)

30import Control.Arrow (second)

32import Control.Monad (replicateM, forM)

31import Control.Monad (replicateM, forM)

@@ -78,7 +77,9 @@ importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleB

78 Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))

77 Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))

79

78

80imports :: Declaration -> [ModuleName]

79imports :: Declaration -> [ModuleName]

81−imports = everything (++) (mkQ [] collect)

80+imports =

81+ let (f, _, _, _, _) = everythingOnValues (++) (const []) collect (const []) (const []) (const [])

82+ in f

82 where

83 where

83 collect :: Value -> [ModuleName]

84 collect :: Value -> [ModuleName]

84 collect (Var (Qualified (Just mn) _)) = [mn]

85 collect (Var (Qualified (Just mn) _)) = [mn]

src/Language/PureScript/Sugar.hs+1−1

@@ -49,7 +49,7 @@ import Control.Category ((>>>))

49--

50desugar :: [Module] -> Either ErrorStack [Module]

51desugar = map removeSignedLiterals

52− >>> desugarDo

52+ >>> mapM desugarDoModule

53 >=> desugarCasesModule

54 >=> desugarTypeDeclarationsModule

55 >=> desugarImports

src/Language/PureScript/Sugar/DoNotation.hs+5−3

@@ -15,10 +15,9 @@

15-----------------------------------------------------------------------------

16

17module Language.PureScript.Sugar.DoNotation (

18− desugarDo

18+ desugarDoModule

19) where

20

21−import Data.Data

22import Data.Generics

21import Data.Generics

23

22

24import Language.PureScript.Names

23import Language.PureScript.Names

@@ -34,7 +33,10 @@ import Control.Applicative

34-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.(>>=) function,

33-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.(>>=) function,

35-- and all @DoNotationLet@ constructors with let expressions.

34-- and all @DoNotationLet@ constructors with let expressions.

36--

35--

36+desugarDoModule :: Module -> Either ErrorStack Module

37+desugarDoModule (Module mn ds exts) = Module mn <$> mapM desugarDo ds <*> pure exts

38+

37−desugarDo :: (Data d) => d -> Either ErrorStack d

39+desugarDo :: Declaration -> Either ErrorStack Declaration

38desugarDo = everywhereM (mkM replace)

40desugarDo = everywhereM (mkM replace)

39 where

41 where

40 prelude :: ModuleName

42 prelude :: ModuleName

src/Language/PureScript/Sugar/Operators.hs+5−5

@@ -37,7 +37,6 @@ import Data.Function (on)

37import Data.Functor.Identity

38import Data.List (groupBy, sortBy)

39

40−import qualified Data.Data as D

41import qualified Data.Generics as G

40import qualified Data.Generics as G

42import qualified Data.Generics.Extras as G

41import qualified Data.Generics.Extras as G

43

42

@@ -57,7 +56,6 @@ rebracket ms = do

57 let opTable = customOperatorTable $ map (\(i, _, f) -> (i, f)) fixities

56 let opTable = customOperatorTable $ map (\(i, _, f) -> (i, f)) fixities

58 mapM (rebracketModule opTable) ms

57 mapM (rebracketModule opTable) ms

59

58

60−

61removeSignedLiterals :: Module -> Module

59removeSignedLiterals :: Module -> Module

62removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts

60removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts

63 where

61 where

@@ -69,10 +67,12 @@ removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts

69 go other = other

67 go other = other

70

68

71rebracketModule :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Module -> Either ErrorStack Module

69rebracketModule :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Module -> Either ErrorStack Module

72−rebracketModule opTable (Module mn ds exts) = Module mn <$> (removeParens <$> G.everywhereM' (G.mkM (matchOperators opTable)) ds) <*> pure exts

70+rebracketModule opTable (Module mn ds exts) = Module mn <$> (map removeParens <$> G.everywhereM' (G.mkM (matchOperators opTable)) ds) <*> pure exts

73

71

74−removeParens :: (D.Data d) => d -> d

72+removeParens :: Declaration -> Declaration

75−removeParens = G.everywhere (G.mkT go)

73+removeParens =

74+ let (f, _, _) = everywhereOnValues id go id

75+ in f

76 where

77 go (Parens val) = val

78 go val = val