mirror of
https://github.com/github/semantic.git
synced 2024-12-29 18:06:14 +03:00
Arrow instance, why not
This commit is contained in:
parent
292a268b00
commit
688219e380
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user