{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
module Data.Functor.Alt
( Alt(..)
, module Data.Functor.Apply
) where
import Control.Applicative hiding (some, many)
import Control.Arrow
import Control.Exception (catch, SomeException)
import Control.Monad
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import Data.Functor.Apply
import Data.Functor.Bind
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
import Data.Semigroup
import Data.List.NonEmpty (NonEmpty(..))
import Data.Sequence (Seq)
import qualified Data.Map as Map
import Data.Map (Map)
import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++))
infixl 3 <!>
class Functor f => Alt f where
(<!>) :: f a -> f a -> f a
some :: Applicative f => f a -> f [a]
some v = some_v
where many_v = some_v <!> pure []
some_v = (:) <$> v <*> many_v
many :: Applicative f => f a -> f [a]
many v = many_v
where many_v = some_v <!> pure []
some_v = (:) <$> v <*> many_v
instance Alt (Either a) where
Left _ <!> b = b
a <!> _ = a
instance Alt IO where
m <!> n = catch m (go n) where
go :: x -> SomeException -> x
go = const
instance Alt [] where
(<!>) = (++)
instance Alt Maybe where
Nothing <!> b = b
a <!> _ = a
instance Alt Option where
(<!>) = (<|>)
instance MonadPlus m => Alt (WrappedMonad m) where
(<!>) = (<|>)
instance ArrowPlus a => Alt (WrappedArrow a b) where
(<!>) = (<|>)
instance Ord k => Alt (Map k) where
(<!>) = Map.union
instance Alt IntMap where
(<!>) = IntMap.union
instance Alt Seq where
(<!>) = mappend
instance Alt NonEmpty where
(a :| as) <!> ~(b :| bs) = a :| (as ++ b : bs)
instance Alternative f => Alt (WrappedApplicative f) where
WrapApplicative a <!> WrapApplicative b = WrapApplicative (a <|> b)
instance Alt f => Alt (IdentityT f) where
IdentityT a <!> IdentityT b = IdentityT (a <!> b)
instance Alt f => Alt (ReaderT e f) where
ReaderT a <!> ReaderT b = ReaderT $ \e -> a e <!> b e
instance (Bind f, Monad f) => Alt (MaybeT f) where
MaybeT a <!> MaybeT b = MaybeT $ do
v <- a
case v of
Nothing -> b
Just _ -> return v
instance (Bind f, Monad f) => Alt (ErrorT e f) where
ErrorT m <!> ErrorT n = ErrorT $ do
a <- m
case a of
Left _ -> n
Right r -> return (Right r)
instance Apply f => Alt (ListT f) where
ListT a <!> ListT b = ListT $ (<!>) <$> a <.> b
instance Alt f => Alt (Strict.StateT e f) where
Strict.StateT m <!> Strict.StateT n = Strict.StateT $ \s -> m s <!> n s
instance Alt f => Alt (Lazy.StateT e f) where
Lazy.StateT m <!> Lazy.StateT n = Lazy.StateT $ \s -> m s <!> n s
instance Alt f => Alt (Strict.WriterT w f) where
Strict.WriterT m <!> Strict.WriterT n = Strict.WriterT $ m <!> n
instance Alt f => Alt (Lazy.WriterT w f) where
Lazy.WriterT m <!> Lazy.WriterT n = Lazy.WriterT $ m <!> n
instance Alt f => Alt (Strict.RWST r w s f) where
Strict.RWST m <!> Strict.RWST n = Strict.RWST $ \r s -> m r s <!> n r s
instance Alt f => Alt (Lazy.RWST r w s f) where
Lazy.RWST m <!> Lazy.RWST n = Lazy.RWST $ \r s -> m r s <!> n r s