git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #962 from purescript/rebindable-do
ed9c102Phil Freeman
examples/passing/RebindableSyntax.pursnew file+37
@@ -0,0 +1,37 @@
1+module Main where
2+
3+example1 :: String
4+example1 = do
5+ "Do"
6+ " notation"
7+ " for"
8+ " Semigroup"
9+ where
10+ (>>=) x f = x <> f unit
11+
12+(*>) :: forall f a b. (Apply f) => f a -> f b -> f b
13+(*>) fa fb = const id <$> fa <*> fb
14+
15+newtype Const a b = Const a
16+
17+runConst :: forall a b. Const a b -> a
18+runConst (Const a) = a
19+
20+instance functorConst :: Functor (Const a) where
21+ (<$>) _ (Const a) = Const a
22+
23+instance applyConst :: (Semigroup a) => Apply (Const a) where
24+ (<*>) (Const a1) (Const a2) = Const (a1 <> a2)
25+
26+example2 :: Const String Unit
27+example2 = do
28+ Const "Do"
29+ Const " notation"
30+ Const " for"
31+ Const " Apply"
32+ where
33+ (>>=) x f = x *> f unit
34+
35+main = do
36+ Debug.Trace.trace example1
37+ Debug.Trace.trace $ runConst example2
src/Language/PureScript/Sugar/DoNotation.hs+1−4
@@ -44,11 +44,8 @@ desugarDo d =
44 let (f, _, _) = everywhereOnValuesM return replace return
44 let (f, _, _) = everywhereOnValuesM return replace return
45 in f d
45 in f d
46 where
46 where
47− prelude :: ModuleName
48− prelude = ModuleName [ProperName C.prelude]
49−
50 bind :: Expr
47 bind :: Expr
51− bind = Var (Qualified (Just prelude) (Op (C.>>=)))
48+ bind = Var (Qualified Nothing (Op (C.>>=)))
52
49
53 replace :: Expr -> m Expr
50 replace :: Expr -> m Expr
54 replace (Do els) = go els
51 replace (Do els) = go els