@@ -25,7 +25,7 @@ import Control.Applicative (Applicative(..), Alternative(..))
2525import qualified Control.Category as C
2626import Control.Category ((>>>))
2727import qualified Control.Arrow as A
28−import Control.Arrow ((***))
28+import Control.Arrow ((***), (<+>))
2929
3030import PureScript.Names
3131import PureScript.Values
@@ -39,36 +39,28 @@ identToJs (Op op) = concatMap opCharToString op
3939 opCharToString :: Char -> String
4040 opCharToString = (:) '$'. show . ord
4141
42−newtype Pattern a b = Pattern { runPattern :: A.Kleisli Maybe a b } deriving (C.Category, A.Arrow)
43−
44−pattern :: Pattern a b -> a -> Maybe b
45−pattern = A.runKleisli . runPattern
42+newtype Pattern a b = Pattern { runPattern :: A.Kleisli Maybe a b } deriving (C.Category, A.Arrow, A.ArrowZero, A.ArrowPlus)
4643
4744instance Functor (Pattern a) where
48− fmap f p = Pattern $ A.Kleisli $ fmap f . pattern p
45+ fmap f (Pattern p) = Pattern $ A.Kleisli $ fmap f . A.runKleisli p
4946
50−instance Applicative (Pattern a) where
51− pure = Pattern . A.Kleisli . const . pure
52− f <*> x = Pattern . A.Kleisli $ \a -> pattern f a <*> pattern x a
53−
54−instance Alternative (Pattern a) where
55− empty = Pattern $ A.Kleisli $ \a -> empty
56− (Pattern (A.Kleisli p)) <|> (Pattern (A.Kleisli q)) = Pattern $ A.Kleisli $ \a -> p a <|> q a
47+pattern :: Pattern a b -> a -> Maybe b
48+pattern = A.runKleisli . runPattern
5749
5850parens :: String -> String
5951parens s = ('(':s) ++ ")"
6052
6153chainl :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r
62−chainl split f p = fix $ \c -> (split >>> (c *** p) >>> A.arr (uncurry f)) <|> p
54+chainl split f p = fix $ \c -> (split >>> ((c <+> p) *** p) >>> A.arr (uncurry f))
6355
6456chainr :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r
65−chainr split f p = fix $ \c -> (split >>> (p *** c) >>> A.arr (uncurry f)) <|> p
57+chainr split f p = fix $ \c -> (split >>> (p *** (c <+> p)) >>> A.arr (uncurry f))
6658
6759wrap :: Pattern a (s, a) -> (s -> r -> r) -> Pattern a r -> Pattern a r
68−wrap split f p = fix $ \c -> (split >>> (C.id *** c) >>> A.arr (uncurry f)) <|> p
60+wrap split f p = fix $ \c -> (split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f))
6961
7062split :: Pattern a (s, t) -> (s -> t -> r) -> Pattern a r -> Pattern a r
71−split s f p = (s >>> A.arr (uncurry f)) <|> p
63+split s f p = (s >>> A.arr (uncurry f))
7264
7365data OperatorTable a r = OperatorTable { runOperatorTable :: [ [Operator a r] ] }
7466
@@ -79,10 +71,10 @@ data Operator a r where
7971 Split :: Pattern a (s, t) -> (s -> t -> r) -> Operator a r
8072
8173buildPrettyPrinter :: OperatorTable a r -> Pattern a r -> Pattern a r
82−buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<|>) (flip map ops $ \op ->
74+buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<+>) (flip map ops $ \op ->
8375 case op of
8476 AssocL pat g -> chainl pat g p'
8577 AssocR pat g -> chainr pat g p'
8678 Wrap pat g -> wrap pat g p'
8779 Split pat g -> split pat g p'
88− )) p $ runOperatorTable table
80+ ) <+> p') p $ runOperatorTable table