1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00

Arrow instance, why not

This commit is contained in:
Patrick Thomson 2018-11-05 11:06:59 -05:00
parent 292a268b00
commit 688219e380
3 changed files with 13 additions and 4 deletions

View File

@ -30,9 +30,10 @@ module Control.Matching
) where
import Prelude hiding (id, (.))
import Prologue hiding (project)
import Prologue hiding (First, project)
import Control.Category
import Control.Arrow
import Data.Sum
import Data.Term
@ -54,6 +55,7 @@ data Matcher t a where
Target :: Matcher t t
Empty :: Matcher t a
Comp :: Matcher b c -> Matcher a b -> Matcher a c
Split :: Matcher b c -> Matcher b' c' -> Matcher (b, b') (c, c')
-- We could have implemented this by changing the semantics of how Then is interpreted, but that would make Then and Sequence inconsistent.
Match :: (t -> Maybe u) -> Matcher u a -> Matcher t a
Pure :: a -> Matcher t a
@ -82,6 +84,10 @@ instance Category Matcher where
id = Target
(.) = Comp
instance Arrow Matcher where
(***) = Split
arr = purely
-- | This matcher always succeeds.
succeeds :: Matcher t ()
succeeds = guard True
@ -196,3 +202,4 @@ matchOne t (Comp g f) = matchOne t f >>= \x -> matchOne x g
matchOne _ (Pure a) = pure a
matchOne _ Empty = empty
matchOne t (Then m f) = matchOne t m >>= matchOne t . f
matchOne t (Split f g) = matchOne t id >>= \(a, b) -> (,) <$> matchOne a f <*> matchOne b g

View File

@ -376,9 +376,6 @@ paraM f = liftM snd . cataM run
a <- f t
pure (embed $ fmap fst t, a)
eitherA :: Applicative f => (b -> f (Either a c)) -> Either a b -> f (Either a c)
eitherA = either (pure . Left)
-- | As 'rewriteM', but with some parameters reversed.
runE :: forall m env from to . Monad m
=> env

View File

@ -1,6 +1,7 @@
{-# LANGUAGE UndecidableInstances #-}
module Prologue
( module X
, eitherA
, foldMapA
, maybeM
, maybeLast
@ -72,3 +73,7 @@ fromMaybeLast b = fromMaybe b . getLast . foldMap (Last . Just)
-- | Extract the 'Just' of a 'Maybe' in an 'Applicative' context or, given 'Nothing', run the provided action.
maybeM :: Applicative f => f a -> Maybe a -> f a
maybeM f = maybe f pure
-- Promote a function to either-applicatives.
eitherA :: Applicative f => (b -> f (Either a c)) -> Either a b -> f (Either a c)
eitherA = either (pure . Left)