diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers')
37 files changed, 0 insertions, 7695 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/BUILD.bazel b/third_party/bazel/rules_haskell/examples/transformers/BUILD.bazel deleted file mode 100644 index 092111f9f1..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/BUILD.bazel +++ /dev/null @@ -1,19 +0,0 @@ -load( - "@io_tweag_rules_haskell//haskell:haskell.bzl", - "haskell_cc_import", - "haskell_library", - "haskell_toolchain_library", -) - -haskell_toolchain_library(name = "base") - -haskell_library( - name = "transformers", - srcs = glob([ - "Data/**/*.hs", - "Control/**/*.hs", - ]), - version = "0", - visibility = ["//visibility:public"], - deps = [":base"], -) diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Backwards.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Backwards.hs deleted file mode 100644 index 7ed74acbac..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Backwards.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Applicative.Backwards --- Copyright : (c) Russell O'Connor 2009 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Making functors with an 'Applicative' instance that performs actions --- in the reverse order. ------------------------------------------------------------------------------ - -module Control.Applicative.Backwards ( - Backwards(..), - ) where - -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length) -import Control.Applicative -import Data.Foldable -import Data.Traversable - --- | The same functor, but with an 'Applicative' instance that performs --- actions in the reverse order. -newtype Backwards f a = Backwards { forwards :: f a } - -instance (Eq1 f) => Eq1 (Backwards f) where - liftEq eq (Backwards x) (Backwards y) = liftEq eq x y - {-# INLINE liftEq #-} - -instance (Ord1 f) => Ord1 (Backwards f) where - liftCompare comp (Backwards x) (Backwards y) = liftCompare comp x y - {-# INLINE liftCompare #-} - -instance (Read1 f) => Read1 (Backwards f) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp rl) "Backwards" Backwards - -instance (Show1 f) => Show1 (Backwards f) where - liftShowsPrec sp sl d (Backwards x) = - showsUnaryWith (liftShowsPrec sp sl) "Backwards" d x - -instance (Eq1 f, Eq a) => Eq (Backwards f a) where (==) = eq1 -instance (Ord1 f, Ord a) => Ord (Backwards f a) where compare = compare1 -instance (Read1 f, Read a) => Read (Backwards f a) where readsPrec = readsPrec1 -instance (Show1 f, Show a) => Show (Backwards f a) where showsPrec = showsPrec1 - --- | Derived instance. -instance (Functor f) => Functor (Backwards f) where - fmap f (Backwards a) = Backwards (fmap f a) - {-# INLINE fmap #-} - --- | Apply @f@-actions in the reverse order. -instance (Applicative f) => Applicative (Backwards f) where - pure a = Backwards (pure a) - {-# INLINE pure #-} - Backwards f <*> Backwards a = Backwards (a <**> f) - {-# INLINE (<*>) #-} - --- | Try alternatives in the same order as @f@. -instance (Alternative f) => Alternative (Backwards f) where - empty = Backwards empty - {-# INLINE empty #-} - Backwards x <|> Backwards y = Backwards (x <|> y) - {-# INLINE (<|>) #-} - --- | Derived instance. -instance (Foldable f) => Foldable (Backwards f) where - foldMap f (Backwards t) = foldMap f t - {-# INLINE foldMap #-} - foldr f z (Backwards t) = foldr f z t - {-# INLINE foldr #-} - foldl f z (Backwards t) = foldl f z t - {-# INLINE foldl #-} - foldr1 f (Backwards t) = foldr1 f t - {-# INLINE foldr1 #-} - foldl1 f (Backwards t) = foldl1 f t - {-# INLINE foldl1 #-} -#if MIN_VERSION_base(4,8,0) - null (Backwards t) = null t - length (Backwards t) = length t -#endif - --- | Derived instance. -instance (Traversable f) => Traversable (Backwards f) where - traverse f (Backwards t) = fmap Backwards (traverse f t) - {-# INLINE traverse #-} - sequenceA (Backwards t) = fmap Backwards (sequenceA t) - {-# INLINE sequenceA #-} - -#if MIN_VERSION_base(4,12,0) --- | Derived instance. -instance Contravariant f => Contravariant (Backwards f) where - contramap f = Backwards . contramap f . forwards - {-# INLINE contramap #-} -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Lift.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Lift.hs deleted file mode 100644 index 8d35e288c0..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Lift.hs +++ /dev/null @@ -1,165 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Applicative.Lift --- Copyright : (c) Ross Paterson 2010 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Adding a new kind of pure computation to an applicative functor. ------------------------------------------------------------------------------ - -module Control.Applicative.Lift ( - -- * Lifting an applicative - Lift(..), - unLift, - mapLift, - elimLift, - -- * Collecting errors - Errors, - runErrors, - failure, - eitherToErrors - ) where - -import Data.Functor.Classes - -import Control.Applicative -import Data.Foldable (Foldable(foldMap)) -import Data.Functor.Constant -import Data.Monoid (Monoid(..)) -import Data.Traversable (Traversable(traverse)) - --- | Applicative functor formed by adding pure computations to a given --- applicative functor. -data Lift f a = Pure a | Other (f a) - -instance (Eq1 f) => Eq1 (Lift f) where - liftEq eq (Pure x1) (Pure x2) = eq x1 x2 - liftEq _ (Pure _) (Other _) = False - liftEq _ (Other _) (Pure _) = False - liftEq eq (Other y1) (Other y2) = liftEq eq y1 y2 - {-# INLINE liftEq #-} - -instance (Ord1 f) => Ord1 (Lift f) where - liftCompare comp (Pure x1) (Pure x2) = comp x1 x2 - liftCompare _ (Pure _) (Other _) = LT - liftCompare _ (Other _) (Pure _) = GT - liftCompare comp (Other y1) (Other y2) = liftCompare comp y1 y2 - {-# INLINE liftCompare #-} - -instance (Read1 f) => Read1 (Lift f) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith rp "Pure" Pure `mappend` - readsUnaryWith (liftReadsPrec rp rl) "Other" Other - -instance (Show1 f) => Show1 (Lift f) where - liftShowsPrec sp _ d (Pure x) = showsUnaryWith sp "Pure" d x - liftShowsPrec sp sl d (Other y) = - showsUnaryWith (liftShowsPrec sp sl) "Other" d y - -instance (Eq1 f, Eq a) => Eq (Lift f a) where (==) = eq1 -instance (Ord1 f, Ord a) => Ord (Lift f a) where compare = compare1 -instance (Read1 f, Read a) => Read (Lift f a) where readsPrec = readsPrec1 -instance (Show1 f, Show a) => Show (Lift f a) where showsPrec = showsPrec1 - -instance (Functor f) => Functor (Lift f) where - fmap f (Pure x) = Pure (f x) - fmap f (Other y) = Other (fmap f y) - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (Lift f) where - foldMap f (Pure x) = f x - foldMap f (Other y) = foldMap f y - {-# INLINE foldMap #-} - -instance (Traversable f) => Traversable (Lift f) where - traverse f (Pure x) = Pure <$> f x - traverse f (Other y) = Other <$> traverse f y - {-# INLINE traverse #-} - --- | A combination is 'Pure' only if both parts are. -instance (Applicative f) => Applicative (Lift f) where - pure = Pure - {-# INLINE pure #-} - Pure f <*> Pure x = Pure (f x) - Pure f <*> Other y = Other (f <$> y) - Other f <*> Pure x = Other (($ x) <$> f) - Other f <*> Other y = Other (f <*> y) - {-# INLINE (<*>) #-} - --- | A combination is 'Pure' only either part is. -instance (Alternative f) => Alternative (Lift f) where - empty = Other empty - {-# INLINE empty #-} - Pure x <|> _ = Pure x - Other _ <|> Pure y = Pure y - Other x <|> Other y = Other (x <|> y) - {-# INLINE (<|>) #-} - --- | Projection to the other functor. -unLift :: (Applicative f) => Lift f a -> f a -unLift (Pure x) = pure x -unLift (Other e) = e -{-# INLINE unLift #-} - --- | Apply a transformation to the other computation. -mapLift :: (f a -> g a) -> Lift f a -> Lift g a -mapLift _ (Pure x) = Pure x -mapLift f (Other e) = Other (f e) -{-# INLINE mapLift #-} - --- | Eliminator for 'Lift'. --- --- * @'elimLift' f g . 'pure' = f@ --- --- * @'elimLift' f g . 'Other' = g@ --- -elimLift :: (a -> r) -> (f a -> r) -> Lift f a -> r -elimLift f _ (Pure x) = f x -elimLift _ g (Other e) = g e -{-# INLINE elimLift #-} - --- | An applicative functor that collects a monoid (e.g. lists) of errors. --- A sequence of computations fails if any of its components do, but --- unlike monads made with 'ExceptT' from "Control.Monad.Trans.Except", --- these computations continue after an error, collecting all the errors. --- --- * @'pure' f '<*>' 'pure' x = 'pure' (f x)@ --- --- * @'pure' f '<*>' 'failure' e = 'failure' e@ --- --- * @'failure' e '<*>' 'pure' x = 'failure' e@ --- --- * @'failure' e1 '<*>' 'failure' e2 = 'failure' (e1 '<>' e2)@ --- -type Errors e = Lift (Constant e) - --- | Extractor for computations with accumulating errors. --- --- * @'runErrors' ('pure' x) = 'Right' x@ --- --- * @'runErrors' ('failure' e) = 'Left' e@ --- -runErrors :: Errors e a -> Either e a -runErrors (Other (Constant e)) = Left e -runErrors (Pure x) = Right x -{-# INLINE runErrors #-} - --- | Report an error. -failure :: e -> Errors e a -failure e = Other (Constant e) -{-# INLINE failure #-} - --- | Convert from 'Either' to 'Errors' (inverse of 'runErrors'). -eitherToErrors :: Either e a -> Errors e a -eitherToErrors = either failure Pure diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Signatures.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Signatures.hs deleted file mode 100644 index ce128ee182..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Signatures.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Signatures --- Copyright : (c) Ross Paterson 2012 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Signatures for monad operations that require specialized lifting. --- Each signature has a uniformity property that the lifting should satisfy. ------------------------------------------------------------------------------ - -module Control.Monad.Signatures ( - CallCC, Catch, Listen, Pass - ) where - --- | Signature of the @callCC@ operation, --- introduced in "Control.Monad.Trans.Cont". --- Any lifting function @liftCallCC@ should satisfy --- --- * @'lift' (f k) = f' ('lift' . k) => 'lift' (cf f) = liftCallCC cf f'@ --- -type CallCC m a b = ((a -> m b) -> m a) -> m a - --- | Signature of the @catchE@ operation, --- introduced in "Control.Monad.Trans.Except". --- Any lifting function @liftCatch@ should satisfy --- --- * @'lift' (cf m f) = liftCatch ('lift' . cf) ('lift' f)@ --- -type Catch e m a = m a -> (e -> m a) -> m a - --- | Signature of the @listen@ operation, --- introduced in "Control.Monad.Trans.Writer". --- Any lifting function @liftListen@ should satisfy --- --- * @'lift' . liftListen = liftListen . 'lift'@ --- -type Listen w m a = m a -> m (a, w) - --- | Signature of the @pass@ operation, --- introduced in "Control.Monad.Trans.Writer". --- Any lifting function @liftPass@ should satisfy --- --- * @'lift' . liftPass = liftPass . 'lift'@ --- -type Pass w m a = m (a, w -> w) -> m a diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Accum.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Accum.hs deleted file mode 100644 index 0a85c43f62..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Accum.hs +++ /dev/null @@ -1,292 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Accum --- Copyright : (c) Nickolay Kudasov 2016 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The lazy 'AccumT' monad transformer, which adds accumulation --- capabilities (such as declarations or document patches) to a given monad. --- --- This monad transformer provides append-only accumulation --- during the computation. For more general access, use --- "Control.Monad.Trans.State" instead. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Accum ( - -- * The Accum monad - Accum, - accum, - runAccum, - execAccum, - evalAccum, - mapAccum, - -- * The AccumT monad transformer - AccumT(AccumT), - runAccumT, - execAccumT, - evalAccumT, - mapAccumT, - -- * Accum operations - look, - looks, - add, - -- * Lifting other operations - liftCallCC, - liftCallCC', - liftCatch, - liftListen, - liftPass, - -- * Monad transformations - readerToAccumT, - writerToAccumT, - accumToStateT, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.Reader (ReaderT(..)) -import Control.Monad.Trans.Writer (WriterT(..)) -import Control.Monad.Trans.State (StateT(..)) -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -import Control.Monad.Signatures -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid -#endif - --- --------------------------------------------------------------------------- --- | An accumulation monad parameterized by the type @w@ of output to accumulate. --- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. -type Accum w = AccumT w Identity - --- | Construct an accumulation computation from a (result, output) pair. --- (The inverse of 'runAccum'.) -accum :: (Monad m) => (w -> (a, w)) -> AccumT w m a -accum f = AccumT $ \ w -> return (f w) -{-# INLINE accum #-} - --- | Unwrap an accumulation computation as a (result, output) pair. --- (The inverse of 'accum'.) -runAccum :: Accum w a -> w -> (a, w) -runAccum m = runIdentity . runAccumT m -{-# INLINE runAccum #-} - --- | Extract the output from an accumulation computation. --- --- * @'execAccum' m w = 'snd' ('runAccum' m w)@ -execAccum :: Accum w a -> w -> w -execAccum m w = snd (runAccum m w) -{-# INLINE execAccum #-} - --- | Evaluate an accumulation computation with the given initial output history --- and return the final value, discarding the final output. --- --- * @'evalAccum' m w = 'fst' ('runAccum' m w)@ -evalAccum :: (Monoid w) => Accum w a -> w -> a -evalAccum m w = fst (runAccum m w) -{-# INLINE evalAccum #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runAccum' ('mapAccum' f m) = f . 'runAccum' m@ -mapAccum :: ((a, w) -> (b, w)) -> Accum w a -> Accum w b -mapAccum f = mapAccumT (Identity . f . runIdentity) -{-# INLINE mapAccum #-} - --- --------------------------------------------------------------------------- --- | An accumulation monad parameterized by: --- --- * @w@ - the output to accumulate. --- --- * @m@ - The inner monad. --- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. --- --- This monad transformer is similar to both state and writer monad transformers. --- Thus it can be seen as --- --- * a restricted append-only version of a state monad transformer or --- --- * a writer monad transformer with the extra ability to read all previous output. -newtype AccumT w m a = AccumT (w -> m (a, w)) - --- | Unwrap an accumulation computation. -runAccumT :: AccumT w m a -> w -> m (a, w) -runAccumT (AccumT f) = f -{-# INLINE runAccumT #-} - --- | Extract the output from an accumulation computation. --- --- * @'execAccumT' m w = 'liftM' 'snd' ('runAccumT' m w)@ -execAccumT :: (Monad m) => AccumT w m a -> w -> m w -execAccumT m w = do - ~(_, w') <- runAccumT m w - return w' -{-# INLINE execAccumT #-} - --- | Evaluate an accumulation computation with the given initial output history --- and return the final value, discarding the final output. --- --- * @'evalAccumT' m w = 'liftM' 'fst' ('runAccumT' m w)@ -evalAccumT :: (Monad m, Monoid w) => AccumT w m a -> w -> m a -evalAccumT m w = do - ~(a, _) <- runAccumT m w - return a -{-# INLINE evalAccumT #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runAccumT' ('mapAccumT' f m) = f . 'runAccumT' m@ -mapAccumT :: (m (a, w) -> n (b, w)) -> AccumT w m a -> AccumT w n b -mapAccumT f m = AccumT (f . runAccumT m) -{-# INLINE mapAccumT #-} - -instance (Functor m) => Functor (AccumT w m) where - fmap f = mapAccumT $ fmap $ \ ~(a, w) -> (f a, w) - {-# INLINE fmap #-} - -instance (Monoid w, Functor m, Monad m) => Applicative (AccumT w m) where - pure a = AccumT $ const $ return (a, mempty) - {-# INLINE pure #-} - mf <*> mv = AccumT $ \ w -> do - ~(f, w') <- runAccumT mf w - ~(v, w'') <- runAccumT mv (w `mappend` w') - return (f v, w' `mappend` w'') - {-# INLINE (<*>) #-} - -instance (Monoid w, Functor m, MonadPlus m) => Alternative (AccumT w m) where - empty = AccumT $ const mzero - {-# INLINE empty #-} - m <|> n = AccumT $ \ w -> runAccumT m w `mplus` runAccumT n w - {-# INLINE (<|>) #-} - -instance (Monoid w, Functor m, Monad m) => Monad (AccumT w m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = AccumT $ const $ return (a, mempty) - {-# INLINE return #-} -#endif - m >>= k = AccumT $ \ w -> do - ~(a, w') <- runAccumT m w - ~(b, w'') <- runAccumT (k a) (w `mappend` w') - return (b, w' `mappend` w'') - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = AccumT $ const (fail msg) - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (AccumT w m) where - fail msg = AccumT $ const (Fail.fail msg) - {-# INLINE fail #-} -#endif - -instance (Monoid w, Functor m, MonadPlus m) => MonadPlus (AccumT w m) where - mzero = AccumT $ const mzero - {-# INLINE mzero #-} - m `mplus` n = AccumT $ \ w -> runAccumT m w `mplus` runAccumT n w - {-# INLINE mplus #-} - -instance (Monoid w, Functor m, MonadFix m) => MonadFix (AccumT w m) where - mfix m = AccumT $ \ w -> mfix $ \ ~(a, _) -> runAccumT (m a) w - {-# INLINE mfix #-} - -instance (Monoid w) => MonadTrans (AccumT w) where - lift m = AccumT $ const $ do - a <- m - return (a, mempty) - {-# INLINE lift #-} - -instance (Monoid w, Functor m, MonadIO m) => MonadIO (AccumT w m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - --- | @'look'@ is an action that fetches all the previously accumulated output. -look :: (Monoid w, Monad m) => AccumT w m w -look = AccumT $ \ w -> return (w, mempty) - --- | @'look'@ is an action that retrieves a function of the previously accumulated output. -looks :: (Monoid w, Monad m) => (w -> a) -> AccumT w m a -looks f = AccumT $ \ w -> return (f w, mempty) - --- | @'add' w@ is an action that produces the output @w@. -add :: (Monad m) => w -> AccumT w m () -add w = accum $ const ((), w) -{-# INLINE add #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original output history on entering the --- continuation. -liftCallCC :: CallCC m (a, w) (b, w) -> CallCC (AccumT w m) a b -liftCallCC callCC f = AccumT $ \ w -> - callCC $ \ c -> - runAccumT (f (\ a -> AccumT $ \ _ -> c (a, w))) w -{-# INLINE liftCallCC #-} - --- | In-situ lifting of a @callCC@ operation to the new monad. --- This version uses the current output history on entering the continuation. --- It does not satisfy the uniformity property (see "Control.Monad.Signatures"). -liftCallCC' :: CallCC m (a, w) (b, w) -> CallCC (AccumT w m) a b -liftCallCC' callCC f = AccumT $ \ s -> - callCC $ \ c -> - runAccumT (f (\ a -> AccumT $ \ s' -> c (a, s'))) s -{-# INLINE liftCallCC' #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a, w) -> Catch e (AccumT w m) a -liftCatch catchE m h = - AccumT $ \ w -> runAccumT m w `catchE` \ e -> runAccumT (h e) w -{-# INLINE liftCatch #-} - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (a, s) -> Listen w (AccumT s m) a -liftListen listen m = AccumT $ \ s -> do - ~((a, s'), w) <- listen (runAccumT m s) - return ((a, w), s') -{-# INLINE liftListen #-} - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (a, s) -> Pass w (AccumT s m) a -liftPass pass m = AccumT $ \ s -> pass $ do - ~((a, f), s') <- runAccumT m s - return ((a, s'), f) -{-# INLINE liftPass #-} - --- | Convert a read-only computation into an accumulation computation. -readerToAccumT :: (Functor m, Monoid w) => ReaderT w m a -> AccumT w m a -readerToAccumT (ReaderT f) = AccumT $ \ w -> fmap (\ a -> (a, mempty)) (f w) -{-# INLINE readerToAccumT #-} - --- | Convert a writer computation into an accumulation computation. -writerToAccumT :: WriterT w m a -> AccumT w m a -writerToAccumT (WriterT m) = AccumT $ const $ m -{-# INLINE writerToAccumT #-} - --- | Convert an accumulation (append-only) computation into a fully --- stateful computation. -accumToStateT :: (Functor m, Monoid s) => AccumT s m a -> StateT s m a -accumToStateT (AccumT f) = - StateT $ \ w -> fmap (\ ~(a, w') -> (a, w `mappend` w')) (f w) -{-# INLINE accumToStateT #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Class.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Class.hs deleted file mode 100644 index b92bc0e8b0..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Class.hs +++ /dev/null @@ -1,262 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Class --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The class of monad transformers. --- --- A monad transformer makes a new monad out of an existing monad, such --- that computations of the old monad may be embedded in the new one. --- To construct a monad with a desired set of features, one typically --- starts with a base monad, such as 'Data.Functor.Identity.Identity', @[]@ or 'IO', and --- applies a sequence of monad transformers. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Class ( - -- * Transformer class - MonadTrans(..) - - -- * Conventions - -- $conventions - - -- * Strict monads - -- $strict - - -- * Examples - -- ** Parsing - -- $example1 - - -- ** Parsing and counting - -- $example2 - - -- ** Interpreter monad - -- $example3 - ) where - --- | The class of monad transformers. Instances should satisfy the --- following laws, which state that 'lift' is a monad transformation: --- --- * @'lift' . 'return' = 'return'@ --- --- * @'lift' (m >>= f) = 'lift' m >>= ('lift' . f)@ - -class MonadTrans t where - -- | Lift a computation from the argument monad to the constructed monad. - lift :: (Monad m) => m a -> t m a - -{- $conventions -Most monad transformer modules include the special case of applying -the transformer to 'Data.Functor.Identity.Identity'. For example, -@'Control.Monad.Trans.State.Lazy.State' s@ is an abbreviation for -@'Control.Monad.Trans.State.Lazy.StateT' s 'Data.Functor.Identity.Identity'@. - -Each monad transformer also comes with an operation @run@/XXX/@T@ to -unwrap the transformer, exposing a computation of the inner monad. -(Currently these functions are defined as field labels, but in the next -major release they will be separate functions.) - -All of the monad transformers except 'Control.Monad.Trans.Cont.ContT' -and 'Control.Monad.Trans.Cont.SelectT' are functors on the category -of monads: in addition to defining a mapping of monads, they -also define a mapping from transformations between base monads to -transformations between transformed monads, called @map@/XXX/@T@. -Thus given a monad transformation @t :: M a -> N a@, the combinator -'Control.Monad.Trans.State.Lazy.mapStateT' constructs a monad -transformation - -> mapStateT t :: StateT s M a -> StateT s N a - -For these monad transformers, 'lift' is a natural transformation in the -category of monads, i.e. for any monad transformation @t :: M a -> N a@, - -* @map@/XXX/@T t . 'lift' = 'lift' . t@ - -Each of the monad transformers introduces relevant operations. -In a sequence of monad transformers, most of these operations.can be -lifted through other transformers using 'lift' or the @map@/XXX/@T@ -combinator, but a few with more complex type signatures require -specialized lifting combinators, called @lift@/Op/ -(see "Control.Monad.Signatures"). --} - -{- $strict - -A monad is said to be /strict/ if its '>>=' operation is strict in its first -argument. The base monads 'Maybe', @[]@ and 'IO' are strict: - ->>> undefined >> return 2 :: Maybe Integer -*** Exception: Prelude.undefined - -However the monad 'Data.Functor.Identity.Identity' is not: - ->>> runIdentity (undefined >> return 2) -2 - -In a strict monad you know when each action is executed, but the monad -is not necessarily strict in the return value, or in other components -of the monad, such as a state. However you can use 'seq' to create -an action that is strict in the component you want evaluated. --} - -{- $example1 - -The first example is a parser monad in the style of - -* \"Monadic parsing in Haskell\", by Graham Hutton and Erik Meijer, -/Journal of Functional Programming/ 8(4):437-444, July 1998 -(<http://www.cs.nott.ac.uk/~pszgmh/bib.html#pearl>). - -We can define such a parser monad by adding a state (the 'String' remaining -to be parsed) to the @[]@ monad, which provides non-determinism: - -> import Control.Monad.Trans.State -> -> type Parser = StateT String [] - -Then @Parser@ is an instance of @MonadPlus@: monadic sequencing implements -concatenation of parsers, while @mplus@ provides choice. To use parsers, -we need a primitive to run a constructed parser on an input string: - -> runParser :: Parser a -> String -> [a] -> runParser p s = [x | (x, "") <- runStateT p s] - -Finally, we need a primitive parser that matches a single character, -from which arbitrarily complex parsers may be constructed: - -> item :: Parser Char -> item = do -> c:cs <- get -> put cs -> return c - -In this example we use the operations @get@ and @put@ from -"Control.Monad.Trans.State", which are defined only for monads that are -applications of 'Control.Monad.Trans.State.Lazy.StateT'. Alternatively one -could use monad classes from the @mtl@ package or similar, which contain -methods @get@ and @put@ with types generalized over all suitable monads. --} - -{- $example2 - -We can define a parser that also counts by adding a -'Control.Monad.Trans.Writer.Lazy.WriterT' transformer: - -> import Control.Monad.Trans.Class -> import Control.Monad.Trans.State -> import Control.Monad.Trans.Writer -> import Data.Monoid -> -> type Parser = WriterT (Sum Int) (StateT String []) - -The function that applies a parser must now unwrap each of the monad -transformers in turn: - -> runParser :: Parser a -> String -> [(a, Int)] -> runParser p s = [(x, n) | ((x, Sum n), "") <- runStateT (runWriterT p) s] - -To define the @item@ parser, we need to lift the -'Control.Monad.Trans.State.Lazy.StateT' operations through the -'Control.Monad.Trans.Writer.Lazy.WriterT' transformer. - -> item :: Parser Char -> item = do -> c:cs <- lift get -> lift (put cs) -> return c - -In this case, we were able to do this with 'lift', but operations with -more complex types require special lifting functions, which are provided -by monad transformers for which they can be implemented. If you use the -monad classes of the @mtl@ package or similar, this lifting is handled -automatically by the instances of the classes, and you need only use -the generalized methods @get@ and @put@. - -We can also define a primitive using the Writer: - -> tick :: Parser () -> tick = tell (Sum 1) - -Then the parser will keep track of how many @tick@s it executes. --} - -{- $example3 - -This example is a cut-down version of the one in - -* \"Monad Transformers and Modular Interpreters\", -by Sheng Liang, Paul Hudak and Mark Jones in /POPL'95/ -(<http://web.cecs.pdx.edu/~mpj/pubs/modinterp.html>). - -Suppose we want to define an interpreter that can do I\/O and has -exceptions, an environment and a modifiable store. We can define -a monad that supports all these things as a stack of monad transformers: - -> import Control.Monad.Trans.Class -> import Control.Monad.Trans.State -> import qualified Control.Monad.Trans.Reader as R -> import qualified Control.Monad.Trans.Except as E -> import Control.Monad.IO.Class -> -> type InterpM = StateT Store (R.ReaderT Env (E.ExceptT Err IO)) - -for suitable types @Store@, @Env@ and @Err@. - -Now we would like to be able to use the operations associated with each -of those monad transformers on @InterpM@ actions. Since the uppermost -monad transformer of @InterpM@ is 'Control.Monad.Trans.State.Lazy.StateT', -it already has the state operations @get@ and @set@. - -The first of the 'Control.Monad.Trans.Reader.ReaderT' operations, -'Control.Monad.Trans.Reader.ask', is a simple action, so we can lift it -through 'Control.Monad.Trans.State.Lazy.StateT' to @InterpM@ using 'lift': - -> ask :: InterpM Env -> ask = lift R.ask - -The other 'Control.Monad.Trans.Reader.ReaderT' operation, -'Control.Monad.Trans.Reader.local', has a suitable type for lifting -using 'Control.Monad.Trans.State.Lazy.mapStateT': - -> local :: (Env -> Env) -> InterpM a -> InterpM a -> local f = mapStateT (R.local f) - -We also wish to lift the operations of 'Control.Monad.Trans.Except.ExceptT' -through both 'Control.Monad.Trans.Reader.ReaderT' and -'Control.Monad.Trans.State.Lazy.StateT'. For the operation -'Control.Monad.Trans.Except.throwE', we know @throwE e@ is a simple -action, so we can lift it through the two monad transformers to @InterpM@ -with two 'lift's: - -> throwE :: Err -> InterpM a -> throwE e = lift (lift (E.throwE e)) - -The 'Control.Monad.Trans.Except.catchE' operation has a more -complex type, so we need to use the special-purpose lifting function -@liftCatch@ provided by most monad transformers. Here we use -the 'Control.Monad.Trans.Reader.ReaderT' version followed by the -'Control.Monad.Trans.State.Lazy.StateT' version: - -> catchE :: InterpM a -> (Err -> InterpM a) -> InterpM a -> catchE = liftCatch (R.liftCatch E.catchE) - -We could lift 'IO' actions to @InterpM@ using three 'lift's, but @InterpM@ -is automatically an instance of 'Control.Monad.IO.Class.MonadIO', -so we can use 'Control.Monad.IO.Class.liftIO' instead: - -> putStr :: String -> InterpM () -> putStr s = liftIO (Prelude.putStr s) - --} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs deleted file mode 100644 index ce2005d4b2..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs +++ /dev/null @@ -1,240 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Cont --- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Continuation monads. --- --- Delimited continuation operators are taken from Kenichi Asai and Oleg --- Kiselyov's tutorial at CW 2011, \"Introduction to programming with --- shift and reset\" (<http://okmij.org/ftp/continuations/#tutorial>). --- ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Cont ( - -- * The Cont monad - Cont, - cont, - runCont, - evalCont, - mapCont, - withCont, - -- ** Delimited continuations - reset, shift, - -- * The ContT monad transformer - ContT(..), - evalContT, - mapContT, - withContT, - callCC, - -- ** Delimited continuations - resetT, shiftT, - -- * Lifting other operations - liftLocal, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Data.Functor.Identity - -import Control.Applicative -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif - -{- | -Continuation monad. -@Cont r a@ is a CPS ("continuation-passing style") computation that produces an -intermediate result of type @a@ within a CPS computation whose final result type -is @r@. - -The @return@ function simply creates a continuation which passes the value on. - -The @>>=@ operator adds the bound function into the continuation chain. --} -type Cont r = ContT r Identity - --- | Construct a continuation-passing computation from a function. --- (The inverse of 'runCont') -cont :: ((a -> r) -> r) -> Cont r a -cont f = ContT (\ c -> Identity (f (runIdentity . c))) -{-# INLINE cont #-} - --- | The result of running a CPS computation with a given final continuation. --- (The inverse of 'cont') -runCont - :: Cont r a -- ^ continuation computation (@Cont@). - -> (a -> r) -- ^ the final continuation, which produces - -- the final result (often 'id'). - -> r -runCont m k = runIdentity (runContT m (Identity . k)) -{-# INLINE runCont #-} - --- | The result of running a CPS computation with the identity as the --- final continuation. --- --- * @'evalCont' ('return' x) = x@ -evalCont :: Cont r r -> r -evalCont m = runIdentity (evalContT m) -{-# INLINE evalCont #-} - --- | Apply a function to transform the result of a continuation-passing --- computation. --- --- * @'runCont' ('mapCont' f m) = f . 'runCont' m@ -mapCont :: (r -> r) -> Cont r a -> Cont r a -mapCont f = mapContT (Identity . f . runIdentity) -{-# INLINE mapCont #-} - --- | Apply a function to transform the continuation passed to a CPS --- computation. --- --- * @'runCont' ('withCont' f m) = 'runCont' m . f@ -withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b -withCont f = withContT ((Identity .) . f . (runIdentity .)) -{-# INLINE withCont #-} - --- | @'reset' m@ delimits the continuation of any 'shift' inside @m@. --- --- * @'reset' ('return' m) = 'return' m@ --- -reset :: Cont r r -> Cont r' r -reset = resetT -{-# INLINE reset #-} - --- | @'shift' f@ captures the continuation up to the nearest enclosing --- 'reset' and passes it to @f@: --- --- * @'reset' ('shift' f >>= k) = 'reset' (f ('evalCont' . k))@ --- -shift :: ((a -> r) -> Cont r r) -> Cont r a -shift f = shiftT (f . (runIdentity .)) -{-# INLINE shift #-} - --- | The continuation monad transformer. --- Can be used to add continuation handling to any type constructor: --- the 'Monad' instance and most of the operations do not require @m@ --- to be a monad. --- --- 'ContT' is not a functor on the category of monads, and many operations --- cannot be lifted through it. -newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } - --- | The result of running a CPS computation with 'return' as the --- final continuation. --- --- * @'evalContT' ('lift' m) = m@ -evalContT :: (Monad m) => ContT r m r -> m r -evalContT m = runContT m return -{-# INLINE evalContT #-} - --- | Apply a function to transform the result of a continuation-passing --- computation. This has a more restricted type than the @map@ operations --- for other monad transformers, because 'ContT' does not define a functor --- in the category of monads. --- --- * @'runContT' ('mapContT' f m) = f . 'runContT' m@ -mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a -mapContT f m = ContT $ f . runContT m -{-# INLINE mapContT #-} - --- | Apply a function to transform the continuation passed to a CPS --- computation. --- --- * @'runContT' ('withContT' f m) = 'runContT' m . f@ -withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b -withContT f m = ContT $ runContT m . f -{-# INLINE withContT #-} - -instance Functor (ContT r m) where - fmap f m = ContT $ \ c -> runContT m (c . f) - {-# INLINE fmap #-} - -instance Applicative (ContT r m) where - pure x = ContT ($ x) - {-# INLINE pure #-} - f <*> v = ContT $ \ c -> runContT f $ \ g -> runContT v (c . g) - {-# INLINE (<*>) #-} - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - -instance Monad (ContT r m) where -#if !(MIN_VERSION_base(4,8,0)) - return x = ContT ($ x) - {-# INLINE return #-} -#endif - m >>= k = ContT $ \ c -> runContT m (\ x -> runContT (k x) c) - {-# INLINE (>>=) #-} - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (ContT r m) where - fail msg = ContT $ \ _ -> Fail.fail msg - {-# INLINE fail #-} -#endif - -instance MonadTrans (ContT r) where - lift m = ContT (m >>=) - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (ContT r m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - --- | @callCC@ (call-with-current-continuation) calls its argument --- function, passing it the current continuation. It provides --- an escape continuation mechanism for use with continuation --- monads. Escape continuations one allow to abort the current --- computation and return a value immediately. They achieve --- a similar effect to 'Control.Monad.Trans.Except.throwE' --- and 'Control.Monad.Trans.Except.catchE' within an --- 'Control.Monad.Trans.Except.ExceptT' monad. The advantage of this --- function over calling 'return' is that it makes the continuation --- explicit, allowing more flexibility and better control. --- --- The standard idiom used with @callCC@ is to provide a lambda-expression --- to name the continuation. Then calling the named continuation anywhere --- within its scope will escape from the computation, even if it is many --- layers deep within nested computations. -callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a -callCC f = ContT $ \ c -> runContT (f (\ x -> ContT $ \ _ -> c x)) c -{-# INLINE callCC #-} - --- | @'resetT' m@ delimits the continuation of any 'shiftT' inside @m@. --- --- * @'resetT' ('lift' m) = 'lift' m@ --- -resetT :: (Monad m) => ContT r m r -> ContT r' m r -resetT = lift . evalContT -{-# INLINE resetT #-} - --- | @'shiftT' f@ captures the continuation up to the nearest enclosing --- 'resetT' and passes it to @f@: --- --- * @'resetT' ('shiftT' f >>= k) = 'resetT' (f ('evalContT' . k))@ --- -shiftT :: (Monad m) => ((a -> m r) -> ContT r m r) -> ContT r m a -shiftT f = ContT (evalContT . f) -{-# INLINE shiftT #-} - --- | @'liftLocal' ask local@ yields a @local@ function for @'ContT' r m@. -liftLocal :: (Monad m) => m r' -> ((r' -> r') -> m r -> m r) -> - (r' -> r') -> ContT r m a -> ContT r m a -liftLocal ask local f m = ContT $ \ c -> do - r <- ask - local f (runContT m (local (const r) . c)) -{-# INLINE liftLocal #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs deleted file mode 100644 index 6eda4b3e01..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs +++ /dev/null @@ -1,333 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif -#if !(MIN_VERSION_base(4,9,0)) -{-# OPTIONS_GHC -fno-warn-orphans #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Error --- Copyright : (c) Michael Weber <michael.weber@post.rwth-aachen.de> 2001, --- (c) Jeff Newbern 2003-2006, --- (c) Andriy Palamarchuk 2006 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- This monad transformer adds the ability to fail or throw exceptions --- to a monad. --- --- A sequence of actions succeeds, producing a value, only if all the --- actions in the sequence are successful. If one fails with an error, --- the rest of the sequence is skipped and the composite action fails --- with that error. --- --- If the value of the error is not required, the variant in --- "Control.Monad.Trans.Maybe" may be used instead. --- --- /Note:/ This module will be removed in a future release. --- Instead, use "Control.Monad.Trans.Except", which does not restrict --- the exception type, and also includes a base exception monad. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Error - {-# DEPRECATED "Use Control.Monad.Trans.Except instead" #-} ( - -- * The ErrorT monad transformer - Error(..), - ErrorList(..), - ErrorT(..), - mapErrorT, - -- * Error operations - throwError, - catchError, - -- * Lifting other operations - liftCallCC, - liftListen, - liftPass, - -- * Examples - -- $examples - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Control.Exception (IOException) -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -#if !(MIN_VERSION_base(4,6,0)) -import Control.Monad.Instances () -- deprecated from base-4.6 -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Monoid (mempty) -import Data.Traversable (Traversable(traverse)) -import System.IO.Error - -#if !(MIN_VERSION_base(4,9,0)) --- These instances are in base-4.9.0 - -instance MonadPlus IO where - mzero = ioError (userError "mzero") - m `mplus` n = m `catchIOError` \ _ -> n - -instance Alternative IO where - empty = mzero - (<|>) = mplus - -# if !(MIN_VERSION_base(4,4,0)) --- exported by System.IO.Error from base-4.4 -catchIOError :: IO a -> (IOError -> IO a) -> IO a -catchIOError = catch -# endif -#endif - -instance (Error e) => Alternative (Either e) where - empty = Left noMsg - Left _ <|> n = n - m <|> _ = m - -instance (Error e) => MonadPlus (Either e) where - mzero = Left noMsg - Left _ `mplus` n = n - m `mplus` _ = m - -#if !(MIN_VERSION_base(4,3,0)) --- These instances are in base-4.3 - -instance Applicative (Either e) where - pure = Right - Left e <*> _ = Left e - Right f <*> r = fmap f r - -instance Monad (Either e) where - return = Right - Left l >>= _ = Left l - Right r >>= k = k r - -instance MonadFix (Either e) where - mfix f = let - a = f $ case a of - Right r -> r - _ -> error "empty mfix argument" - in a - -#endif /* base to 4.2.0.x */ - --- | An exception to be thrown. --- --- Minimal complete definition: 'noMsg' or 'strMsg'. -class Error a where - -- | Creates an exception without a message. - -- The default implementation is @'strMsg' \"\"@. - noMsg :: a - -- | Creates an exception with a message. - -- The default implementation of @'strMsg' s@ is 'noMsg'. - strMsg :: String -> a - - noMsg = strMsg "" - strMsg _ = noMsg - -instance Error IOException where - strMsg = userError - --- | A string can be thrown as an error. -instance (ErrorList a) => Error [a] where - strMsg = listMsg - --- | Workaround so that we can have a Haskell 98 instance @'Error' 'String'@. -class ErrorList a where - listMsg :: String -> [a] - -instance ErrorList Char where - listMsg = id - --- | The error monad transformer. It can be used to add error handling --- to other monads. --- --- The @ErrorT@ Monad structure is parameterized over two things: --- --- * e - The error type. --- --- * m - The inner monad. --- --- The 'return' function yields a successful computation, while @>>=@ --- sequences two subcomputations, failing on the first error. -newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) } - -instance (Eq e, Eq1 m) => Eq1 (ErrorT e m) where - liftEq eq (ErrorT x) (ErrorT y) = liftEq (liftEq eq) x y - -instance (Ord e, Ord1 m) => Ord1 (ErrorT e m) where - liftCompare comp (ErrorT x) (ErrorT y) = liftCompare (liftCompare comp) x y - -instance (Read e, Read1 m) => Read1 (ErrorT e m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "ErrorT" ErrorT - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show e, Show1 m) => Show1 (ErrorT e m) where - liftShowsPrec sp sl d (ErrorT m) = - showsUnaryWith (liftShowsPrec sp' sl') "ErrorT" d m - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance (Eq e, Eq1 m, Eq a) => Eq (ErrorT e m a) where (==) = eq1 -instance (Ord e, Ord1 m, Ord a) => Ord (ErrorT e m a) where compare = compare1 -instance (Read e, Read1 m, Read a) => Read (ErrorT e m a) where - readsPrec = readsPrec1 -instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where - showsPrec = showsPrec1 - --- | Map the unwrapped computation using the given function. --- --- * @'runErrorT' ('mapErrorT' f m) = f ('runErrorT' m)@ -mapErrorT :: (m (Either e a) -> n (Either e' b)) - -> ErrorT e m a - -> ErrorT e' n b -mapErrorT f m = ErrorT $ f (runErrorT m) - -instance (Functor m) => Functor (ErrorT e m) where - fmap f = ErrorT . fmap (fmap f) . runErrorT - -instance (Foldable f) => Foldable (ErrorT e f) where - foldMap f (ErrorT a) = foldMap (either (const mempty) f) a - -instance (Traversable f) => Traversable (ErrorT e f) where - traverse f (ErrorT a) = - ErrorT <$> traverse (either (pure . Left) (fmap Right . f)) a - -instance (Functor m, Monad m) => Applicative (ErrorT e m) where - pure a = ErrorT $ return (Right a) - f <*> v = ErrorT $ do - mf <- runErrorT f - case mf of - Left e -> return (Left e) - Right k -> do - mv <- runErrorT v - case mv of - Left e -> return (Left e) - Right x -> return (Right (k x)) - -instance (Functor m, Monad m, Error e) => Alternative (ErrorT e m) where - empty = mzero - (<|>) = mplus - -instance (Monad m, Error e) => Monad (ErrorT e m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = ErrorT $ return (Right a) -#endif - m >>= k = ErrorT $ do - a <- runErrorT m - case a of - Left l -> return (Left l) - Right r -> runErrorT (k r) -#if !(MIN_VERSION_base(4,13,0)) - fail msg = ErrorT $ return (Left (strMsg msg)) -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monad m, Error e) => Fail.MonadFail (ErrorT e m) where - fail msg = ErrorT $ return (Left (strMsg msg)) -#endif - -instance (Monad m, Error e) => MonadPlus (ErrorT e m) where - mzero = ErrorT $ return (Left noMsg) - m `mplus` n = ErrorT $ do - a <- runErrorT m - case a of - Left _ -> runErrorT n - Right r -> return (Right r) - -instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where - mfix f = ErrorT $ mfix $ \ a -> runErrorT $ f $ case a of - Right r -> r - _ -> error "empty mfix argument" - -instance MonadTrans (ErrorT e) where - lift m = ErrorT $ do - a <- m - return (Right a) - -instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where - liftIO = lift . liftIO - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (ErrorT e m) where - contramap f = ErrorT . contramap (fmap f) . runErrorT -#endif - --- | Signal an error value @e@. --- --- * @'runErrorT' ('throwError' e) = 'return' ('Left' e)@ --- --- * @'throwError' e >>= m = 'throwError' e@ -throwError :: (Monad m) => e -> ErrorT e m a -throwError l = ErrorT $ return (Left l) - --- | Handle an error. --- --- * @'catchError' h ('lift' m) = 'lift' m@ --- --- * @'catchError' h ('throwError' e) = h e@ -catchError :: (Monad m) => - ErrorT e m a -- ^ the inner computation - -> (e -> ErrorT e m a) -- ^ a handler for errors in the inner - -- computation - -> ErrorT e m a -m `catchError` h = ErrorT $ do - a <- runErrorT m - case a of - Left l -> runErrorT (h l) - Right r -> return (Right r) - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ErrorT e m) a b -liftCallCC callCC f = ErrorT $ - callCC $ \ c -> - runErrorT (f (\ a -> ErrorT $ c (Right a))) - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ErrorT e m) a -liftListen listen = mapErrorT $ \ m -> do - (a, w) <- listen m - return $! fmap (\ r -> (r, w)) a - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ErrorT e m) a -liftPass pass = mapErrorT $ \ m -> pass $ do - a <- m - return $! case a of - Left l -> (Left l, id) - Right (r, f) -> (Right r, f) - -{- $examples - -Wrapping an IO action that can throw an error @e@: - -> type ErrorWithIO e a = ErrorT e IO a -> ==> ErrorT (IO (Either e a)) - -An IO monad wrapped in @StateT@ inside of @ErrorT@: - -> type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a -> ==> ErrorT (StateT s IO (Either e a)) -> ==> ErrorT (StateT (s -> IO (Either e a,s))) - --} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Except.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Except.hs deleted file mode 100644 index 477b9dd482..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Except.hs +++ /dev/null @@ -1,316 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Except --- Copyright : (C) 2013 Ross Paterson --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- This monad transformer extends a monad with the ability to throw exceptions. --- --- A sequence of actions terminates normally, producing a value, --- only if none of the actions in the sequence throws an exception. --- If one throws an exception, the rest of the sequence is skipped and --- the composite action exits with that exception. --- --- If the value of the exception is not required, the variant in --- "Control.Monad.Trans.Maybe" may be used instead. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Except ( - -- * The Except monad - Except, - except, - runExcept, - mapExcept, - withExcept, - -- * The ExceptT monad transformer - ExceptT(ExceptT), - runExceptT, - mapExceptT, - withExceptT, - -- * Exception operations - throwE, - catchE, - -- * Lifting other operations - liftCallCC, - liftListen, - liftPass, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Monoid -import Data.Traversable (Traversable(traverse)) - --- | The parameterizable exception monad. --- --- Computations are either exceptions or normal values. --- --- The 'return' function returns a normal value, while @>>=@ exits on --- the first exception. For a variant that continues after an error --- and collects all the errors, see 'Control.Applicative.Lift.Errors'. -type Except e = ExceptT e Identity - --- | Constructor for computations in the exception monad. --- (The inverse of 'runExcept'). -except :: (Monad m) => Either e a -> ExceptT e m a -except m = ExceptT (return m) -{-# INLINE except #-} - --- | Extractor for computations in the exception monad. --- (The inverse of 'except'). -runExcept :: Except e a -> Either e a -runExcept (ExceptT m) = runIdentity m -{-# INLINE runExcept #-} - --- | Map the unwrapped computation using the given function. --- --- * @'runExcept' ('mapExcept' f m) = f ('runExcept' m)@ -mapExcept :: (Either e a -> Either e' b) - -> Except e a - -> Except e' b -mapExcept f = mapExceptT (Identity . f . runIdentity) -{-# INLINE mapExcept #-} - --- | Transform any exceptions thrown by the computation using the given --- function (a specialization of 'withExceptT'). -withExcept :: (e -> e') -> Except e a -> Except e' a -withExcept = withExceptT -{-# INLINE withExcept #-} - --- | A monad transformer that adds exceptions to other monads. --- --- @ExceptT@ constructs a monad parameterized over two things: --- --- * e - The exception type. --- --- * m - The inner monad. --- --- The 'return' function yields a computation that produces the given --- value, while @>>=@ sequences two subcomputations, exiting on the --- first exception. -newtype ExceptT e m a = ExceptT (m (Either e a)) - -instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where - liftEq eq (ExceptT x) (ExceptT y) = liftEq (liftEq eq) x y - {-# INLINE liftEq #-} - -instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where - liftCompare comp (ExceptT x) (ExceptT y) = - liftCompare (liftCompare comp) x y - {-# INLINE liftCompare #-} - -instance (Read e, Read1 m) => Read1 (ExceptT e m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "ExceptT" ExceptT - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show e, Show1 m) => Show1 (ExceptT e m) where - liftShowsPrec sp sl d (ExceptT m) = - showsUnaryWith (liftShowsPrec sp' sl') "ExceptT" d m - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) - where (==) = eq1 -instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) - where compare = compare1 -instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where - readsPrec = readsPrec1 -instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where - showsPrec = showsPrec1 - --- | The inverse of 'ExceptT'. -runExceptT :: ExceptT e m a -> m (Either e a) -runExceptT (ExceptT m) = m -{-# INLINE runExceptT #-} - --- | Map the unwrapped computation using the given function. --- --- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@ -mapExceptT :: (m (Either e a) -> n (Either e' b)) - -> ExceptT e m a - -> ExceptT e' n b -mapExceptT f m = ExceptT $ f (runExceptT m) -{-# INLINE mapExceptT #-} - --- | Transform any exceptions thrown by the computation using the --- given function. -withExceptT :: (Functor m) => (e -> e') -> ExceptT e m a -> ExceptT e' m a -withExceptT f = mapExceptT $ fmap $ either (Left . f) Right -{-# INLINE withExceptT #-} - -instance (Functor m) => Functor (ExceptT e m) where - fmap f = ExceptT . fmap (fmap f) . runExceptT - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (ExceptT e f) where - foldMap f (ExceptT a) = foldMap (either (const mempty) f) a - {-# INLINE foldMap #-} - -instance (Traversable f) => Traversable (ExceptT e f) where - traverse f (ExceptT a) = - ExceptT <$> traverse (either (pure . Left) (fmap Right . f)) a - {-# INLINE traverse #-} - -instance (Functor m, Monad m) => Applicative (ExceptT e m) where - pure a = ExceptT $ return (Right a) - {-# INLINE pure #-} - ExceptT f <*> ExceptT v = ExceptT $ do - mf <- f - case mf of - Left e -> return (Left e) - Right k -> do - mv <- v - case mv of - Left e -> return (Left e) - Right x -> return (Right (k x)) - {-# INLINEABLE (<*>) #-} - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - -instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where - empty = ExceptT $ return (Left mempty) - {-# INLINE empty #-} - ExceptT mx <|> ExceptT my = ExceptT $ do - ex <- mx - case ex of - Left e -> liftM (either (Left . mappend e) Right) my - Right x -> return (Right x) - {-# INLINEABLE (<|>) #-} - -instance (Monad m) => Monad (ExceptT e m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = ExceptT $ return (Right a) - {-# INLINE return #-} -#endif - m >>= k = ExceptT $ do - a <- runExceptT m - case a of - Left e -> return (Left e) - Right x -> runExceptT (k x) - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail = ExceptT . fail - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (ExceptT e m) where - fail = ExceptT . Fail.fail - {-# INLINE fail #-} -#endif - -instance (Monad m, Monoid e) => MonadPlus (ExceptT e m) where - mzero = ExceptT $ return (Left mempty) - {-# INLINE mzero #-} - ExceptT mx `mplus` ExceptT my = ExceptT $ do - ex <- mx - case ex of - Left e -> liftM (either (Left . mappend e) Right) my - Right x -> return (Right x) - {-# INLINEABLE mplus #-} - -instance (MonadFix m) => MonadFix (ExceptT e m) where - mfix f = ExceptT (mfix (runExceptT . f . either (const bomb) id)) - where bomb = error "mfix (ExceptT): inner computation returned Left value" - {-# INLINE mfix #-} - -instance MonadTrans (ExceptT e) where - lift = ExceptT . liftM Right - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (ExceptT e m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip m) => MonadZip (ExceptT e m) where - mzipWith f (ExceptT a) (ExceptT b) = ExceptT $ mzipWith (liftA2 f) a b - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (ExceptT e m) where - contramap f = ExceptT . contramap (fmap f) . runExceptT - {-# INLINE contramap #-} -#endif - --- | Signal an exception value @e@. --- --- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@ --- --- * @'throwE' e >>= m = 'throwE' e@ -throwE :: (Monad m) => e -> ExceptT e m a -throwE = ExceptT . return . Left -{-# INLINE throwE #-} - --- | Handle an exception. --- --- * @'catchE' ('lift' m) h = 'lift' m@ --- --- * @'catchE' ('throwE' e) h = h e@ -catchE :: (Monad m) => - ExceptT e m a -- ^ the inner computation - -> (e -> ExceptT e' m a) -- ^ a handler for exceptions in the inner - -- computation - -> ExceptT e' m a -m `catchE` h = ExceptT $ do - a <- runExceptT m - case a of - Left l -> runExceptT (h l) - Right r -> return (Right r) -{-# INLINE catchE #-} - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b -liftCallCC callCC f = ExceptT $ - callCC $ \ c -> - runExceptT (f (\ a -> ExceptT $ c (Right a))) -{-# INLINE liftCallCC #-} - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ExceptT e m) a -liftListen listen = mapExceptT $ \ m -> do - (a, w) <- listen m - return $! fmap (\ r -> (r, w)) a -{-# INLINE liftListen #-} - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ExceptT e m) a -liftPass pass = mapExceptT $ \ m -> pass $ do - a <- m - return $! case a of - Left l -> (Left l, id) - Right (r, f) -> (Right r, f) -{-# INLINE liftPass #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Identity.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Identity.hs deleted file mode 100644 index 2a0db5e5a1..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Identity.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Identity --- Copyright : (c) 2007 Magnus Therning --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The identity monad transformer. --- --- This is useful for functions parameterized by a monad transformer. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Identity ( - -- * The identity monad transformer - IdentityT(..), - mapIdentityT, - -- * Lifting other operations - liftCatch, - liftCallCC, - ) where - -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Control.Monad.Signatures -import Control.Monad.Trans.Class (MonadTrans(lift)) -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Control.Monad (MonadPlus(mzero, mplus)) -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix (MonadFix(mfix)) -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable -import Data.Traversable (Traversable(traverse)) -import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length) - --- | The trivial monad transformer, which maps a monad to an equivalent monad. -newtype IdentityT f a = IdentityT { runIdentityT :: f a } - -instance (Eq1 f) => Eq1 (IdentityT f) where - liftEq eq (IdentityT x) (IdentityT y) = liftEq eq x y - {-# INLINE liftEq #-} - -instance (Ord1 f) => Ord1 (IdentityT f) where - liftCompare comp (IdentityT x) (IdentityT y) = liftCompare comp x y - {-# INLINE liftCompare #-} - -instance (Read1 f) => Read1 (IdentityT f) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp rl) "IdentityT" IdentityT - -instance (Show1 f) => Show1 (IdentityT f) where - liftShowsPrec sp sl d (IdentityT m) = - showsUnaryWith (liftShowsPrec sp sl) "IdentityT" d m - -instance (Eq1 f, Eq a) => Eq (IdentityT f a) where (==) = eq1 -instance (Ord1 f, Ord a) => Ord (IdentityT f a) where compare = compare1 -instance (Read1 f, Read a) => Read (IdentityT f a) where readsPrec = readsPrec1 -instance (Show1 f, Show a) => Show (IdentityT f a) where showsPrec = showsPrec1 - -instance (Functor m) => Functor (IdentityT m) where - fmap f = mapIdentityT (fmap f) - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (IdentityT f) where - foldMap f (IdentityT t) = foldMap f t - {-# INLINE foldMap #-} - foldr f z (IdentityT t) = foldr f z t - {-# INLINE foldr #-} - foldl f z (IdentityT t) = foldl f z t - {-# INLINE foldl #-} - foldr1 f (IdentityT t) = foldr1 f t - {-# INLINE foldr1 #-} - foldl1 f (IdentityT t) = foldl1 f t - {-# INLINE foldl1 #-} -#if MIN_VERSION_base(4,8,0) - null (IdentityT t) = null t - length (IdentityT t) = length t -#endif - -instance (Traversable f) => Traversable (IdentityT f) where - traverse f (IdentityT a) = IdentityT <$> traverse f a - {-# INLINE traverse #-} - -instance (Applicative m) => Applicative (IdentityT m) where - pure x = IdentityT (pure x) - {-# INLINE pure #-} - (<*>) = lift2IdentityT (<*>) - {-# INLINE (<*>) #-} - (*>) = lift2IdentityT (*>) - {-# INLINE (*>) #-} - (<*) = lift2IdentityT (<*) - {-# INLINE (<*) #-} - -instance (Alternative m) => Alternative (IdentityT m) where - empty = IdentityT empty - {-# INLINE empty #-} - (<|>) = lift2IdentityT (<|>) - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (IdentityT m) where -#if !(MIN_VERSION_base(4,8,0)) - return = IdentityT . return - {-# INLINE return #-} -#endif - m >>= k = IdentityT $ runIdentityT . k =<< runIdentityT m - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = IdentityT $ fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (IdentityT m) where - fail msg = IdentityT $ Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (MonadPlus m) => MonadPlus (IdentityT m) where - mzero = IdentityT mzero - {-# INLINE mzero #-} - mplus = lift2IdentityT mplus - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (IdentityT m) where - mfix f = IdentityT (mfix (runIdentityT . f)) - {-# INLINE mfix #-} - -instance (MonadIO m) => MonadIO (IdentityT m) where - liftIO = IdentityT . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip m) => MonadZip (IdentityT m) where - mzipWith f = lift2IdentityT (mzipWith f) - {-# INLINE mzipWith #-} -#endif - -instance MonadTrans IdentityT where - lift = IdentityT - {-# INLINE lift #-} - -#if MIN_VERSION_base(4,12,0) -instance Contravariant f => Contravariant (IdentityT f) where - contramap f = IdentityT . contramap f . runIdentityT - {-# INLINE contramap #-} -#endif - --- | Lift a unary operation to the new monad. -mapIdentityT :: (m a -> n b) -> IdentityT m a -> IdentityT n b -mapIdentityT f = IdentityT . f . runIdentityT -{-# INLINE mapIdentityT #-} - --- | Lift a binary operation to the new monad. -lift2IdentityT :: - (m a -> n b -> p c) -> IdentityT m a -> IdentityT n b -> IdentityT p c -lift2IdentityT f a b = IdentityT (f (runIdentityT a) (runIdentityT b)) -{-# INLINE lift2IdentityT #-} - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m a b -> CallCC (IdentityT m) a b -liftCallCC callCC f = - IdentityT $ callCC $ \ c -> runIdentityT (f (IdentityT . c)) -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m a -> Catch e (IdentityT m) a -liftCatch f m h = IdentityT $ f (runIdentityT m) (runIdentityT . h) -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/List.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/List.hs deleted file mode 100644 index 0bdbcc732e..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/List.hs +++ /dev/null @@ -1,185 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.List --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The ListT monad transformer, adding backtracking to a given monad, --- which must be commutative. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.List - {-# DEPRECATED "This transformer is invalid on most monads" #-} ( - -- * The ListT monad transformer - ListT(..), - mapListT, - -- * Lifting other operations - liftCallCC, - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Traversable (Traversable(traverse)) - --- | Parameterizable list monad, with an inner monad. --- --- /Note:/ this does not yield a monad unless the argument monad is commutative. -newtype ListT m a = ListT { runListT :: m [a] } - -instance (Eq1 m) => Eq1 (ListT m) where - liftEq eq (ListT x) (ListT y) = liftEq (liftEq eq) x y - {-# INLINE liftEq #-} - -instance (Ord1 m) => Ord1 (ListT m) where - liftCompare comp (ListT x) (ListT y) = liftCompare (liftCompare comp) x y - {-# INLINE liftCompare #-} - -instance (Read1 m) => Read1 (ListT m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "ListT" ListT - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show1 m) => Show1 (ListT m) where - liftShowsPrec sp sl d (ListT m) = - showsUnaryWith (liftShowsPrec sp' sl') "ListT" d m - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance (Eq1 m, Eq a) => Eq (ListT m a) where (==) = eq1 -instance (Ord1 m, Ord a) => Ord (ListT m a) where compare = compare1 -instance (Read1 m, Read a) => Read (ListT m a) where readsPrec = readsPrec1 -instance (Show1 m, Show a) => Show (ListT m a) where showsPrec = showsPrec1 - --- | Map between 'ListT' computations. --- --- * @'runListT' ('mapListT' f m) = f ('runListT' m)@ -mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b -mapListT f m = ListT $ f (runListT m) -{-# INLINE mapListT #-} - -instance (Functor m) => Functor (ListT m) where - fmap f = mapListT $ fmap $ map f - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (ListT f) where - foldMap f (ListT a) = foldMap (foldMap f) a - {-# INLINE foldMap #-} - -instance (Traversable f) => Traversable (ListT f) where - traverse f (ListT a) = ListT <$> traverse (traverse f) a - {-# INLINE traverse #-} - -instance (Applicative m) => Applicative (ListT m) where - pure a = ListT $ pure [a] - {-# INLINE pure #-} - f <*> v = ListT $ (<*>) <$> runListT f <*> runListT v - {-# INLINE (<*>) #-} - -instance (Applicative m) => Alternative (ListT m) where - empty = ListT $ pure [] - {-# INLINE empty #-} - m <|> n = ListT $ (++) <$> runListT m <*> runListT n - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (ListT m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = ListT $ return [a] - {-# INLINE return #-} -#endif - m >>= k = ListT $ do - a <- runListT m - b <- mapM (runListT . k) a - return (concat b) - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail _ = ListT $ return [] - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monad m) => Fail.MonadFail (ListT m) where - fail _ = ListT $ return [] - {-# INLINE fail #-} -#endif - -instance (Monad m) => MonadPlus (ListT m) where - mzero = ListT $ return [] - {-# INLINE mzero #-} - m `mplus` n = ListT $ do - a <- runListT m - b <- runListT n - return (a ++ b) - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (ListT m) where - mfix f = ListT $ mfix (runListT . f . head) >>= \ xs -> case xs of - [] -> return [] - x:_ -> liftM (x:) (runListT (mfix (mapListT (liftM tail) . f))) - {-# INLINE mfix #-} - -instance MonadTrans ListT where - lift m = ListT $ do - a <- m - return [a] - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (ListT m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip m) => MonadZip (ListT m) where - mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (ListT m) where - contramap f = ListT . contramap (fmap f) . runListT - {-# INLINE contramap #-} -#endif - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b -liftCallCC callCC f = ListT $ - callCC $ \ c -> - runListT (f (\ a -> ListT $ c [a])) -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m [a] -> Catch e (ListT m) a -liftCatch catchE m h = ListT $ runListT m - `catchE` \ e -> runListT (h e) -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Maybe.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Maybe.hs deleted file mode 100644 index f02b225444..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Maybe.hs +++ /dev/null @@ -1,241 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Maybe --- Copyright : (c) 2007 Yitzak Gale, Eric Kidd --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The 'MaybeT' monad transformer extends a monad with the ability to exit --- the computation without returning a value. --- --- A sequence of actions produces a value only if all the actions in --- the sequence do. If one exits, the rest of the sequence is skipped --- and the composite action exits. --- --- For a variant allowing a range of exception values, see --- "Control.Monad.Trans.Except". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Maybe ( - -- * The MaybeT monad transformer - MaybeT(..), - mapMaybeT, - -- * Monad transformations - maybeToExceptT, - exceptToMaybeT, - -- * Lifting other operations - liftCallCC, - liftCatch, - liftListen, - liftPass, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except (ExceptT(..)) -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Control.Monad (MonadPlus(mzero, mplus), liftM) -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix (MonadFix(mfix)) -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Maybe (fromMaybe) -import Data.Traversable (Traversable(traverse)) - --- | The parameterizable maybe monad, obtained by composing an arbitrary --- monad with the 'Maybe' monad. --- --- Computations are actions that may produce a value or exit. --- --- The 'return' function yields a computation that produces that --- value, while @>>=@ sequences two subcomputations, exiting if either --- computation does. -newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } - -instance (Eq1 m) => Eq1 (MaybeT m) where - liftEq eq (MaybeT x) (MaybeT y) = liftEq (liftEq eq) x y - {-# INLINE liftEq #-} - -instance (Ord1 m) => Ord1 (MaybeT m) where - liftCompare comp (MaybeT x) (MaybeT y) = liftCompare (liftCompare comp) x y - {-# INLINE liftCompare #-} - -instance (Read1 m) => Read1 (MaybeT m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "MaybeT" MaybeT - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show1 m) => Show1 (MaybeT m) where - liftShowsPrec sp sl d (MaybeT m) = - showsUnaryWith (liftShowsPrec sp' sl') "MaybeT" d m - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance (Eq1 m, Eq a) => Eq (MaybeT m a) where (==) = eq1 -instance (Ord1 m, Ord a) => Ord (MaybeT m a) where compare = compare1 -instance (Read1 m, Read a) => Read (MaybeT m a) where readsPrec = readsPrec1 -instance (Show1 m, Show a) => Show (MaybeT m a) where showsPrec = showsPrec1 - --- | Transform the computation inside a @MaybeT@. --- --- * @'runMaybeT' ('mapMaybeT' f m) = f ('runMaybeT' m)@ -mapMaybeT :: (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b -mapMaybeT f = MaybeT . f . runMaybeT -{-# INLINE mapMaybeT #-} - --- | Convert a 'MaybeT' computation to 'ExceptT', with a default --- exception value. -maybeToExceptT :: (Functor m) => e -> MaybeT m a -> ExceptT e m a -maybeToExceptT e (MaybeT m) = ExceptT $ fmap (maybe (Left e) Right) m -{-# INLINE maybeToExceptT #-} - --- | Convert a 'ExceptT' computation to 'MaybeT', discarding the --- value of any exception. -exceptToMaybeT :: (Functor m) => ExceptT e m a -> MaybeT m a -exceptToMaybeT (ExceptT m) = MaybeT $ fmap (either (const Nothing) Just) m -{-# INLINE exceptToMaybeT #-} - -instance (Functor m) => Functor (MaybeT m) where - fmap f = mapMaybeT (fmap (fmap f)) - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (MaybeT f) where - foldMap f (MaybeT a) = foldMap (foldMap f) a - {-# INLINE foldMap #-} - -instance (Traversable f) => Traversable (MaybeT f) where - traverse f (MaybeT a) = MaybeT <$> traverse (traverse f) a - {-# INLINE traverse #-} - -instance (Functor m, Monad m) => Applicative (MaybeT m) where - pure = MaybeT . return . Just - {-# INLINE pure #-} - mf <*> mx = MaybeT $ do - mb_f <- runMaybeT mf - case mb_f of - Nothing -> return Nothing - Just f -> do - mb_x <- runMaybeT mx - case mb_x of - Nothing -> return Nothing - Just x -> return (Just (f x)) - {-# INLINE (<*>) #-} - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - -instance (Functor m, Monad m) => Alternative (MaybeT m) where - empty = MaybeT (return Nothing) - {-# INLINE empty #-} - x <|> y = MaybeT $ do - v <- runMaybeT x - case v of - Nothing -> runMaybeT y - Just _ -> return v - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (MaybeT m) where -#if !(MIN_VERSION_base(4,8,0)) - return = MaybeT . return . Just - {-# INLINE return #-} -#endif - x >>= f = MaybeT $ do - v <- runMaybeT x - case v of - Nothing -> return Nothing - Just y -> runMaybeT (f y) - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail _ = MaybeT (return Nothing) - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monad m) => Fail.MonadFail (MaybeT m) where - fail _ = MaybeT (return Nothing) - {-# INLINE fail #-} -#endif - -instance (Monad m) => MonadPlus (MaybeT m) where - mzero = MaybeT (return Nothing) - {-# INLINE mzero #-} - mplus x y = MaybeT $ do - v <- runMaybeT x - case v of - Nothing -> runMaybeT y - Just _ -> return v - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (MaybeT m) where - mfix f = MaybeT (mfix (runMaybeT . f . fromMaybe bomb)) - where bomb = error "mfix (MaybeT): inner computation returned Nothing" - {-# INLINE mfix #-} - -instance MonadTrans MaybeT where - lift = MaybeT . liftM Just - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (MaybeT m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip m) => MonadZip (MaybeT m) where - mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (MaybeT m) where - contramap f = MaybeT . contramap (fmap f) . runMaybeT - {-# INLINE contramap #-} -#endif - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m (Maybe a) (Maybe b) -> CallCC (MaybeT m) a b -liftCallCC callCC f = - MaybeT $ callCC $ \ c -> runMaybeT (f (MaybeT . c . Just)) -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (Maybe a) -> Catch e (MaybeT m) a -liftCatch f m h = MaybeT $ f (runMaybeT m) (runMaybeT . h) -{-# INLINE liftCatch #-} - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (Maybe a) -> Listen w (MaybeT m) a -liftListen listen = mapMaybeT $ \ m -> do - (a, w) <- listen m - return $! fmap (\ r -> (r, w)) a -{-# INLINE liftListen #-} - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (Maybe a) -> Pass w (MaybeT m) a -liftPass pass = mapMaybeT $ \ m -> pass $ do - a <- m - return $! case a of - Nothing -> (Nothing, id) - Just (v, f) -> (Just v, f) -{-# INLINE liftPass #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS.hs deleted file mode 100644 index b4cc6adaad..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.RWS --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. --- This version is lazy; for a constant-space version with almost the --- same interface, see "Control.Monad.Trans.RWS.CPS". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.RWS ( - module Control.Monad.Trans.RWS.Lazy - ) where - -import Control.Monad.Trans.RWS.Lazy diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/CPS.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/CPS.hs deleted file mode 100644 index 8a565e1652..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/CPS.hs +++ /dev/null @@ -1,406 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.RWS.CPS --- Copyright : (c) Daniel Mendler 2016, --- (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. --- This version uses continuation-passing-style for the writer part --- to achieve constant space usage. --- For a lazy version with the same interface, --- see "Control.Monad.Trans.RWS.Lazy". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.RWS.CPS ( - -- * The RWS monad - RWS, - rws, - runRWS, - evalRWS, - execRWS, - mapRWS, - withRWS, - -- * The RWST monad transformer - RWST, - rwsT, - runRWST, - evalRWST, - execRWST, - mapRWST, - withRWST, - -- * Reader operations - reader, - ask, - local, - asks, - -- * Writer operations - writer, - tell, - listen, - listens, - pass, - censor, - -- * State operations - state, - get, - put, - modify, - gets, - -- * Lifting other operations - liftCallCC, - liftCallCC', - liftCatch, - ) where - -import Control.Applicative -import Control.Monad -import Control.Monad.Fix -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Signatures -import Data.Functor.Identity - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid -#endif - -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif - --- | A monad containing an environment of type @r@, output of type @w@ --- and an updatable state of type @s@. -type RWS r w s = RWST r w s Identity - --- | Construct an RWS computation from a function. --- (The inverse of 'runRWS'.) -rws :: (Monoid w) => (r -> s -> (a, s, w)) -> RWS r w s a -rws f = RWST $ \ r s w -> - let (a, s', w') = f r s; wt = w `mappend` w' in wt `seq` return (a, s', wt) -{-# INLINE rws #-} - --- | Unwrap an RWS computation as a function. --- (The inverse of 'rws'.) -runRWS :: (Monoid w) => RWS r w s a -> r -> s -> (a, s, w) -runRWS m r s = runIdentity (runRWST m r s) -{-# INLINE runRWS #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final value and output, discarding the final state. -evalRWS :: (Monoid w) - => RWS r w s a -- ^RWS computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> (a, w) -- ^final value and output -evalRWS m r s = let - (a, _, w) = runRWS m r s - in (a, w) -{-# INLINE evalRWS #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final state and output, discarding the final value. -execRWS :: (Monoid w) - => RWS r w s a -- ^RWS computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> (s, w) -- ^final state and output -execRWS m r s = let - (_, s', w) = runRWS m r s - in (s', w) -{-# INLINE execRWS #-} - --- | Map the return value, final state and output of a computation using --- the given function. --- --- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@ -mapRWS :: (Monoid w, Monoid w') => ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b -mapRWS f = mapRWST (Identity . f . runIdentity) -{-# INLINE mapRWS #-} - --- | @'withRWS' f m@ executes action @m@ with an initial environment --- and state modified by applying @f@. --- --- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@ -withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a -withRWS = withRWST -{-# INLINE withRWS #-} - --- --------------------------------------------------------------------------- --- | A monad transformer adding reading an environment of type @r@, --- collecting an output of type @w@ and updating a state of type @s@ --- to an inner monad @m@. -newtype RWST r w s m a = RWST { unRWST :: r -> s -> w -> m (a, s, w) } - --- | Construct an RWST computation from a function. --- (The inverse of 'runRWST'.) -rwsT :: (Functor m, Monoid w) => (r -> s -> m (a, s, w)) -> RWST r w s m a -rwsT f = RWST $ \ r s w -> - (\ (a, s', w') -> let wt = w `mappend` w' in wt `seq` (a, s', wt)) <$> f r s -{-# INLINE rwsT #-} - --- | Unwrap an RWST computation as a function. --- (The inverse of 'rwsT'.) -runRWST :: (Monoid w) => RWST r w s m a -> r -> s -> m (a, s, w) -runRWST m r s = unRWST m r s mempty -{-# INLINE runRWST #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final value and output, discarding the final state. -evalRWST :: (Monad m, Monoid w) - => RWST r w s m a -- ^computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> m (a, w) -- ^computation yielding final value and output -evalRWST m r s = do - (a, _, w) <- runRWST m r s - return (a, w) -{-# INLINE evalRWST #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final state and output, discarding the final value. -execRWST :: (Monad m, Monoid w) - => RWST r w s m a -- ^computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> m (s, w) -- ^computation yielding final state and output -execRWST m r s = do - (_, s', w) <- runRWST m r s - return (s', w) -{-# INLINE execRWST #-} - --- | Map the inner computation using the given function. --- --- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@ ---mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b -mapRWST :: (Monad n, Monoid w, Monoid w') => - (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b -mapRWST f m = RWST $ \ r s w -> do - (a, s', w') <- f (runRWST m r s) - let wt = w `mappend` w' - wt `seq` return (a, s', wt) -{-# INLINE mapRWST #-} - --- | @'withRWST' f m@ executes action @m@ with an initial environment --- and state modified by applying @f@. --- --- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@ -withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a -withRWST f m = RWST $ \ r s -> uncurry (unRWST m) (f r s) -{-# INLINE withRWST #-} - -instance (Functor m) => Functor (RWST r w s m) where - fmap f m = RWST $ \ r s w -> (\ (a, s', w') -> (f a, s', w')) <$> unRWST m r s w - {-# INLINE fmap #-} - -instance (Functor m, Monad m) => Applicative (RWST r w s m) where - pure a = RWST $ \ _ s w -> return (a, s, w) - {-# INLINE pure #-} - - RWST mf <*> RWST mx = RWST $ \ r s w -> do - (f, s', w') <- mf r s w - (x, s'', w'') <- mx r s' w' - return (f x, s'', w'') - {-# INLINE (<*>) #-} - -instance (Functor m, MonadPlus m) => Alternative (RWST r w s m) where - empty = RWST $ \ _ _ _ -> mzero - {-# INLINE empty #-} - - RWST m <|> RWST n = RWST $ \ r s w -> m r s w `mplus` n r s w - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (RWST r w s m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = RWST $ \ _ s w -> return (a, s, w) - {-# INLINE return #-} -#endif - - m >>= k = RWST $ \ r s w -> do - (a, s', w') <- unRWST m r s w - unRWST (k a) r s' w' - {-# INLINE (>>=) #-} - -#if !(MIN_VERSION_base(4,13,0)) - fail msg = RWST $ \ _ _ _ -> fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where - fail msg = RWST $ \ _ _ _ -> Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (Functor m, MonadPlus m) => MonadPlus (RWST r w s m) where - mzero = empty - {-# INLINE mzero #-} - mplus = (<|>) - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (RWST r w s m) where - mfix f = RWST $ \ r s w -> mfix $ \ ~(a, _, _) -> unRWST (f a) r s w - {-# INLINE mfix #-} - -instance MonadTrans (RWST r w s) where - lift m = RWST $ \ _ s w -> do - a <- m - return (a, s, w) - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (RWST r w s m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} --- --------------------------------------------------------------------------- --- Reader operations - --- | Constructor for computations in the reader monad (equivalent to 'asks'). -reader :: (Monad m) => (r -> a) -> RWST r w s m a -reader = asks -{-# INLINE reader #-} - --- | Fetch the value of the environment. -ask :: (Monad m) => RWST r w s m r -ask = asks id -{-# INLINE ask #-} - --- | Execute a computation in a modified environment --- --- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@ -local :: (r -> r) -> RWST r w s m a -> RWST r w s m a -local f m = RWST $ \ r s w -> unRWST m (f r) s w -{-# INLINE local #-} - --- | Retrieve a function of the current environment. --- --- * @'asks' f = 'liftM' f 'ask'@ -asks :: (Monad m) => (r -> a) -> RWST r w s m a -asks f = RWST $ \ r s w -> return (f r, s, w) -{-# INLINE asks #-} - --- --------------------------------------------------------------------------- --- Writer operations - --- | Construct a writer computation from a (result, output) pair. -writer :: (Monoid w, Monad m) => (a, w) -> RWST r w s m a -writer (a, w') = RWST $ \ _ s w -> let wt = w `mappend` w' in wt `seq` return (a, s, wt) -{-# INLINE writer #-} - --- | @'tell' w@ is an action that produces the output @w@. -tell :: (Monoid w, Monad m) => w -> RWST r w s m () -tell w' = writer ((), w') -{-# INLINE tell #-} - --- | @'listen' m@ is an action that executes the action @m@ and adds its --- output to the value of the computation. --- --- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@ -listen :: (Monoid w, Monad m) => RWST r w s m a -> RWST r w s m (a, w) -listen = listens id -{-# INLINE listen #-} - --- | @'listens' f m@ is an action that executes the action @m@ and adds --- the result of applying @f@ to the output to the value of the computation. --- --- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@ --- --- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@ -listens :: (Monoid w, Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b) -listens f m = RWST $ \ r s w -> do - (a, s', w') <- runRWST m r s - let wt = w `mappend` w' - wt `seq` return ((a, f w'), s', wt) -{-# INLINE listens #-} - --- | @'pass' m@ is an action that executes the action @m@, which returns --- a value and a function, and returns the value, applying the function --- to the output. --- --- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@ -pass :: (Monoid w, Monoid w', Monad m) => RWST r w s m (a, w -> w') -> RWST r w' s m a -pass m = RWST $ \ r s w -> do - ((a, f), s', w') <- runRWST m r s - let wt = w `mappend` f w' - wt `seq` return (a, s', wt) -{-# INLINE pass #-} - --- | @'censor' f m@ is an action that executes the action @m@ and --- applies the function @f@ to its output, leaving the return value --- unchanged. --- --- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@ --- --- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@ -censor :: (Monoid w, Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a -censor f m = RWST $ \ r s w -> do - (a, s', w') <- runRWST m r s - let wt = w `mappend` f w' - wt `seq` return (a, s', wt) -{-# INLINE censor #-} - --- --------------------------------------------------------------------------- --- State operations - --- | Construct a state monad computation from a state transformer function. -state :: (Monad m) => (s -> (a, s)) -> RWST r w s m a -state f = RWST $ \ _ s w -> let (a, s') = f s in return (a, s', w) -{-# INLINE state #-} - --- | Fetch the current value of the state within the monad. -get :: (Monad m) =>RWST r w s m s -get = gets id -{-# INLINE get #-} - --- | @'put' s@ sets the state within the monad to @s@. -put :: (Monad m) =>s -> RWST r w s m () -put s = RWST $ \ _ _ w -> return ((), s, w) -{-# INLINE put #-} - --- | @'modify' f@ is an action that updates the state to the result of --- applying @f@ to the current state. --- --- * @'modify' f = 'get' >>= ('put' . f)@ -modify :: (Monad m) =>(s -> s) -> RWST r w s m () -modify f = RWST $ \ _ s w -> return ((), f s, w) -{-# INLINE modify #-} - --- | Get a specific component of the state, using a projection function --- supplied. --- --- * @'gets' f = 'liftM' f 'get'@ -gets :: (Monad m) =>(s -> a) -> RWST r w s m a -gets f = RWST $ \ _ s w -> return (f s, s, w) -{-# INLINE gets #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. -liftCallCC :: CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b -liftCallCC callCC f = RWST $ \ r s w -> - callCC $ \ c -> unRWST (f (\ a -> RWST $ \ _ _ _ -> c (a, s, w))) r s w -{-# INLINE liftCallCC #-} - --- | In-situ lifting of a @callCC@ operation to the new monad. --- This version uses the current state on entering the continuation. -liftCallCC' :: CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b -liftCallCC' callCC f = RWST $ \ r s w -> - callCC $ \ c -> unRWST (f (\ a -> RWST $ \ _ s' _ -> c (a, s', w))) r s w -{-# INLINE liftCallCC' #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a -liftCatch catchE m h = - RWST $ \ r s w -> unRWST m r s w `catchE` \ e -> unRWST (h e) r s w -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Lazy.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Lazy.hs deleted file mode 100644 index 8f98b2c5e0..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Lazy.hs +++ /dev/null @@ -1,389 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.RWS.Lazy --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. --- This version is lazy; for a constant-space version with almost the --- same interface, see "Control.Monad.Trans.RWS.CPS". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.RWS.Lazy ( - -- * The RWS monad - RWS, - rws, - runRWS, - evalRWS, - execRWS, - mapRWS, - withRWS, - -- * The RWST monad transformer - RWST(..), - evalRWST, - execRWST, - mapRWST, - withRWST, - -- * Reader operations - reader, - ask, - local, - asks, - -- * Writer operations - writer, - tell, - listen, - listens, - pass, - censor, - -- * State operations - state, - get, - put, - modify, - gets, - -- * Lifting other operations - liftCallCC, - liftCallCC', - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -import Data.Monoid - --- | A monad containing an environment of type @r@, output of type @w@ --- and an updatable state of type @s@. -type RWS r w s = RWST r w s Identity - --- | Construct an RWS computation from a function. --- (The inverse of 'runRWS'.) -rws :: (r -> s -> (a, s, w)) -> RWS r w s a -rws f = RWST (\ r s -> Identity (f r s)) -{-# INLINE rws #-} - --- | Unwrap an RWS computation as a function. --- (The inverse of 'rws'.) -runRWS :: RWS r w s a -> r -> s -> (a, s, w) -runRWS m r s = runIdentity (runRWST m r s) -{-# INLINE runRWS #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final value and output, discarding the final state. -evalRWS :: RWS r w s a -- ^RWS computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> (a, w) -- ^final value and output -evalRWS m r s = let - (a, _, w) = runRWS m r s - in (a, w) -{-# INLINE evalRWS #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final state and output, discarding the final value. -execRWS :: RWS r w s a -- ^RWS computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> (s, w) -- ^final state and output -execRWS m r s = let - (_, s', w) = runRWS m r s - in (s', w) -{-# INLINE execRWS #-} - --- | Map the return value, final state and output of a computation using --- the given function. --- --- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@ -mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b -mapRWS f = mapRWST (Identity . f . runIdentity) -{-# INLINE mapRWS #-} - --- | @'withRWS' f m@ executes action @m@ with an initial environment --- and state modified by applying @f@. --- --- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@ -withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a -withRWS = withRWST -{-# INLINE withRWS #-} - --- --------------------------------------------------------------------------- --- | A monad transformer adding reading an environment of type @r@, --- collecting an output of type @w@ and updating a state of type @s@ --- to an inner monad @m@. -newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } - --- | Evaluate a computation with the given initial state and environment, --- returning the final value and output, discarding the final state. -evalRWST :: (Monad m) - => RWST r w s m a -- ^computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> m (a, w) -- ^computation yielding final value and output -evalRWST m r s = do - ~(a, _, w) <- runRWST m r s - return (a, w) -{-# INLINE evalRWST #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final state and output, discarding the final value. -execRWST :: (Monad m) - => RWST r w s m a -- ^computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> m (s, w) -- ^computation yielding final state and output -execRWST m r s = do - ~(_, s', w) <- runRWST m r s - return (s', w) -{-# INLINE execRWST #-} - --- | Map the inner computation using the given function. --- --- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@ -mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b -mapRWST f m = RWST $ \ r s -> f (runRWST m r s) -{-# INLINE mapRWST #-} - --- | @'withRWST' f m@ executes action @m@ with an initial environment --- and state modified by applying @f@. --- --- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@ -withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a -withRWST f m = RWST $ \ r s -> uncurry (runRWST m) (f r s) -{-# INLINE withRWST #-} - -instance (Functor m) => Functor (RWST r w s m) where - fmap f m = RWST $ \ r s -> - fmap (\ ~(a, s', w) -> (f a, s', w)) $ runRWST m r s - {-# INLINE fmap #-} - -instance (Monoid w, Functor m, Monad m) => Applicative (RWST r w s m) where - pure a = RWST $ \ _ s -> return (a, s, mempty) - {-# INLINE pure #-} - RWST mf <*> RWST mx = RWST $ \ r s -> do - ~(f, s', w) <- mf r s - ~(x, s'',w') <- mx r s' - return (f x, s'', w `mappend` w') - {-# INLINE (<*>) #-} - -instance (Monoid w, Functor m, MonadPlus m) => Alternative (RWST r w s m) where - empty = RWST $ \ _ _ -> mzero - {-# INLINE empty #-} - RWST m <|> RWST n = RWST $ \ r s -> m r s `mplus` n r s - {-# INLINE (<|>) #-} - -instance (Monoid w, Monad m) => Monad (RWST r w s m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = RWST $ \ _ s -> return (a, s, mempty) - {-# INLINE return #-} -#endif - m >>= k = RWST $ \ r s -> do - ~(a, s', w) <- runRWST m r s - ~(b, s'',w') <- runRWST (k a) r s' - return (b, s'', w `mappend` w') - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = RWST $ \ _ _ -> fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where - fail msg = RWST $ \ _ _ -> Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where - mzero = RWST $ \ _ _ -> mzero - {-# INLINE mzero #-} - RWST m `mplus` RWST n = RWST $ \ r s -> m r s `mplus` n r s - {-# INLINE mplus #-} - -instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where - mfix f = RWST $ \ r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s - {-# INLINE mfix #-} - -instance (Monoid w) => MonadTrans (RWST r w s) where - lift m = RWST $ \ _ s -> do - a <- m - return (a, s, mempty) - {-# INLINE lift #-} - -instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (RWST r w s m) where - contramap f m = RWST $ \r s -> - contramap (\ ~(a, s', w) -> (f a, s', w)) $ runRWST m r s - {-# INLINE contramap #-} -#endif - --- --------------------------------------------------------------------------- --- Reader operations - --- | Constructor for computations in the reader monad (equivalent to 'asks'). -reader :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a -reader = asks -{-# INLINE reader #-} - --- | Fetch the value of the environment. -ask :: (Monoid w, Monad m) => RWST r w s m r -ask = RWST $ \ r s -> return (r, s, mempty) -{-# INLINE ask #-} - --- | Execute a computation in a modified environment --- --- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@ -local :: (r -> r) -> RWST r w s m a -> RWST r w s m a -local f m = RWST $ \ r s -> runRWST m (f r) s -{-# INLINE local #-} - --- | Retrieve a function of the current environment. --- --- * @'asks' f = 'liftM' f 'ask'@ -asks :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a -asks f = RWST $ \ r s -> return (f r, s, mempty) -{-# INLINE asks #-} - --- --------------------------------------------------------------------------- --- Writer operations - --- | Construct a writer computation from a (result, output) pair. -writer :: (Monad m) => (a, w) -> RWST r w s m a -writer (a, w) = RWST $ \ _ s -> return (a, s, w) -{-# INLINE writer #-} - --- | @'tell' w@ is an action that produces the output @w@. -tell :: (Monad m) => w -> RWST r w s m () -tell w = RWST $ \ _ s -> return ((),s,w) -{-# INLINE tell #-} - --- | @'listen' m@ is an action that executes the action @m@ and adds its --- output to the value of the computation. --- --- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@ -listen :: (Monad m) => RWST r w s m a -> RWST r w s m (a, w) -listen m = RWST $ \ r s -> do - ~(a, s', w) <- runRWST m r s - return ((a, w), s', w) -{-# INLINE listen #-} - --- | @'listens' f m@ is an action that executes the action @m@ and adds --- the result of applying @f@ to the output to the value of the computation. --- --- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@ --- --- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@ -listens :: (Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b) -listens f m = RWST $ \ r s -> do - ~(a, s', w) <- runRWST m r s - return ((a, f w), s', w) -{-# INLINE listens #-} - --- | @'pass' m@ is an action that executes the action @m@, which returns --- a value and a function, and returns the value, applying the function --- to the output. --- --- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@ -pass :: (Monad m) => RWST r w s m (a, w -> w) -> RWST r w s m a -pass m = RWST $ \ r s -> do - ~((a, f), s', w) <- runRWST m r s - return (a, s', f w) -{-# INLINE pass #-} - --- | @'censor' f m@ is an action that executes the action @m@ and --- applies the function @f@ to its output, leaving the return value --- unchanged. --- --- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@ --- --- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@ -censor :: (Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a -censor f m = RWST $ \ r s -> do - ~(a, s', w) <- runRWST m r s - return (a, s', f w) -{-# INLINE censor #-} - --- --------------------------------------------------------------------------- --- State operations - --- | Construct a state monad computation from a state transformer function. -state :: (Monoid w, Monad m) => (s -> (a,s)) -> RWST r w s m a -state f = RWST $ \ _ s -> let (a,s') = f s in return (a, s', mempty) -{-# INLINE state #-} - --- | Fetch the current value of the state within the monad. -get :: (Monoid w, Monad m) => RWST r w s m s -get = RWST $ \ _ s -> return (s, s, mempty) -{-# INLINE get #-} - --- | @'put' s@ sets the state within the monad to @s@. -put :: (Monoid w, Monad m) => s -> RWST r w s m () -put s = RWST $ \ _ _ -> return ((), s, mempty) -{-# INLINE put #-} - --- | @'modify' f@ is an action that updates the state to the result of --- applying @f@ to the current state. --- --- * @'modify' f = 'get' >>= ('put' . f)@ -modify :: (Monoid w, Monad m) => (s -> s) -> RWST r w s m () -modify f = RWST $ \ _ s -> return ((), f s, mempty) -{-# INLINE modify #-} - --- | Get a specific component of the state, using a projection function --- supplied. --- --- * @'gets' f = 'liftM' f 'get'@ -gets :: (Monoid w, Monad m) => (s -> a) -> RWST r w s m a -gets f = RWST $ \ _ s -> return (f s, s, mempty) -{-# INLINE gets #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. -liftCallCC :: (Monoid w) => - CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b -liftCallCC callCC f = RWST $ \ r s -> - callCC $ \ c -> - runRWST (f (\ a -> RWST $ \ _ _ -> c (a, s, mempty))) r s -{-# INLINE liftCallCC #-} - --- | In-situ lifting of a @callCC@ operation to the new monad. --- This version uses the current state on entering the continuation. -liftCallCC' :: (Monoid w) => - CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b -liftCallCC' callCC f = RWST $ \ r s -> - callCC $ \ c -> - runRWST (f (\ a -> RWST $ \ _ s' -> c (a, s', mempty))) r s -{-# INLINE liftCallCC' #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a -liftCatch catchE m h = - RWST $ \ r s -> runRWST m r s `catchE` \ e -> runRWST (h e) r s -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Strict.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Strict.hs deleted file mode 100644 index 557dd2028d..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Strict.hs +++ /dev/null @@ -1,392 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.RWS.Strict --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'. --- This version is strict; for a lazy version with the same interface, --- see "Control.Monad.Trans.RWS.Lazy". --- Although the output is built strictly, it is not possible to --- achieve constant space behaviour with this transformer: for that, --- use "Control.Monad.Trans.RWS.CPS" instead. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.RWS.Strict ( - -- * The RWS monad - RWS, - rws, - runRWS, - evalRWS, - execRWS, - mapRWS, - withRWS, - -- * The RWST monad transformer - RWST(..), - evalRWST, - execRWST, - mapRWST, - withRWST, - -- * Reader operations - reader, - ask, - local, - asks, - -- * Writer operations - writer, - tell, - listen, - listens, - pass, - censor, - -- * State operations - state, - get, - put, - modify, - gets, - -- * Lifting other operations - liftCallCC, - liftCallCC', - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -import Data.Monoid - --- | A monad containing an environment of type @r@, output of type @w@ --- and an updatable state of type @s@. -type RWS r w s = RWST r w s Identity - --- | Construct an RWS computation from a function. --- (The inverse of 'runRWS'.) -rws :: (r -> s -> (a, s, w)) -> RWS r w s a -rws f = RWST (\ r s -> Identity (f r s)) -{-# INLINE rws #-} - --- | Unwrap an RWS computation as a function. --- (The inverse of 'rws'.) -runRWS :: RWS r w s a -> r -> s -> (a, s, w) -runRWS m r s = runIdentity (runRWST m r s) -{-# INLINE runRWS #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final value and output, discarding the final state. -evalRWS :: RWS r w s a -- ^RWS computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> (a, w) -- ^final value and output -evalRWS m r s = let - (a, _, w) = runRWS m r s - in (a, w) -{-# INLINE evalRWS #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final state and output, discarding the final value. -execRWS :: RWS r w s a -- ^RWS computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> (s, w) -- ^final state and output -execRWS m r s = let - (_, s', w) = runRWS m r s - in (s', w) -{-# INLINE execRWS #-} - --- | Map the return value, final state and output of a computation using --- the given function. --- --- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@ -mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b -mapRWS f = mapRWST (Identity . f . runIdentity) -{-# INLINE mapRWS #-} - --- | @'withRWS' f m@ executes action @m@ with an initial environment --- and state modified by applying @f@. --- --- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@ -withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a -withRWS = withRWST -{-# INLINE withRWS #-} - --- --------------------------------------------------------------------------- --- | A monad transformer adding reading an environment of type @r@, --- collecting an output of type @w@ and updating a state of type @s@ --- to an inner monad @m@. -newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } - --- | Evaluate a computation with the given initial state and environment, --- returning the final value and output, discarding the final state. -evalRWST :: (Monad m) - => RWST r w s m a -- ^computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> m (a, w) -- ^computation yielding final value and output -evalRWST m r s = do - (a, _, w) <- runRWST m r s - return (a, w) -{-# INLINE evalRWST #-} - --- | Evaluate a computation with the given initial state and environment, --- returning the final state and output, discarding the final value. -execRWST :: (Monad m) - => RWST r w s m a -- ^computation to execute - -> r -- ^initial environment - -> s -- ^initial value - -> m (s, w) -- ^computation yielding final state and output -execRWST m r s = do - (_, s', w) <- runRWST m r s - return (s', w) -{-# INLINE execRWST #-} - --- | Map the inner computation using the given function. --- --- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@ -mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b -mapRWST f m = RWST $ \ r s -> f (runRWST m r s) -{-# INLINE mapRWST #-} - --- | @'withRWST' f m@ executes action @m@ with an initial environment --- and state modified by applying @f@. --- --- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@ -withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a -withRWST f m = RWST $ \ r s -> uncurry (runRWST m) (f r s) -{-# INLINE withRWST #-} - -instance (Functor m) => Functor (RWST r w s m) where - fmap f m = RWST $ \ r s -> - fmap (\ (a, s', w) -> (f a, s', w)) $ runRWST m r s - {-# INLINE fmap #-} - -instance (Monoid w, Functor m, Monad m) => Applicative (RWST r w s m) where - pure a = RWST $ \ _ s -> return (a, s, mempty) - {-# INLINE pure #-} - RWST mf <*> RWST mx = RWST $ \ r s -> do - (f, s', w) <- mf r s - (x, s'',w') <- mx r s' - return (f x, s'', w `mappend` w') - {-# INLINE (<*>) #-} - -instance (Monoid w, Functor m, MonadPlus m) => Alternative (RWST r w s m) where - empty = RWST $ \ _ _ -> mzero - {-# INLINE empty #-} - RWST m <|> RWST n = RWST $ \ r s -> m r s `mplus` n r s - {-# INLINE (<|>) #-} - -instance (Monoid w, Monad m) => Monad (RWST r w s m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = RWST $ \ _ s -> return (a, s, mempty) - {-# INLINE return #-} -#endif - m >>= k = RWST $ \ r s -> do - (a, s', w) <- runRWST m r s - (b, s'',w') <- runRWST (k a) r s' - return (b, s'', w `mappend` w') - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = RWST $ \ _ _ -> fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where - fail msg = RWST $ \ _ _ -> Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where - mzero = RWST $ \ _ _ -> mzero - {-# INLINE mzero #-} - RWST m `mplus` RWST n = RWST $ \ r s -> m r s `mplus` n r s - {-# INLINE mplus #-} - -instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where - mfix f = RWST $ \ r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s - {-# INLINE mfix #-} - -instance (Monoid w) => MonadTrans (RWST r w s) where - lift m = RWST $ \ _ s -> do - a <- m - return (a, s, mempty) - {-# INLINE lift #-} - -instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (RWST r w s m) where - contramap f m = RWST $ \r s -> - contramap (\ (a, s', w) -> (f a, s', w)) $ runRWST m r s - {-# INLINE contramap #-} -#endif - --- --------------------------------------------------------------------------- --- Reader operations - --- | Constructor for computations in the reader monad (equivalent to 'asks'). -reader :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a -reader = asks -{-# INLINE reader #-} - --- | Fetch the value of the environment. -ask :: (Monoid w, Monad m) => RWST r w s m r -ask = RWST $ \ r s -> return (r, s, mempty) -{-# INLINE ask #-} - --- | Execute a computation in a modified environment --- --- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@ -local :: (r -> r) -> RWST r w s m a -> RWST r w s m a -local f m = RWST $ \ r s -> runRWST m (f r) s -{-# INLINE local #-} - --- | Retrieve a function of the current environment. --- --- * @'asks' f = 'liftM' f 'ask'@ -asks :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a -asks f = RWST $ \ r s -> return (f r, s, mempty) -{-# INLINE asks #-} - --- --------------------------------------------------------------------------- --- Writer operations - --- | Construct a writer computation from a (result, output) pair. -writer :: (Monad m) => (a, w) -> RWST r w s m a -writer (a, w) = RWST $ \ _ s -> return (a, s, w) -{-# INLINE writer #-} - --- | @'tell' w@ is an action that produces the output @w@. -tell :: (Monad m) => w -> RWST r w s m () -tell w = RWST $ \ _ s -> return ((),s,w) -{-# INLINE tell #-} - --- | @'listen' m@ is an action that executes the action @m@ and adds its --- output to the value of the computation. --- --- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@ -listen :: (Monad m) => RWST r w s m a -> RWST r w s m (a, w) -listen m = RWST $ \ r s -> do - (a, s', w) <- runRWST m r s - return ((a, w), s', w) -{-# INLINE listen #-} - --- | @'listens' f m@ is an action that executes the action @m@ and adds --- the result of applying @f@ to the output to the value of the computation. --- --- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@ --- --- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@ -listens :: (Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b) -listens f m = RWST $ \ r s -> do - (a, s', w) <- runRWST m r s - return ((a, f w), s', w) -{-# INLINE listens #-} - --- | @'pass' m@ is an action that executes the action @m@, which returns --- a value and a function, and returns the value, applying the function --- to the output. --- --- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@ -pass :: (Monad m) => RWST r w s m (a, w -> w) -> RWST r w s m a -pass m = RWST $ \ r s -> do - ((a, f), s', w) <- runRWST m r s - return (a, s', f w) -{-# INLINE pass #-} - --- | @'censor' f m@ is an action that executes the action @m@ and --- applies the function @f@ to its output, leaving the return value --- unchanged. --- --- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@ --- --- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@ -censor :: (Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a -censor f m = RWST $ \ r s -> do - (a, s', w) <- runRWST m r s - return (a, s', f w) -{-# INLINE censor #-} - --- --------------------------------------------------------------------------- --- State operations - --- | Construct a state monad computation from a state transformer function. -state :: (Monoid w, Monad m) => (s -> (a,s)) -> RWST r w s m a -state f = RWST $ \ _ s -> case f s of (a,s') -> return (a, s', mempty) -{-# INLINE state #-} - --- | Fetch the current value of the state within the monad. -get :: (Monoid w, Monad m) => RWST r w s m s -get = RWST $ \ _ s -> return (s, s, mempty) -{-# INLINE get #-} - --- | @'put' s@ sets the state within the monad to @s@. -put :: (Monoid w, Monad m) => s -> RWST r w s m () -put s = RWST $ \ _ _ -> return ((), s, mempty) -{-# INLINE put #-} - --- | @'modify' f@ is an action that updates the state to the result of --- applying @f@ to the current state. --- --- * @'modify' f = 'get' >>= ('put' . f)@ -modify :: (Monoid w, Monad m) => (s -> s) -> RWST r w s m () -modify f = RWST $ \ _ s -> return ((), f s, mempty) -{-# INLINE modify #-} - --- | Get a specific component of the state, using a projection function --- supplied. --- --- * @'gets' f = 'liftM' f 'get'@ -gets :: (Monoid w, Monad m) => (s -> a) -> RWST r w s m a -gets f = RWST $ \ _ s -> return (f s, s, mempty) -{-# INLINE gets #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. -liftCallCC :: (Monoid w) => - CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b -liftCallCC callCC f = RWST $ \ r s -> - callCC $ \ c -> - runRWST (f (\ a -> RWST $ \ _ _ -> c (a, s, mempty))) r s -{-# INLINE liftCallCC #-} - --- | In-situ lifting of a @callCC@ operation to the new monad. --- This version uses the current state on entering the continuation. -liftCallCC' :: (Monoid w) => - CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b -liftCallCC' callCC f = RWST $ \ r s -> - callCC $ \ c -> - runRWST (f (\ a -> RWST $ \ _ s' -> c (a, s', mempty))) r s -{-# INLINE liftCallCC' #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a -liftCatch catchE m h = - RWST $ \ r s -> runRWST m r s `catchE` \ e -> runRWST (h e) r s -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs deleted file mode 100644 index 25e3ad27c3..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs +++ /dev/null @@ -1,262 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Reader --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Declaration of the 'ReaderT' monad transformer, which adds a static --- environment to a given monad. --- --- If the computation is to modify the stored information, use --- "Control.Monad.Trans.State" instead. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Reader ( - -- * The Reader monad - Reader, - reader, - runReader, - mapReader, - withReader, - -- * The ReaderT monad transformer - ReaderT(..), - mapReaderT, - withReaderT, - -- * Reader operations - ask, - local, - asks, - -- * Lifting other operations - liftCallCC, - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -#if !(MIN_VERSION_base(4,6,0)) -import Control.Monad.Instances () -- deprecated from base-4.6 -#endif -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -#if MIN_VERSION_base(4,2,0) -import Data.Functor(Functor(..)) -#endif - --- | The parameterizable reader monad. --- --- Computations are functions of a shared environment. --- --- The 'return' function ignores the environment, while @>>=@ passes --- the inherited environment to both subcomputations. -type Reader r = ReaderT r Identity - --- | Constructor for computations in the reader monad (equivalent to 'asks'). -reader :: (Monad m) => (r -> a) -> ReaderT r m a -reader f = ReaderT (return . f) -{-# INLINE reader #-} - --- | Runs a @Reader@ and extracts the final value from it. --- (The inverse of 'reader'.) -runReader - :: Reader r a -- ^ A @Reader@ to run. - -> r -- ^ An initial environment. - -> a -runReader m = runIdentity . runReaderT m -{-# INLINE runReader #-} - --- | Transform the value returned by a @Reader@. --- --- * @'runReader' ('mapReader' f m) = f . 'runReader' m@ -mapReader :: (a -> b) -> Reader r a -> Reader r b -mapReader f = mapReaderT (Identity . f . runIdentity) -{-# INLINE mapReader #-} - --- | Execute a computation in a modified environment --- (a specialization of 'withReaderT'). --- --- * @'runReader' ('withReader' f m) = 'runReader' m . f@ -withReader - :: (r' -> r) -- ^ The function to modify the environment. - -> Reader r a -- ^ Computation to run in the modified environment. - -> Reader r' a -withReader = withReaderT -{-# INLINE withReader #-} - --- | The reader monad transformer, --- which adds a read-only environment to the given monad. --- --- The 'return' function ignores the environment, while @>>=@ passes --- the inherited environment to both subcomputations. -newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } - --- | Transform the computation inside a @ReaderT@. --- --- * @'runReaderT' ('mapReaderT' f m) = f . 'runReaderT' m@ -mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b -mapReaderT f m = ReaderT $ f . runReaderT m -{-# INLINE mapReaderT #-} - --- | Execute a computation in a modified environment --- (a more general version of 'local'). --- --- * @'runReaderT' ('withReaderT' f m) = 'runReaderT' m . f@ -withReaderT - :: (r' -> r) -- ^ The function to modify the environment. - -> ReaderT r m a -- ^ Computation to run in the modified environment. - -> ReaderT r' m a -withReaderT f m = ReaderT $ runReaderT m . f -{-# INLINE withReaderT #-} - -instance (Functor m) => Functor (ReaderT r m) where - fmap f = mapReaderT (fmap f) - {-# INLINE fmap #-} -#if MIN_VERSION_base(4,2,0) - x <$ v = mapReaderT (x <$) v - {-# INLINE (<$) #-} -#endif - -instance (Applicative m) => Applicative (ReaderT r m) where - pure = liftReaderT . pure - {-# INLINE pure #-} - f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r - {-# INLINE (<*>) #-} -#if MIN_VERSION_base(4,2,0) - u *> v = ReaderT $ \ r -> runReaderT u r *> runReaderT v r - {-# INLINE (*>) #-} - u <* v = ReaderT $ \ r -> runReaderT u r <* runReaderT v r - {-# INLINE (<*) #-} -#endif -#if MIN_VERSION_base(4,10,0) - liftA2 f x y = ReaderT $ \ r -> liftA2 f (runReaderT x r) (runReaderT y r) - {-# INLINE liftA2 #-} -#endif - -instance (Alternative m) => Alternative (ReaderT r m) where - empty = liftReaderT empty - {-# INLINE empty #-} - m <|> n = ReaderT $ \ r -> runReaderT m r <|> runReaderT n r - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (ReaderT r m) where -#if !(MIN_VERSION_base(4,8,0)) - return = lift . return - {-# INLINE return #-} -#endif - m >>= k = ReaderT $ \ r -> do - a <- runReaderT m r - runReaderT (k a) r - {-# INLINE (>>=) #-} -#if MIN_VERSION_base(4,8,0) - (>>) = (*>) -#else - m >> k = ReaderT $ \ r -> runReaderT m r >> runReaderT k r -#endif - {-# INLINE (>>) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = lift (fail msg) - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (ReaderT r m) where - fail msg = lift (Fail.fail msg) - {-# INLINE fail #-} -#endif - -instance (MonadPlus m) => MonadPlus (ReaderT r m) where - mzero = lift mzero - {-# INLINE mzero #-} - m `mplus` n = ReaderT $ \ r -> runReaderT m r `mplus` runReaderT n r - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (ReaderT r m) where - mfix f = ReaderT $ \ r -> mfix $ \ a -> runReaderT (f a) r - {-# INLINE mfix #-} - -instance MonadTrans (ReaderT r) where - lift = liftReaderT - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (ReaderT r m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip m) => MonadZip (ReaderT r m) where - mzipWith f (ReaderT m) (ReaderT n) = ReaderT $ \ a -> - mzipWith f (m a) (n a) - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (ReaderT r m) where - contramap f = ReaderT . fmap (contramap f) . runReaderT - {-# INLINE contramap #-} -#endif - -liftReaderT :: m a -> ReaderT r m a -liftReaderT m = ReaderT (const m) -{-# INLINE liftReaderT #-} - --- | Fetch the value of the environment. -ask :: (Monad m) => ReaderT r m r -ask = ReaderT return -{-# INLINE ask #-} - --- | Execute a computation in a modified environment --- (a specialization of 'withReaderT'). --- --- * @'runReaderT' ('local' f m) = 'runReaderT' m . f@ -local - :: (r -> r) -- ^ The function to modify the environment. - -> ReaderT r m a -- ^ Computation to run in the modified environment. - -> ReaderT r m a -local = withReaderT -{-# INLINE local #-} - --- | Retrieve a function of the current environment. --- --- * @'asks' f = 'liftM' f 'ask'@ -asks :: (Monad m) - => (r -> a) -- ^ The selector function to apply to the environment. - -> ReaderT r m a -asks f = ReaderT (return . f) -{-# INLINE asks #-} - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: CallCC m a b -> CallCC (ReaderT r m) a b -liftCallCC callCC f = ReaderT $ \ r -> - callCC $ \ c -> - runReaderT (f (ReaderT . const . c)) r -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m a -> Catch e (ReaderT r m) a -liftCatch f m h = - ReaderT $ \ r -> f (runReaderT m r) (\ e -> runReaderT (h e) r) -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Select.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Select.hs deleted file mode 100644 index 22fdf8fd8a..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Select.hs +++ /dev/null @@ -1,161 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Select --- Copyright : (c) Ross Paterson 2017 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Selection monad transformer, modelling search algorithms. --- --- * Martin Escardo and Paulo Oliva. --- "Selection functions, bar recursion and backward induction", --- /Mathematical Structures in Computer Science/ 20:2 (2010), pp. 127-168. --- <https://www.cs.bham.ac.uk/~mhe/papers/selection-escardo-oliva.pdf> --- --- * Jules Hedges. "Monad transformers for backtracking search". --- In /Proceedings of MSFP 2014/. <https://arxiv.org/abs/1406.2058> ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Select ( - -- * The Select monad - Select, - select, - runSelect, - mapSelect, - -- * The SelectT monad transformer - SelectT(SelectT), - runSelectT, - mapSelectT, - -- * Monad transformation - selectToContT, - selectToCont, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.Cont - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Data.Functor.Identity - --- | Selection monad. -type Select r = SelectT r Identity - --- | Constructor for computations in the selection monad. -select :: ((a -> r) -> a) -> Select r a -select f = SelectT $ \ k -> Identity (f (runIdentity . k)) -{-# INLINE select #-} - --- | Runs a @Select@ computation with a function for evaluating answers --- to select a particular answer. (The inverse of 'select'.) -runSelect :: Select r a -> (a -> r) -> a -runSelect m k = runIdentity (runSelectT m (Identity . k)) -{-# INLINE runSelect #-} - --- | Apply a function to transform the result of a selection computation. --- --- * @'runSelect' ('mapSelect' f m) = f . 'runSelect' m@ -mapSelect :: (a -> a) -> Select r a -> Select r a -mapSelect f = mapSelectT (Identity . f . runIdentity) -{-# INLINE mapSelect #-} - --- | Selection monad transformer. --- --- 'SelectT' is not a functor on the category of monads, and many operations --- cannot be lifted through it. -newtype SelectT r m a = SelectT ((a -> m r) -> m a) - --- | Runs a @SelectT@ computation with a function for evaluating answers --- to select a particular answer. (The inverse of 'select'.) -runSelectT :: SelectT r m a -> (a -> m r) -> m a -runSelectT (SelectT g) = g -{-# INLINE runSelectT #-} - --- | Apply a function to transform the result of a selection computation. --- This has a more restricted type than the @map@ operations for other --- monad transformers, because 'SelectT' does not define a functor in --- the category of monads. --- --- * @'runSelectT' ('mapSelectT' f m) = f . 'runSelectT' m@ -mapSelectT :: (m a -> m a) -> SelectT r m a -> SelectT r m a -mapSelectT f m = SelectT $ f . runSelectT m -{-# INLINE mapSelectT #-} - -instance (Functor m) => Functor (SelectT r m) where - fmap f (SelectT g) = SelectT (fmap f . g . (. f)) - {-# INLINE fmap #-} - -instance (Functor m, Monad m) => Applicative (SelectT r m) where - pure = lift . return - {-# INLINE pure #-} - SelectT gf <*> SelectT gx = SelectT $ \ k -> do - let h f = liftM f (gx (k . f)) - f <- gf ((>>= k) . h) - h f - {-# INLINE (<*>) #-} - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - -instance (Functor m, MonadPlus m) => Alternative (SelectT r m) where - empty = mzero - {-# INLINE empty #-} - (<|>) = mplus - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (SelectT r m) where -#if !(MIN_VERSION_base(4,8,0)) - return = lift . return - {-# INLINE return #-} -#endif - SelectT g >>= f = SelectT $ \ k -> do - let h x = runSelectT (f x) k - y <- g ((>>= k) . h) - h y - {-# INLINE (>>=) #-} - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (SelectT r m) where - fail msg = lift (Fail.fail msg) - {-# INLINE fail #-} -#endif - -instance (MonadPlus m) => MonadPlus (SelectT r m) where - mzero = SelectT (const mzero) - {-# INLINE mzero #-} - SelectT f `mplus` SelectT g = SelectT $ \ k -> f k `mplus` g k - {-# INLINE mplus #-} - -instance MonadTrans (SelectT r) where - lift = SelectT . const - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (SelectT r m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - --- | Convert a selection computation to a continuation-passing computation. -selectToContT :: (Monad m) => SelectT r m a -> ContT r m a -selectToContT (SelectT g) = ContT $ \ k -> g k >>= k -{-# INLINE selectToCont #-} - --- | Deprecated name for 'selectToContT'. -{-# DEPRECATED selectToCont "Use selectToContT instead" #-} -selectToCont :: (Monad m) => SelectT r m a -> ContT r m a -selectToCont = selectToContT diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State.hs deleted file mode 100644 index 36de964ea1..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.State --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- State monads, passing an updatable state through a computation. --- --- Some computations may not require the full power of state transformers: --- --- * For a read-only state, see "Control.Monad.Trans.Reader". --- --- * To accumulate a value without using it on the way, see --- "Control.Monad.Trans.Writer". --- --- This version is lazy; for a strict version, see --- "Control.Monad.Trans.State.Strict", which has the same interface. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.State ( - module Control.Monad.Trans.State.Lazy - ) where - -import Control.Monad.Trans.State.Lazy diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Lazy.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Lazy.hs deleted file mode 100644 index d7cdde5444..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Lazy.hs +++ /dev/null @@ -1,428 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.State.Lazy --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Lazy state monads, passing an updatable state through a computation. --- See below for examples. --- --- Some computations may not require the full power of state transformers: --- --- * For a read-only state, see "Control.Monad.Trans.Reader". --- --- * To accumulate a value without using it on the way, see --- "Control.Monad.Trans.Writer". --- --- In this version, sequencing of computations is lazy, so that for --- example the following produces a usable result: --- --- > evalState (sequence $ repeat $ do { n <- get; put (n*2); return n }) 1 --- --- For a strict version with the same interface, see --- "Control.Monad.Trans.State.Strict". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.State.Lazy ( - -- * The State monad - State, - state, - runState, - evalState, - execState, - mapState, - withState, - -- * The StateT monad transformer - StateT(..), - evalStateT, - execStateT, - mapStateT, - withStateT, - -- * State operations - get, - put, - modify, - modify', - gets, - -- * Lifting other operations - liftCallCC, - liftCallCC', - liftCatch, - liftListen, - liftPass, - -- * Examples - -- ** State monads - -- $examples - - -- ** Counting - -- $counting - - -- ** Labelling trees - -- $labelling - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix - --- --------------------------------------------------------------------------- --- | A state monad parameterized by the type @s@ of the state to carry. --- --- The 'return' function leaves the state unchanged, while @>>=@ uses --- the final state of the first computation as the initial state of --- the second. -type State s = StateT s Identity - --- | Construct a state monad computation from a function. --- (The inverse of 'runState'.) -state :: (Monad m) - => (s -> (a, s)) -- ^pure state transformer - -> StateT s m a -- ^equivalent state-passing computation -state f = StateT (return . f) -{-# INLINE state #-} - --- | Unwrap a state monad computation as a function. --- (The inverse of 'state'.) -runState :: State s a -- ^state-passing computation to execute - -> s -- ^initial state - -> (a, s) -- ^return value and final state -runState m = runIdentity . runStateT m -{-# INLINE runState #-} - --- | Evaluate a state computation with the given initial state --- and return the final value, discarding the final state. --- --- * @'evalState' m s = 'fst' ('runState' m s)@ -evalState :: State s a -- ^state-passing computation to execute - -> s -- ^initial value - -> a -- ^return value of the state computation -evalState m s = fst (runState m s) -{-# INLINE evalState #-} - --- | Evaluate a state computation with the given initial state --- and return the final state, discarding the final value. --- --- * @'execState' m s = 'snd' ('runState' m s)@ -execState :: State s a -- ^state-passing computation to execute - -> s -- ^initial value - -> s -- ^final state -execState m s = snd (runState m s) -{-# INLINE execState #-} - --- | Map both the return value and final state of a computation using --- the given function. --- --- * @'runState' ('mapState' f m) = f . 'runState' m@ -mapState :: ((a, s) -> (b, s)) -> State s a -> State s b -mapState f = mapStateT (Identity . f . runIdentity) -{-# INLINE mapState #-} - --- | @'withState' f m@ executes action @m@ on a state modified by --- applying @f@. --- --- * @'withState' f m = 'modify' f >> m@ -withState :: (s -> s) -> State s a -> State s a -withState = withStateT -{-# INLINE withState #-} - --- --------------------------------------------------------------------------- --- | A state transformer monad parameterized by: --- --- * @s@ - The state. --- --- * @m@ - The inner monad. --- --- The 'return' function leaves the state unchanged, while @>>=@ uses --- the final state of the first computation as the initial state of --- the second. -newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } - --- | Evaluate a state computation with the given initial state --- and return the final value, discarding the final state. --- --- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@ -evalStateT :: (Monad m) => StateT s m a -> s -> m a -evalStateT m s = do - ~(a, _) <- runStateT m s - return a -{-# INLINE evalStateT #-} - --- | Evaluate a state computation with the given initial state --- and return the final state, discarding the final value. --- --- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@ -execStateT :: (Monad m) => StateT s m a -> s -> m s -execStateT m s = do - ~(_, s') <- runStateT m s - return s' -{-# INLINE execStateT #-} - --- | Map both the return value and final state of a computation using --- the given function. --- --- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@ -mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b -mapStateT f m = StateT $ f . runStateT m -{-# INLINE mapStateT #-} - --- | @'withStateT' f m@ executes action @m@ on a state modified by --- applying @f@. --- --- * @'withStateT' f m = 'modify' f >> m@ -withStateT :: (s -> s) -> StateT s m a -> StateT s m a -withStateT f m = StateT $ runStateT m . f -{-# INLINE withStateT #-} - -instance (Functor m) => Functor (StateT s m) where - fmap f m = StateT $ \ s -> - fmap (\ ~(a, s') -> (f a, s')) $ runStateT m s - {-# INLINE fmap #-} - -instance (Functor m, Monad m) => Applicative (StateT s m) where - pure a = StateT $ \ s -> return (a, s) - {-# INLINE pure #-} - StateT mf <*> StateT mx = StateT $ \ s -> do - ~(f, s') <- mf s - ~(x, s'') <- mx s' - return (f x, s'') - {-# INLINE (<*>) #-} - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - -instance (Functor m, MonadPlus m) => Alternative (StateT s m) where - empty = StateT $ \ _ -> mzero - {-# INLINE empty #-} - StateT m <|> StateT n = StateT $ \ s -> m s `mplus` n s - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (StateT s m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = StateT $ \ s -> return (a, s) - {-# INLINE return #-} -#endif - m >>= k = StateT $ \ s -> do - ~(a, s') <- runStateT m s - runStateT (k a) s' - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail str = StateT $ \ _ -> fail str - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where - fail str = StateT $ \ _ -> Fail.fail str - {-# INLINE fail #-} -#endif - -instance (MonadPlus m) => MonadPlus (StateT s m) where - mzero = StateT $ \ _ -> mzero - {-# INLINE mzero #-} - StateT m `mplus` StateT n = StateT $ \ s -> m s `mplus` n s - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (StateT s m) where - mfix f = StateT $ \ s -> mfix $ \ ~(a, _) -> runStateT (f a) s - {-# INLINE mfix #-} - -instance MonadTrans (StateT s) where - lift m = StateT $ \ s -> do - a <- m - return (a, s) - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (StateT s m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (StateT s m) where - contramap f m = StateT $ \s -> - contramap (\ ~(a, s') -> (f a, s')) $ runStateT m s - {-# INLINE contramap #-} -#endif - --- | Fetch the current value of the state within the monad. -get :: (Monad m) => StateT s m s -get = state $ \ s -> (s, s) -{-# INLINE get #-} - --- | @'put' s@ sets the state within the monad to @s@. -put :: (Monad m) => s -> StateT s m () -put s = state $ \ _ -> ((), s) -{-# INLINE put #-} - --- | @'modify' f@ is an action that updates the state to the result of --- applying @f@ to the current state. --- --- * @'modify' f = 'get' >>= ('put' . f)@ -modify :: (Monad m) => (s -> s) -> StateT s m () -modify f = state $ \ s -> ((), f s) -{-# INLINE modify #-} - --- | A variant of 'modify' in which the computation is strict in the --- new state. --- --- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@ -modify' :: (Monad m) => (s -> s) -> StateT s m () -modify' f = do - s <- get - put $! f s -{-# INLINE modify' #-} - --- | Get a specific component of the state, using a projection function --- supplied. --- --- * @'gets' f = 'liftM' f 'get'@ -gets :: (Monad m) => (s -> a) -> StateT s m a -gets f = state $ \ s -> (f s, s) -{-# INLINE gets #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. -liftCallCC :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b -liftCallCC callCC f = StateT $ \ s -> - callCC $ \ c -> - runStateT (f (\ a -> StateT $ \ _ -> c (a, s))) s -{-# INLINE liftCallCC #-} - --- | In-situ lifting of a @callCC@ operation to the new monad. --- This version uses the current state on entering the continuation. --- It does not satisfy the uniformity property (see "Control.Monad.Signatures"). -liftCallCC' :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b -liftCallCC' callCC f = StateT $ \ s -> - callCC $ \ c -> - runStateT (f (\ a -> StateT $ \ s' -> c (a, s'))) s -{-# INLINE liftCallCC' #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a -liftCatch catchE m h = - StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s -{-# INLINE liftCatch #-} - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (a,s) -> Listen w (StateT s m) a -liftListen listen m = StateT $ \ s -> do - ~((a, s'), w) <- listen (runStateT m s) - return ((a, w), s') -{-# INLINE liftListen #-} - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (a,s) -> Pass w (StateT s m) a -liftPass pass m = StateT $ \ s -> pass $ do - ~((a, f), s') <- runStateT m s - return ((a, s'), f) -{-# INLINE liftPass #-} - -{- $examples - -Parser from ParseLib with Hugs: - -> type Parser a = StateT String [] a -> ==> StateT (String -> [(a,String)]) - -For example, item can be written as: - -> item = do (x:xs) <- get -> put xs -> return x -> -> type BoringState s a = StateT s Identity a -> ==> StateT (s -> Identity (a,s)) -> -> type StateWithIO s a = StateT s IO a -> ==> StateT (s -> IO (a,s)) -> -> type StateWithErr s a = StateT s Maybe a -> ==> StateT (s -> Maybe (a,s)) - --} - -{- $counting - -A function to increment a counter. -Taken from the paper \"Generalising Monads to Arrows\", -John Hughes (<http://www.cse.chalmers.se/~rjmh/>), November 1998: - -> tick :: State Int Int -> tick = do n <- get -> put (n+1) -> return n - -Add one to the given number using the state monad: - -> plusOne :: Int -> Int -> plusOne n = execState tick n - -A contrived addition example. Works only with positive numbers: - -> plus :: Int -> Int -> Int -> plus n x = execState (sequence $ replicate n tick) x - --} - -{- $labelling - -An example from /The Craft of Functional Programming/, Simon -Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>), -Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a -tree of integers in which the original elements are replaced by -natural numbers, starting from 0. The same element has to be -replaced by the same number at every occurrence, and when we meet -an as-yet-unvisited element we have to find a \'new\' number to match -it with:\" - -> data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) -> type Table a = [a] - -> numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) -> numberTree Nil = return Nil -> numberTree (Node x t1 t2) = do -> num <- numberNode x -> nt1 <- numberTree t1 -> nt2 <- numberTree t2 -> return (Node num nt1 nt2) -> where -> numberNode :: Eq a => a -> State (Table a) Int -> numberNode x = do -> table <- get -> case elemIndex x table of -> Nothing -> do -> put (table ++ [x]) -> return (length table) -> Just i -> return i - -numTree applies numberTree with an initial state: - -> numTree :: (Eq a) => Tree a -> Tree Int -> numTree t = evalState (numberTree t) [] - -> testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil -> numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil - --} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Strict.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Strict.hs deleted file mode 100644 index d0fb58edb4..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Strict.hs +++ /dev/null @@ -1,425 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.State.Strict --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Strict state monads, passing an updatable state through a computation. --- See below for examples. --- --- Some computations may not require the full power of state transformers: --- --- * For a read-only state, see "Control.Monad.Trans.Reader". --- --- * To accumulate a value without using it on the way, see --- "Control.Monad.Trans.Writer". --- --- In this version, sequencing of computations is strict (but computations --- are not strict in the state unless you force it with 'seq' or the like). --- For a lazy version with the same interface, see --- "Control.Monad.Trans.State.Lazy". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.State.Strict ( - -- * The State monad - State, - state, - runState, - evalState, - execState, - mapState, - withState, - -- * The StateT monad transformer - StateT(..), - evalStateT, - execStateT, - mapStateT, - withStateT, - -- * State operations - get, - put, - modify, - modify', - gets, - -- * Lifting other operations - liftCallCC, - liftCallCC', - liftCatch, - liftListen, - liftPass, - -- * Examples - -- ** State monads - -- $examples - - -- ** Counting - -- $counting - - -- ** Labelling trees - -- $labelling - ) where - -import Control.Monad.IO.Class -import Control.Monad.Signatures -import Control.Monad.Trans.Class -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix - --- --------------------------------------------------------------------------- --- | A state monad parameterized by the type @s@ of the state to carry. --- --- The 'return' function leaves the state unchanged, while @>>=@ uses --- the final state of the first computation as the initial state of --- the second. -type State s = StateT s Identity - --- | Construct a state monad computation from a function. --- (The inverse of 'runState'.) -state :: (Monad m) - => (s -> (a, s)) -- ^pure state transformer - -> StateT s m a -- ^equivalent state-passing computation -state f = StateT (return . f) -{-# INLINE state #-} - --- | Unwrap a state monad computation as a function. --- (The inverse of 'state'.) -runState :: State s a -- ^state-passing computation to execute - -> s -- ^initial state - -> (a, s) -- ^return value and final state -runState m = runIdentity . runStateT m -{-# INLINE runState #-} - --- | Evaluate a state computation with the given initial state --- and return the final value, discarding the final state. --- --- * @'evalState' m s = 'fst' ('runState' m s)@ -evalState :: State s a -- ^state-passing computation to execute - -> s -- ^initial value - -> a -- ^return value of the state computation -evalState m s = fst (runState m s) -{-# INLINE evalState #-} - --- | Evaluate a state computation with the given initial state --- and return the final state, discarding the final value. --- --- * @'execState' m s = 'snd' ('runState' m s)@ -execState :: State s a -- ^state-passing computation to execute - -> s -- ^initial value - -> s -- ^final state -execState m s = snd (runState m s) -{-# INLINE execState #-} - --- | Map both the return value and final state of a computation using --- the given function. --- --- * @'runState' ('mapState' f m) = f . 'runState' m@ -mapState :: ((a, s) -> (b, s)) -> State s a -> State s b -mapState f = mapStateT (Identity . f . runIdentity) -{-# INLINE mapState #-} - --- | @'withState' f m@ executes action @m@ on a state modified by --- applying @f@. --- --- * @'withState' f m = 'modify' f >> m@ -withState :: (s -> s) -> State s a -> State s a -withState = withStateT -{-# INLINE withState #-} - --- --------------------------------------------------------------------------- --- | A state transformer monad parameterized by: --- --- * @s@ - The state. --- --- * @m@ - The inner monad. --- --- The 'return' function leaves the state unchanged, while @>>=@ uses --- the final state of the first computation as the initial state of --- the second. -newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } - --- | Evaluate a state computation with the given initial state --- and return the final value, discarding the final state. --- --- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@ -evalStateT :: (Monad m) => StateT s m a -> s -> m a -evalStateT m s = do - (a, _) <- runStateT m s - return a -{-# INLINE evalStateT #-} - --- | Evaluate a state computation with the given initial state --- and return the final state, discarding the final value. --- --- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@ -execStateT :: (Monad m) => StateT s m a -> s -> m s -execStateT m s = do - (_, s') <- runStateT m s - return s' -{-# INLINE execStateT #-} - --- | Map both the return value and final state of a computation using --- the given function. --- --- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@ -mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b -mapStateT f m = StateT $ f . runStateT m -{-# INLINE mapStateT #-} - --- | @'withStateT' f m@ executes action @m@ on a state modified by --- applying @f@. --- --- * @'withStateT' f m = 'modify' f >> m@ -withStateT :: (s -> s) -> StateT s m a -> StateT s m a -withStateT f m = StateT $ runStateT m . f -{-# INLINE withStateT #-} - -instance (Functor m) => Functor (StateT s m) where - fmap f m = StateT $ \ s -> - fmap (\ (a, s') -> (f a, s')) $ runStateT m s - {-# INLINE fmap #-} - -instance (Functor m, Monad m) => Applicative (StateT s m) where - pure a = StateT $ \ s -> return (a, s) - {-# INLINE pure #-} - StateT mf <*> StateT mx = StateT $ \ s -> do - (f, s') <- mf s - (x, s'') <- mx s' - return (f x, s'') - {-# INLINE (<*>) #-} - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - -instance (Functor m, MonadPlus m) => Alternative (StateT s m) where - empty = StateT $ \ _ -> mzero - {-# INLINE empty #-} - StateT m <|> StateT n = StateT $ \ s -> m s `mplus` n s - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (StateT s m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = StateT $ \ s -> return (a, s) - {-# INLINE return #-} -#endif - m >>= k = StateT $ \ s -> do - (a, s') <- runStateT m s - runStateT (k a) s' - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail str = StateT $ \ _ -> fail str - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where - fail str = StateT $ \ _ -> Fail.fail str - {-# INLINE fail #-} -#endif - -instance (MonadPlus m) => MonadPlus (StateT s m) where - mzero = StateT $ \ _ -> mzero - {-# INLINE mzero #-} - StateT m `mplus` StateT n = StateT $ \ s -> m s `mplus` n s - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (StateT s m) where - mfix f = StateT $ \ s -> mfix $ \ ~(a, _) -> runStateT (f a) s - {-# INLINE mfix #-} - -instance MonadTrans (StateT s) where - lift m = StateT $ \ s -> do - a <- m - return (a, s) - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (StateT s m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (StateT s m) where - contramap f m = StateT $ \s -> - contramap (\ (a, s') -> (f a, s')) $ runStateT m s - {-# INLINE contramap #-} -#endif - --- | Fetch the current value of the state within the monad. -get :: (Monad m) => StateT s m s -get = state $ \ s -> (s, s) -{-# INLINE get #-} - --- | @'put' s@ sets the state within the monad to @s@. -put :: (Monad m) => s -> StateT s m () -put s = state $ \ _ -> ((), s) -{-# INLINE put #-} - --- | @'modify' f@ is an action that updates the state to the result of --- applying @f@ to the current state. --- --- * @'modify' f = 'get' >>= ('put' . f)@ -modify :: (Monad m) => (s -> s) -> StateT s m () -modify f = state $ \ s -> ((), f s) -{-# INLINE modify #-} - --- | A variant of 'modify' in which the computation is strict in the --- new state. --- --- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@ -modify' :: (Monad m) => (s -> s) -> StateT s m () -modify' f = do - s <- get - put $! f s -{-# INLINE modify' #-} - --- | Get a specific component of the state, using a projection function --- supplied. --- --- * @'gets' f = 'liftM' f 'get'@ -gets :: (Monad m) => (s -> a) -> StateT s m a -gets f = state $ \ s -> (f s, s) -{-# INLINE gets #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. -liftCallCC :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b -liftCallCC callCC f = StateT $ \ s -> - callCC $ \ c -> - runStateT (f (\ a -> StateT $ \ _ -> c (a, s))) s -{-# INLINE liftCallCC #-} - --- | In-situ lifting of a @callCC@ operation to the new monad. --- This version uses the current state on entering the continuation. --- It does not satisfy the uniformity property (see "Control.Monad.Signatures"). -liftCallCC' :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b -liftCallCC' callCC f = StateT $ \ s -> - callCC $ \ c -> - runStateT (f (\ a -> StateT $ \ s' -> c (a, s'))) s -{-# INLINE liftCallCC' #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a -liftCatch catchE m h = - StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s -{-# INLINE liftCatch #-} - --- | Lift a @listen@ operation to the new monad. -liftListen :: (Monad m) => Listen w m (a,s) -> Listen w (StateT s m) a -liftListen listen m = StateT $ \ s -> do - ((a, s'), w) <- listen (runStateT m s) - return ((a, w), s') -{-# INLINE liftListen #-} - --- | Lift a @pass@ operation to the new monad. -liftPass :: (Monad m) => Pass w m (a,s) -> Pass w (StateT s m) a -liftPass pass m = StateT $ \ s -> pass $ do - ((a, f), s') <- runStateT m s - return ((a, s'), f) -{-# INLINE liftPass #-} - -{- $examples - -Parser from ParseLib with Hugs: - -> type Parser a = StateT String [] a -> ==> StateT (String -> [(a,String)]) - -For example, item can be written as: - -> item = do (x:xs) <- get -> put xs -> return x -> -> type BoringState s a = StateT s Identity a -> ==> StateT (s -> Identity (a,s)) -> -> type StateWithIO s a = StateT s IO a -> ==> StateT (s -> IO (a,s)) -> -> type StateWithErr s a = StateT s Maybe a -> ==> StateT (s -> Maybe (a,s)) - --} - -{- $counting - -A function to increment a counter. -Taken from the paper \"Generalising Monads to Arrows\", -John Hughes (<http://www.cse.chalmers.se/~rjmh/>), November 1998: - -> tick :: State Int Int -> tick = do n <- get -> put (n+1) -> return n - -Add one to the given number using the state monad: - -> plusOne :: Int -> Int -> plusOne n = execState tick n - -A contrived addition example. Works only with positive numbers: - -> plus :: Int -> Int -> Int -> plus n x = execState (sequence $ replicate n tick) x - --} - -{- $labelling - -An example from /The Craft of Functional Programming/, Simon -Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>), -Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a -tree of integers in which the original elements are replaced by -natural numbers, starting from 0. The same element has to be -replaced by the same number at every occurrence, and when we meet -an as-yet-unvisited element we have to find a \'new\' number to match -it with:\" - -> data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) -> type Table a = [a] - -> numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) -> numberTree Nil = return Nil -> numberTree (Node x t1 t2) = do -> num <- numberNode x -> nt1 <- numberTree t1 -> nt2 <- numberTree t2 -> return (Node num nt1 nt2) -> where -> numberNode :: Eq a => a -> State (Table a) Int -> numberNode x = do -> table <- get -> case elemIndex x table of -> Nothing -> do -> put (table ++ [x]) -> return (length table) -> Just i -> return i - -numTree applies numberTree with an initial state: - -> numTree :: (Eq a) => Tree a -> Tree Int -> numTree t = evalState (numberTree t) [] - -> testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil -> numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil - --} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer.hs deleted file mode 100644 index f45f4d2768..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Writer --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The WriterT monad transformer. --- This version builds its output lazily; for a constant-space version --- with almost the same interface, see "Control.Monad.Trans.Writer.CPS". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Writer ( - module Control.Monad.Trans.Writer.Lazy - ) where - -import Control.Monad.Trans.Writer.Lazy diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/CPS.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/CPS.hs deleted file mode 100644 index 28951016cf..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/CPS.hs +++ /dev/null @@ -1,283 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Writer.CPS --- Copyright : (c) Daniel Mendler 2016, --- (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The strict 'WriterT' monad transformer, which adds collection of --- outputs (such as a count or string output) to a given monad. --- --- This monad transformer provides only limited access to the output --- during the computation. For more general access, use --- "Control.Monad.Trans.State" instead. --- --- This version builds its output strictly and uses continuation-passing-style --- to achieve constant space usage. This transformer can be used as a --- drop-in replacement for "Control.Monad.Trans.Writer.Strict". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Writer.CPS ( - -- * The Writer monad - Writer, - writer, - runWriter, - execWriter, - mapWriter, - -- * The WriterT monad transformer - WriterT, - writerT, - runWriterT, - execWriterT, - mapWriterT, - -- * Writer operations - tell, - listen, - listens, - pass, - censor, - -- * Lifting other operations - liftCallCC, - liftCatch, - ) where - -import Control.Applicative -import Control.Monad -import Control.Monad.Fix -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Signatures -import Data.Functor.Identity - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid -#endif - -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif - --- --------------------------------------------------------------------------- --- | A writer monad parameterized by the type @w@ of output to accumulate. --- --- The 'return' function produces the output 'mempty', while '>>=' --- combines the outputs of the subcomputations using 'mappend'. -type Writer w = WriterT w Identity - --- | Construct a writer computation from a (result, output) pair. --- (The inverse of 'runWriter'.) -writer :: (Monoid w, Monad m) => (a, w) -> WriterT w m a -writer (a, w') = WriterT $ \ w -> - let wt = w `mappend` w' in wt `seq` return (a, wt) -{-# INLINE writer #-} - --- | Unwrap a writer computation as a (result, output) pair. --- (The inverse of 'writer'.) -runWriter :: (Monoid w) => Writer w a -> (a, w) -runWriter = runIdentity . runWriterT -{-# INLINE runWriter #-} - --- | Extract the output from a writer computation. --- --- * @'execWriter' m = 'snd' ('runWriter' m)@ -execWriter :: (Monoid w) => Writer w a -> w -execWriter = runIdentity . execWriterT -{-# INLINE execWriter #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@ -mapWriter :: (Monoid w, Monoid w') => - ((a, w) -> (b, w')) -> Writer w a -> Writer w' b -mapWriter f = mapWriterT (Identity . f . runIdentity) -{-# INLINE mapWriter #-} - --- --------------------------------------------------------------------------- --- | A writer monad parameterized by: --- --- * @w@ - the output to accumulate. --- --- * @m@ - The inner monad. --- --- The 'return' function produces the output 'mempty', while '>>=' --- combines the outputs of the subcomputations using 'mappend'. - -newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) } - --- | Construct a writer computation from a (result, output) computation. --- (The inverse of 'runWriterT'.) -writerT :: (Functor m, Monoid w) => m (a, w) -> WriterT w m a -writerT f = WriterT $ \ w -> - (\ (a, w') -> let wt = w `mappend` w' in wt `seq` (a, wt)) <$> f -{-# INLINE writerT #-} - --- | Unwrap a writer computation. --- (The inverse of 'writerT'.) -runWriterT :: (Monoid w) => WriterT w m a -> m (a, w) -runWriterT m = unWriterT m mempty -{-# INLINE runWriterT #-} - --- | Extract the output from a writer computation. --- --- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@ -execWriterT :: (Monad m, Monoid w) => WriterT w m a -> m w -execWriterT m = do - (_, w) <- runWriterT m - return w -{-# INLINE execWriterT #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@ -mapWriterT :: (Monad n, Monoid w, Monoid w') => - (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b -mapWriterT f m = WriterT $ \ w -> do - (a, w') <- f (runWriterT m) - let wt = w `mappend` w' - wt `seq` return (a, wt) -{-# INLINE mapWriterT #-} - -instance (Functor m) => Functor (WriterT w m) where - fmap f m = WriterT $ \ w -> (\ (a, w') -> (f a, w')) <$> unWriterT m w - {-# INLINE fmap #-} - -instance (Functor m, Monad m) => Applicative (WriterT w m) where - pure a = WriterT $ \ w -> return (a, w) - {-# INLINE pure #-} - - WriterT mf <*> WriterT mx = WriterT $ \ w -> do - (f, w') <- mf w - (x, w'') <- mx w' - return (f x, w'') - {-# INLINE (<*>) #-} - -instance (Functor m, MonadPlus m) => Alternative (WriterT w m) where - empty = WriterT $ const mzero - {-# INLINE empty #-} - - WriterT m <|> WriterT n = WriterT $ \ w -> m w `mplus` n w - {-# INLINE (<|>) #-} - -instance (Monad m) => Monad (WriterT w m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = WriterT $ \ w -> return (a, w) - {-# INLINE return #-} -#endif - - m >>= k = WriterT $ \ w -> do - (a, w') <- unWriterT m w - unWriterT (k a) w' - {-# INLINE (>>=) #-} - -#if !(MIN_VERSION_base(4,13,0)) - fail msg = WriterT $ \ _ -> fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where - fail msg = WriterT $ \ _ -> Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (Functor m, MonadPlus m) => MonadPlus (WriterT w m) where - mzero = empty - {-# INLINE mzero #-} - mplus = (<|>) - {-# INLINE mplus #-} - -instance (MonadFix m) => MonadFix (WriterT w m) where - mfix f = WriterT $ \ w -> mfix $ \ ~(a, _) -> unWriterT (f a) w - {-# INLINE mfix #-} - -instance MonadTrans (WriterT w) where - lift m = WriterT $ \ w -> do - a <- m - return (a, w) - {-# INLINE lift #-} - -instance (MonadIO m) => MonadIO (WriterT w m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - --- | @'tell' w@ is an action that produces the output @w@. -tell :: (Monoid w, Monad m) => w -> WriterT w m () -tell w = writer ((), w) -{-# INLINE tell #-} - --- | @'listen' m@ is an action that executes the action @m@ and adds its --- output to the value of the computation. --- --- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@ -listen :: (Monoid w, Monad m) => WriterT w m a -> WriterT w m (a, w) -listen = listens id -{-# INLINE listen #-} - --- | @'listens' f m@ is an action that executes the action @m@ and adds --- the result of applying @f@ to the output to the value of the computation. --- --- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@ --- --- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@ -listens :: (Monoid w, Monad m) => - (w -> b) -> WriterT w m a -> WriterT w m (a, b) -listens f m = WriterT $ \ w -> do - (a, w') <- runWriterT m - let wt = w `mappend` w' - wt `seq` return ((a, f w'), wt) -{-# INLINE listens #-} - --- | @'pass' m@ is an action that executes the action @m@, which returns --- a value and a function, and returns the value, applying the function --- to the output. --- --- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@ -pass :: (Monoid w, Monoid w', Monad m) => - WriterT w m (a, w -> w') -> WriterT w' m a -pass m = WriterT $ \ w -> do - ((a, f), w') <- runWriterT m - let wt = w `mappend` f w' - wt `seq` return (a, wt) -{-# INLINE pass #-} - --- | @'censor' f m@ is an action that executes the action @m@ and --- applies the function @f@ to its output, leaving the return value --- unchanged. --- --- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@ --- --- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@ -censor :: (Monoid w, Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a -censor f m = WriterT $ \ w -> do - (a, w') <- runWriterT m - let wt = w `mappend` f w' - wt `seq` return (a, wt) -{-# INLINE censor #-} - --- | Uniform lifting of a @callCC@ operation to the new monad. --- This version rolls back to the original state on entering the --- continuation. -liftCallCC :: CallCC m (a, w) (b, w) -> CallCC (WriterT w m) a b -liftCallCC callCC f = WriterT $ \ w -> - callCC $ \ c -> unWriterT (f (\ a -> WriterT $ \ _ -> c (a, w))) w -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a, w) -> Catch e (WriterT w m) a -liftCatch catchE m h = WriterT $ \ w -> - unWriterT m w `catchE` \ e -> unWriterT (h e) w -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Lazy.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Lazy.hs deleted file mode 100644 index d12b0e7d58..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Lazy.hs +++ /dev/null @@ -1,313 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Writer.Lazy --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The lazy 'WriterT' monad transformer, which adds collection of --- outputs (such as a count or string output) to a given monad. --- --- This monad transformer provides only limited access to the output --- during the computation. For more general access, use --- "Control.Monad.Trans.State" instead. --- --- This version builds its output lazily; for a constant-space version --- with almost the same interface, see "Control.Monad.Trans.Writer.CPS". ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Writer.Lazy ( - -- * The Writer monad - Writer, - writer, - runWriter, - execWriter, - mapWriter, - -- * The WriterT monad transformer - WriterT(..), - execWriterT, - mapWriterT, - -- * Writer operations - tell, - listen, - listens, - pass, - censor, - -- * Lifting other operations - liftCallCC, - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -import Control.Monad.Signatures -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable -import Data.Monoid -import Data.Traversable (Traversable(traverse)) -import Prelude hiding (null, length) - --- --------------------------------------------------------------------------- --- | A writer monad parameterized by the type @w@ of output to accumulate. --- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. -type Writer w = WriterT w Identity - --- | Construct a writer computation from a (result, output) pair. --- (The inverse of 'runWriter'.) -writer :: (Monad m) => (a, w) -> WriterT w m a -writer = WriterT . return -{-# INLINE writer #-} - --- | Unwrap a writer computation as a (result, output) pair. --- (The inverse of 'writer'.) -runWriter :: Writer w a -> (a, w) -runWriter = runIdentity . runWriterT -{-# INLINE runWriter #-} - --- | Extract the output from a writer computation. --- --- * @'execWriter' m = 'snd' ('runWriter' m)@ -execWriter :: Writer w a -> w -execWriter m = snd (runWriter m) -{-# INLINE execWriter #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@ -mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b -mapWriter f = mapWriterT (Identity . f . runIdentity) -{-# INLINE mapWriter #-} - --- --------------------------------------------------------------------------- --- | A writer monad parameterized by: --- --- * @w@ - the output to accumulate. --- --- * @m@ - The inner monad. --- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. -newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } - -instance (Eq w, Eq1 m) => Eq1 (WriterT w m) where - liftEq eq (WriterT m1) (WriterT m2) = liftEq (liftEq2 eq (==)) m1 m2 - {-# INLINE liftEq #-} - -instance (Ord w, Ord1 m) => Ord1 (WriterT w m) where - liftCompare comp (WriterT m1) (WriterT m2) = - liftCompare (liftCompare2 comp compare) m1 m2 - {-# INLINE liftCompare #-} - -instance (Read w, Read1 m) => Read1 (WriterT w m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "WriterT" WriterT - where - rp' = liftReadsPrec2 rp rl readsPrec readList - rl' = liftReadList2 rp rl readsPrec readList - -instance (Show w, Show1 m) => Show1 (WriterT w m) where - liftShowsPrec sp sl d (WriterT m) = - showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d m - where - sp' = liftShowsPrec2 sp sl showsPrec showList - sl' = liftShowList2 sp sl showsPrec showList - -instance (Eq w, Eq1 m, Eq a) => Eq (WriterT w m a) where (==) = eq1 -instance (Ord w, Ord1 m, Ord a) => Ord (WriterT w m a) where compare = compare1 -instance (Read w, Read1 m, Read a) => Read (WriterT w m a) where - readsPrec = readsPrec1 -instance (Show w, Show1 m, Show a) => Show (WriterT w m a) where - showsPrec = showsPrec1 - --- | Extract the output from a writer computation. --- --- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@ -execWriterT :: (Monad m) => WriterT w m a -> m w -execWriterT m = do - ~(_, w) <- runWriterT m - return w -{-# INLINE execWriterT #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@ -mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b -mapWriterT f m = WriterT $ f (runWriterT m) -{-# INLINE mapWriterT #-} - -instance (Functor m) => Functor (WriterT w m) where - fmap f = mapWriterT $ fmap $ \ ~(a, w) -> (f a, w) - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (WriterT w f) where - foldMap f = foldMap (f . fst) . runWriterT - {-# INLINE foldMap #-} -#if MIN_VERSION_base(4,8,0) - null (WriterT t) = null t - length (WriterT t) = length t -#endif - -instance (Traversable f) => Traversable (WriterT w f) where - traverse f = fmap WriterT . traverse f' . runWriterT where - f' (a, b) = fmap (\ c -> (c, b)) (f a) - {-# INLINE traverse #-} - -instance (Monoid w, Applicative m) => Applicative (WriterT w m) where - pure a = WriterT $ pure (a, mempty) - {-# INLINE pure #-} - f <*> v = WriterT $ liftA2 k (runWriterT f) (runWriterT v) - where k ~(a, w) ~(b, w') = (a b, w `mappend` w') - {-# INLINE (<*>) #-} - -instance (Monoid w, Alternative m) => Alternative (WriterT w m) where - empty = WriterT empty - {-# INLINE empty #-} - m <|> n = WriterT $ runWriterT m <|> runWriterT n - {-# INLINE (<|>) #-} - -instance (Monoid w, Monad m) => Monad (WriterT w m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = writer (a, mempty) - {-# INLINE return #-} -#endif - m >>= k = WriterT $ do - ~(a, w) <- runWriterT m - ~(b, w') <- runWriterT (k a) - return (b, w `mappend` w') - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = WriterT $ fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where - fail msg = WriterT $ Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where - mzero = WriterT mzero - {-# INLINE mzero #-} - m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n - {-# INLINE mplus #-} - -instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where - mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a) - {-# INLINE mfix #-} - -instance (Monoid w) => MonadTrans (WriterT w) where - lift m = WriterT $ do - a <- m - return (a, mempty) - {-# INLINE lift #-} - -instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where - mzipWith f (WriterT x) (WriterT y) = WriterT $ - mzipWith (\ ~(a, w) ~(b, w') -> (f a b, w `mappend` w')) x y - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (WriterT w m) where - contramap f = mapWriterT $ contramap $ \ ~(a, w) -> (f a, w) - {-# INLINE contramap #-} -#endif - --- | @'tell' w@ is an action that produces the output @w@. -tell :: (Monad m) => w -> WriterT w m () -tell w = writer ((), w) -{-# INLINE tell #-} - --- | @'listen' m@ is an action that executes the action @m@ and adds its --- output to the value of the computation. --- --- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@ -listen :: (Monad m) => WriterT w m a -> WriterT w m (a, w) -listen m = WriterT $ do - ~(a, w) <- runWriterT m - return ((a, w), w) -{-# INLINE listen #-} - --- | @'listens' f m@ is an action that executes the action @m@ and adds --- the result of applying @f@ to the output to the value of the computation. --- --- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@ --- --- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@ -listens :: (Monad m) => (w -> b) -> WriterT w m a -> WriterT w m (a, b) -listens f m = WriterT $ do - ~(a, w) <- runWriterT m - return ((a, f w), w) -{-# INLINE listens #-} - --- | @'pass' m@ is an action that executes the action @m@, which returns --- a value and a function, and returns the value, applying the function --- to the output. --- --- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@ -pass :: (Monad m) => WriterT w m (a, w -> w) -> WriterT w m a -pass m = WriterT $ do - ~((a, f), w) <- runWriterT m - return (a, f w) -{-# INLINE pass #-} - --- | @'censor' f m@ is an action that executes the action @m@ and --- applies the function @f@ to its output, leaving the return value --- unchanged. --- --- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@ --- --- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@ -censor :: (Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a -censor f m = WriterT $ do - ~(a, w) <- runWriterT m - return (a, f w) -{-# INLINE censor #-} - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: (Monoid w) => CallCC m (a,w) (b,w) -> CallCC (WriterT w m) a b -liftCallCC callCC f = WriterT $ - callCC $ \ c -> - runWriterT (f (\ a -> WriterT $ c (a, mempty))) -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a -liftCatch catchE m h = - WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e) -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Strict.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Strict.hs deleted file mode 100644 index f39862c020..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Strict.hs +++ /dev/null @@ -1,316 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans.Writer.Strict --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The strict 'WriterT' monad transformer, which adds collection of --- outputs (such as a count or string output) to a given monad. --- --- This monad transformer provides only limited access to the output --- during the computation. For more general access, use --- "Control.Monad.Trans.State" instead. --- --- This version builds its output strictly; for a lazy version with --- the same interface, see "Control.Monad.Trans.Writer.Lazy". --- Although the output is built strictly, it is not possible to --- achieve constant space behaviour with this transformer: for that, --- use "Control.Monad.Trans.Writer.CPS" instead. ------------------------------------------------------------------------------ - -module Control.Monad.Trans.Writer.Strict ( - -- * The Writer monad - Writer, - writer, - runWriter, - execWriter, - mapWriter, - -- * The WriterT monad transformer - WriterT(..), - execWriterT, - mapWriterT, - -- * Writer operations - tell, - listen, - listens, - pass, - censor, - -- * Lifting other operations - liftCallCC, - liftCatch, - ) where - -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Functor.Identity - -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Control.Monad.Fix -import Control.Monad.Signatures -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -import Data.Foldable -import Data.Monoid -import Data.Traversable (Traversable(traverse)) -import Prelude hiding (null, length) - --- --------------------------------------------------------------------------- --- | A writer monad parameterized by the type @w@ of output to accumulate. --- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. -type Writer w = WriterT w Identity - --- | Construct a writer computation from a (result, output) pair. --- (The inverse of 'runWriter'.) -writer :: (Monad m) => (a, w) -> WriterT w m a -writer = WriterT . return -{-# INLINE writer #-} - --- | Unwrap a writer computation as a (result, output) pair. --- (The inverse of 'writer'.) -runWriter :: Writer w a -> (a, w) -runWriter = runIdentity . runWriterT -{-# INLINE runWriter #-} - --- | Extract the output from a writer computation. --- --- * @'execWriter' m = 'snd' ('runWriter' m)@ -execWriter :: Writer w a -> w -execWriter m = snd (runWriter m) -{-# INLINE execWriter #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@ -mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b -mapWriter f = mapWriterT (Identity . f . runIdentity) -{-# INLINE mapWriter #-} - --- --------------------------------------------------------------------------- --- | A writer monad parameterized by: --- --- * @w@ - the output to accumulate. --- --- * @m@ - The inner monad. --- --- The 'return' function produces the output 'mempty', while @>>=@ --- combines the outputs of the subcomputations using 'mappend'. -newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } - -instance (Eq w, Eq1 m) => Eq1 (WriterT w m) where - liftEq eq (WriterT m1) (WriterT m2) = liftEq (liftEq2 eq (==)) m1 m2 - {-# INLINE liftEq #-} - -instance (Ord w, Ord1 m) => Ord1 (WriterT w m) where - liftCompare comp (WriterT m1) (WriterT m2) = - liftCompare (liftCompare2 comp compare) m1 m2 - {-# INLINE liftCompare #-} - -instance (Read w, Read1 m) => Read1 (WriterT w m) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "WriterT" WriterT - where - rp' = liftReadsPrec2 rp rl readsPrec readList - rl' = liftReadList2 rp rl readsPrec readList - -instance (Show w, Show1 m) => Show1 (WriterT w m) where - liftShowsPrec sp sl d (WriterT m) = - showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d m - where - sp' = liftShowsPrec2 sp sl showsPrec showList - sl' = liftShowList2 sp sl showsPrec showList - -instance (Eq w, Eq1 m, Eq a) => Eq (WriterT w m a) where (==) = eq1 -instance (Ord w, Ord1 m, Ord a) => Ord (WriterT w m a) where compare = compare1 -instance (Read w, Read1 m, Read a) => Read (WriterT w m a) where - readsPrec = readsPrec1 -instance (Show w, Show1 m, Show a) => Show (WriterT w m a) where - showsPrec = showsPrec1 - --- | Extract the output from a writer computation. --- --- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@ -execWriterT :: (Monad m) => WriterT w m a -> m w -execWriterT m = do - (_, w) <- runWriterT m - return w -{-# INLINE execWriterT #-} - --- | Map both the return value and output of a computation using --- the given function. --- --- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@ -mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b -mapWriterT f m = WriterT $ f (runWriterT m) -{-# INLINE mapWriterT #-} - -instance (Functor m) => Functor (WriterT w m) where - fmap f = mapWriterT $ fmap $ \ (a, w) -> (f a, w) - {-# INLINE fmap #-} - -instance (Foldable f) => Foldable (WriterT w f) where - foldMap f = foldMap (f . fst) . runWriterT - {-# INLINE foldMap #-} -#if MIN_VERSION_base(4,8,0) - null (WriterT t) = null t - length (WriterT t) = length t -#endif - -instance (Traversable f) => Traversable (WriterT w f) where - traverse f = fmap WriterT . traverse f' . runWriterT where - f' (a, b) = fmap (\ c -> (c, b)) (f a) - {-# INLINE traverse #-} - -instance (Monoid w, Applicative m) => Applicative (WriterT w m) where - pure a = WriterT $ pure (a, mempty) - {-# INLINE pure #-} - f <*> v = WriterT $ liftA2 k (runWriterT f) (runWriterT v) - where k (a, w) (b, w') = (a b, w `mappend` w') - {-# INLINE (<*>) #-} - -instance (Monoid w, Alternative m) => Alternative (WriterT w m) where - empty = WriterT empty - {-# INLINE empty #-} - m <|> n = WriterT $ runWriterT m <|> runWriterT n - {-# INLINE (<|>) #-} - -instance (Monoid w, Monad m) => Monad (WriterT w m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = writer (a, mempty) - {-# INLINE return #-} -#endif - m >>= k = WriterT $ do - (a, w) <- runWriterT m - (b, w') <- runWriterT (k a) - return (b, w `mappend` w') - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = WriterT $ fail msg - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where - fail msg = WriterT $ Fail.fail msg - {-# INLINE fail #-} -#endif - -instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where - mzero = WriterT mzero - {-# INLINE mzero #-} - m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n - {-# INLINE mplus #-} - -instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where - mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a) - {-# INLINE mfix #-} - -instance (Monoid w) => MonadTrans (WriterT w) where - lift m = WriterT $ do - a <- m - return (a, mempty) - {-# INLINE lift #-} - -instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where - liftIO = lift . liftIO - {-# INLINE liftIO #-} - -#if MIN_VERSION_base(4,4,0) -instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where - mzipWith f (WriterT x) (WriterT y) = WriterT $ - mzipWith (\ (a, w) (b, w') -> (f a b, w `mappend` w')) x y - {-# INLINE mzipWith #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant m => Contravariant (WriterT w m) where - contramap f = mapWriterT $ contramap $ \ (a, w) -> (f a, w) - {-# INLINE contramap #-} -#endif - --- | @'tell' w@ is an action that produces the output @w@. -tell :: (Monad m) => w -> WriterT w m () -tell w = writer ((), w) -{-# INLINE tell #-} - --- | @'listen' m@ is an action that executes the action @m@ and adds its --- output to the value of the computation. --- --- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@ -listen :: (Monad m) => WriterT w m a -> WriterT w m (a, w) -listen m = WriterT $ do - (a, w) <- runWriterT m - return ((a, w), w) -{-# INLINE listen #-} - --- | @'listens' f m@ is an action that executes the action @m@ and adds --- the result of applying @f@ to the output to the value of the computation. --- --- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@ --- --- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@ -listens :: (Monad m) => (w -> b) -> WriterT w m a -> WriterT w m (a, b) -listens f m = WriterT $ do - (a, w) <- runWriterT m - return ((a, f w), w) -{-# INLINE listens #-} - --- | @'pass' m@ is an action that executes the action @m@, which returns --- a value and a function, and returns the value, applying the function --- to the output. --- --- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@ -pass :: (Monad m) => WriterT w m (a, w -> w) -> WriterT w m a -pass m = WriterT $ do - ((a, f), w) <- runWriterT m - return (a, f w) -{-# INLINE pass #-} - --- | @'censor' f m@ is an action that executes the action @m@ and --- applies the function @f@ to its output, leaving the return value --- unchanged. --- --- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@ --- --- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@ -censor :: (Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a -censor f m = WriterT $ do - (a, w) <- runWriterT m - return (a, f w) -{-# INLINE censor #-} - --- | Lift a @callCC@ operation to the new monad. -liftCallCC :: (Monoid w) => CallCC m (a,w) (b,w) -> CallCC (WriterT w m) a b -liftCallCC callCC f = WriterT $ - callCC $ \ c -> - runWriterT (f (\ a -> WriterT $ c (a, mempty))) -{-# INLINE liftCallCC #-} - --- | Lift a @catchE@ operation to the new monad. -liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a -liftCatch catchE m h = - WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e) -{-# INLINE liftCatch #-} diff --git a/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs b/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs deleted file mode 100644 index 9c0b8d42dc..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Constant --- Copyright : (c) Ross Paterson 2010 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- The constant functor. ------------------------------------------------------------------------------ - -module Data.Functor.Constant ( - Constant(..), - ) where - -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -import Data.Foldable -import Data.Monoid (Monoid(..)) -import Data.Traversable (Traversable(traverse)) -#if MIN_VERSION_base(4,8,0) -import Data.Bifunctor (Bifunctor(..)) -#endif -#if MIN_VERSION_base(4,9,0) -import Data.Semigroup (Semigroup(..)) -#endif -#if MIN_VERSION_base(4,10,0) -import Data.Bifoldable (Bifoldable(..)) -import Data.Bitraversable (Bitraversable(..)) -#endif -import Prelude hiding (null, length) - --- | Constant functor. -newtype Constant a b = Constant { getConstant :: a } - deriving (Eq, Ord) - --- These instances would be equivalent to the derived instances of the --- newtype if the field were removed. - -instance (Read a) => Read (Constant a b) where - readsPrec = readsData $ - readsUnaryWith readsPrec "Constant" Constant - -instance (Show a) => Show (Constant a b) where - showsPrec d (Constant x) = showsUnaryWith showsPrec "Constant" d x - --- Instances of lifted Prelude classes - -instance Eq2 Constant where - liftEq2 eq _ (Constant x) (Constant y) = eq x y - {-# INLINE liftEq2 #-} - -instance Ord2 Constant where - liftCompare2 comp _ (Constant x) (Constant y) = comp x y - {-# INLINE liftCompare2 #-} - -instance Read2 Constant where - liftReadsPrec2 rp _ _ _ = readsData $ - readsUnaryWith rp "Constant" Constant - -instance Show2 Constant where - liftShowsPrec2 sp _ _ _ d (Constant x) = showsUnaryWith sp "Constant" d x - -instance (Eq a) => Eq1 (Constant a) where - liftEq = liftEq2 (==) - {-# INLINE liftEq #-} -instance (Ord a) => Ord1 (Constant a) where - liftCompare = liftCompare2 compare - {-# INLINE liftCompare #-} -instance (Read a) => Read1 (Constant a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList - {-# INLINE liftReadsPrec #-} -instance (Show a) => Show1 (Constant a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - {-# INLINE liftShowsPrec #-} - -instance Functor (Constant a) where - fmap _ (Constant x) = Constant x - {-# INLINE fmap #-} - -instance Foldable (Constant a) where - foldMap _ (Constant _) = mempty - {-# INLINE foldMap #-} -#if MIN_VERSION_base(4,8,0) - null (Constant _) = True - length (Constant _) = 0 -#endif - -instance Traversable (Constant a) where - traverse _ (Constant x) = pure (Constant x) - {-# INLINE traverse #-} - -#if MIN_VERSION_base(4,9,0) -instance (Semigroup a) => Semigroup (Constant a b) where - Constant x <> Constant y = Constant (x <> y) - {-# INLINE (<>) #-} -#endif - -instance (Monoid a) => Applicative (Constant a) where - pure _ = Constant mempty - {-# INLINE pure #-} - Constant x <*> Constant y = Constant (x `mappend` y) - {-# INLINE (<*>) #-} - -instance (Monoid a) => Monoid (Constant a b) where - mempty = Constant mempty - {-# INLINE mempty #-} -#if !MIN_VERSION_base(4,11,0) - -- From base-4.11, Monoid(mappend) defaults to Semigroup((<>)) - Constant x `mappend` Constant y = Constant (x `mappend` y) - {-# INLINE mappend #-} -#endif - -#if MIN_VERSION_base(4,8,0) -instance Bifunctor Constant where - first f (Constant x) = Constant (f x) - {-# INLINE first #-} - second _ (Constant x) = Constant x - {-# INLINE second #-} -#endif - -#if MIN_VERSION_base(4,10,0) -instance Bifoldable Constant where - bifoldMap f _ (Constant a) = f a - {-# INLINE bifoldMap #-} - -instance Bitraversable Constant where - bitraverse f _ (Constant a) = Constant <$> f a - {-# INLINE bitraverse #-} -#endif - -#if MIN_VERSION_base(4,12,0) -instance Contravariant (Constant a) where - contramap _ (Constant a) = Constant a - {-# INLINE contramap #-} -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs b/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs deleted file mode 100644 index 5d8c41fa15..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs +++ /dev/null @@ -1,143 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Reverse --- Copyright : (c) Russell O'Connor 2009 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Making functors whose elements are notionally in the reverse order --- from the original functor. ------------------------------------------------------------------------------ - -module Data.Functor.Reverse ( - Reverse(..), - ) where - -import Control.Applicative.Backwards -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length) -import Control.Applicative -import Control.Monad -#if MIN_VERSION_base(4,9,0) -import qualified Control.Monad.Fail as Fail -#endif -import Data.Foldable -import Data.Traversable -import Data.Monoid - --- | The same functor, but with 'Foldable' and 'Traversable' instances --- that process the elements in the reverse order. -newtype Reverse f a = Reverse { getReverse :: f a } - -instance (Eq1 f) => Eq1 (Reverse f) where - liftEq eq (Reverse x) (Reverse y) = liftEq eq x y - {-# INLINE liftEq #-} - -instance (Ord1 f) => Ord1 (Reverse f) where - liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y - {-# INLINE liftCompare #-} - -instance (Read1 f) => Read1 (Reverse f) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse - -instance (Show1 f) => Show1 (Reverse f) where - liftShowsPrec sp sl d (Reverse x) = - showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x - -instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1 -instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1 -instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1 -instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1 - --- | Derived instance. -instance (Functor f) => Functor (Reverse f) where - fmap f (Reverse a) = Reverse (fmap f a) - {-# INLINE fmap #-} - --- | Derived instance. -instance (Applicative f) => Applicative (Reverse f) where - pure a = Reverse (pure a) - {-# INLINE pure #-} - Reverse f <*> Reverse a = Reverse (f <*> a) - {-# INLINE (<*>) #-} - --- | Derived instance. -instance (Alternative f) => Alternative (Reverse f) where - empty = Reverse empty - {-# INLINE empty #-} - Reverse x <|> Reverse y = Reverse (x <|> y) - {-# INLINE (<|>) #-} - --- | Derived instance. -instance (Monad m) => Monad (Reverse m) where -#if !(MIN_VERSION_base(4,8,0)) - return a = Reverse (return a) - {-# INLINE return #-} -#endif - m >>= f = Reverse (getReverse m >>= getReverse . f) - {-# INLINE (>>=) #-} -#if !(MIN_VERSION_base(4,13,0)) - fail msg = Reverse (fail msg) - {-# INLINE fail #-} -#endif - -#if MIN_VERSION_base(4,9,0) -instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where - fail msg = Reverse (Fail.fail msg) - {-# INLINE fail #-} -#endif - --- | Derived instance. -instance (MonadPlus m) => MonadPlus (Reverse m) where - mzero = Reverse mzero - {-# INLINE mzero #-} - Reverse x `mplus` Reverse y = Reverse (x `mplus` y) - {-# INLINE mplus #-} - --- | Fold from right to left. -instance (Foldable f) => Foldable (Reverse f) where - foldMap f (Reverse t) = getDual (foldMap (Dual . f) t) - {-# INLINE foldMap #-} - foldr f z (Reverse t) = foldl (flip f) z t - {-# INLINE foldr #-} - foldl f z (Reverse t) = foldr (flip f) z t - {-# INLINE foldl #-} - foldr1 f (Reverse t) = foldl1 (flip f) t - {-# INLINE foldr1 #-} - foldl1 f (Reverse t) = foldr1 (flip f) t - {-# INLINE foldl1 #-} -#if MIN_VERSION_base(4,8,0) - null (Reverse t) = null t - length (Reverse t) = length t -#endif - --- | Traverse from right to left. -instance (Traversable f) => Traversable (Reverse f) where - traverse f (Reverse t) = - fmap Reverse . forwards $ traverse (Backwards . f) t - {-# INLINE traverse #-} - -#if MIN_VERSION_base(4,12,0) --- | Derived instance. -instance Contravariant f => Contravariant (Reverse f) where - contramap f = Reverse . contramap f . getReverse - {-# INLINE contramap #-} -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/LICENSE b/third_party/bazel/rules_haskell/examples/transformers/LICENSE deleted file mode 100644 index 92337b951e..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/LICENSE +++ /dev/null @@ -1,31 +0,0 @@ -The Glasgow Haskell Compiler License - -Copyright 2004, The University Court of the University of Glasgow. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. diff --git a/third_party/bazel/rules_haskell/examples/transformers/Setup.hs b/third_party/bazel/rules_haskell/examples/transformers/Setup.hs deleted file mode 100644 index 9a994af677..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/third_party/bazel/rules_haskell/examples/transformers/changelog b/third_party/bazel/rules_haskell/examples/transformers/changelog deleted file mode 100644 index 5dd688f35b..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/changelog +++ /dev/null @@ -1,124 +0,0 @@ --*-change-log-*- - -0.5.6.2 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019 - * Further backward compatability fix - -0.5.6.1 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019 - * Backward compatability fix for MonadFix ListT instance - -0.5.6.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019 - * Generalized type of except - * Added Control.Monad.Trans.Writer.CPS and Control.Monad.Trans.RWS.CPS - * Added Contravariant instances - * Added MonadFix instance for ListT - -0.5.5.0 Ross Paterson <R.Paterson@city.ac.uk> Oct 2017 - * Added mapSelect and mapSelectT - * Renamed selectToCont to selectToContT for consistency - * Defined explicit method definitions to fix space leaks - * Added missing Semigroup instance to `Constant` functor - -0.5.4.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2017 - * Migrate Bifoldable and Bitraversable instances for Constant - -0.5.3.1 Ross Paterson <R.Paterson@city.ac.uk> Feb 2017 - * Fixed for pre-AMP environments - -0.5.3.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2017 - * Added AccumT and SelectT monad transformers - * Deprecated ListT - * Added Monad (and related) instances for Reverse - * Added elimLift and eitherToErrors - * Added specialized definitions of several methods for efficiency - * Removed specialized definition of sequenceA for Reverse - * Backported Eq1/Ord1/Read1/Show1 instances for Proxy - -0.5.2.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2016 - * Re-added orphan instances for Either to deprecated module - * Added lots of INLINE pragmas - -0.5.1.0 Ross Paterson <R.Paterson@city.ac.uk> Jan 2016 - * Bump minor version number, required by added instances - -0.5.0.2 Ross Paterson <R.Paterson@city.ac.uk> Jan 2016 - * Backported extra instances for Identity - -0.5.0.1 Ross Paterson <R.Paterson@city.ac.uk> Jan 2016 - * Tightened GHC bounds for PolyKinds and DeriveDataTypeable - -0.5.0.0 Ross Paterson <R.Paterson@city.ac.uk> Dec 2015 - * Control.Monad.IO.Class in base for GHC >= 8.0 - * Data.Functor.{Classes,Compose,Product,Sum} in base for GHC >= 8.0 - * Added PolyKinds for GHC >= 7.4 - * Added instances of base classes MonadZip and MonadFail - * Changed liftings of Prelude classes to use explicit dictionaries - -0.4.3.0 Ross Paterson <R.Paterson@city.ac.uk> Mar 2015 - * Added Eq1, Ord1, Show1 and Read1 instances for Const - -0.4.2.0 Ross Paterson <ross@soi.city.ac.uk> Nov 2014 - * Dropped compatibility with base-1.x - * Data.Functor.Identity in base for GHC >= 7.10 - * Added mapLift and runErrors to Control.Applicative.Lift - * Added AutoDeriveTypeable for GHC >= 7.10 - * Expanded messages from mfix on ExceptT and MaybeT - -0.4.1.0 Ross Paterson <ross@soi.city.ac.uk> May 2014 - * Reverted to record syntax for newtypes until next major release - -0.4.0.0 Ross Paterson <ross@soi.city.ac.uk> May 2014 - * Added Sum type - * Added modify', a strict version of modify, to the state monads - * Added ExceptT and deprecated ErrorT - * Added infixr 9 `Compose` to match (.) - * Added Eq, Ord, Read and Show instances where possible - * Replaced record syntax for newtypes with separate inverse functions - * Added delimited continuation functions to ContT - * Added instance Alternative IO to ErrorT - * Handled disappearance of Control.Monad.Instances - -0.3.0.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2012 - * Added type synonyms for signatures of complex operations - * Generalized state, reader and writer constructor functions - * Added Lift, Backwards/Reverse - * Added MonadFix instances for IdentityT and MaybeT - * Added Foldable and Traversable instances - * Added Monad instances for Product - -0.2.2.1 Ross Paterson <ross@soi.city.ac.uk> Oct 2013 - * Backport of fix for disappearance of Control.Monad.Instances - -0.2.2.0 Ross Paterson <ross@soi.city.ac.uk> Sep 2010 - * Handled move of Either instances to base package - -0.2.1.0 Ross Paterson <ross@soi.city.ac.uk> Apr 2010 - * Added Alternative instance for Compose - * Added Data.Functor.Product - -0.2.0.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2010 - * Added Constant and Compose - * Renamed modules to avoid clash with mtl - * Removed Monad constraint from Monad instance for ContT - -0.1.4.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2009 - * Adjusted lifting of Identity and Maybe transformers - -0.1.3.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2009 - * Added IdentityT transformer - * Added Applicative and Alternative instances for (Either e) - -0.1.1.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009 - * Made all Functor instances assume Functor - -0.1.0.1 Ross Paterson <ross@soi.city.ac.uk> Jan 2009 - * Adjusted dependencies - -0.1.0.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009 - * Two versions of lifting of callcc through StateT - * Added Applicative instances - -0.0.1.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009 - * Added constructors state, etc for simple monads - -0.0.0.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009 - * Split Haskell 98 transformers from the mtl diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs deleted file mode 100644 index 940e4e470f..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs +++ /dev/null @@ -1,259 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 700 -{-# LANGUAGE DeriveDataTypeable #-} -#endif -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE Trustworthy #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE AutoDeriveTypeable #-} -{-# LANGUAGE DataKinds #-} -#endif -#if MIN_VERSION_base(4,7,0) --- We need to implement bitSize for the Bits instance, but it's deprecated. -{-# OPTIONS_GHC -fno-warn-deprecations #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Identity --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : ross@soi.city.ac.uk --- Stability : experimental --- Portability : portable --- --- The identity functor and monad. --- --- This trivial type constructor serves two purposes: --- --- * It can be used with functions parameterized by functor or monad classes. --- --- * It can be used as a base monad to which a series of monad --- transformers may be applied to construct a composite monad. --- Most monad transformer modules include the special case of --- applying the transformer to 'Identity'. For example, @State s@ --- is an abbreviation for @StateT s 'Identity'@. ------------------------------------------------------------------------------ - -module Data.Functor.Identity ( - Identity(..), - ) where - -import Data.Bits -import Control.Applicative -import Control.Arrow (Arrow((***))) -import Control.Monad.Fix -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith, munzip)) -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Monoid (Monoid(mempty, mappend)) -import Data.String (IsString(fromString)) -import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 700 -import Data.Data -#endif -import Data.Ix (Ix(..)) -import Foreign (Storable(..), castPtr) -#if __GLASGOW_HASKELL__ >= 702 -import GHC.Generics -#endif - --- | Identity functor and monad. (a non-strict monad) -newtype Identity a = Identity { runIdentity :: a } - deriving ( Eq, Ord -#if __GLASGOW_HASKELL__ >= 700 - , Data, Typeable -#endif -#if __GLASGOW_HASKELL__ >= 702 - , Generic -#endif -#if __GLASGOW_HASKELL__ >= 706 - , Generic1 -#endif - ) - -instance (Bits a) => Bits (Identity a) where - Identity x .&. Identity y = Identity (x .&. y) - Identity x .|. Identity y = Identity (x .|. y) - xor (Identity x) (Identity y) = Identity (xor x y) - complement (Identity x) = Identity (complement x) - shift (Identity x) i = Identity (shift x i) - rotate (Identity x) i = Identity (rotate x i) - setBit (Identity x) i = Identity (setBit x i) - clearBit (Identity x) i = Identity (clearBit x i) - shiftL (Identity x) i = Identity (shiftL x i) - shiftR (Identity x) i = Identity (shiftR x i) - rotateL (Identity x) i = Identity (rotateL x i) - rotateR (Identity x) i = Identity (rotateR x i) - testBit (Identity x) i = testBit x i - bitSize (Identity x) = bitSize x - isSigned (Identity x) = isSigned x - bit i = Identity (bit i) -#if MIN_VERSION_base(4,5,0) - unsafeShiftL (Identity x) i = Identity (unsafeShiftL x i) - unsafeShiftR (Identity x) i = Identity (unsafeShiftR x i) - popCount (Identity x) = popCount x -#endif -#if MIN_VERSION_base(4,7,0) - zeroBits = Identity zeroBits - bitSizeMaybe (Identity x) = bitSizeMaybe x -#endif - -instance (Bounded a) => Bounded (Identity a) where - minBound = Identity minBound - maxBound = Identity maxBound - -instance (Enum a) => Enum (Identity a) where - succ (Identity x) = Identity (succ x) - pred (Identity x) = Identity (pred x) - toEnum i = Identity (toEnum i) - fromEnum (Identity x) = fromEnum x - enumFrom (Identity x) = map Identity (enumFrom x) - enumFromThen (Identity x) (Identity y) = map Identity (enumFromThen x y) - enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y) - enumFromThenTo (Identity x) (Identity y) (Identity z) = - map Identity (enumFromThenTo x y z) - -#if MIN_VERSION_base(4,7,0) -instance (FiniteBits a) => FiniteBits (Identity a) where - finiteBitSize (Identity x) = finiteBitSize x -#endif - -instance (Floating a) => Floating (Identity a) where - pi = Identity pi - exp (Identity x) = Identity (exp x) - log (Identity x) = Identity (log x) - sqrt (Identity x) = Identity (sqrt x) - sin (Identity x) = Identity (sin x) - cos (Identity x) = Identity (cos x) - tan (Identity x) = Identity (tan x) - asin (Identity x) = Identity (asin x) - acos (Identity x) = Identity (acos x) - atan (Identity x) = Identity (atan x) - sinh (Identity x) = Identity (sinh x) - cosh (Identity x) = Identity (cosh x) - tanh (Identity x) = Identity (tanh x) - asinh (Identity x) = Identity (asinh x) - acosh (Identity x) = Identity (acosh x) - atanh (Identity x) = Identity (atanh x) - Identity x ** Identity y = Identity (x ** y) - logBase (Identity x) (Identity y) = Identity (logBase x y) - -instance (Fractional a) => Fractional (Identity a) where - Identity x / Identity y = Identity (x / y) - recip (Identity x) = Identity (recip x) - fromRational r = Identity (fromRational r) - -instance (IsString a) => IsString (Identity a) where - fromString s = Identity (fromString s) - -instance (Ix a) => Ix (Identity a) where - range (Identity x, Identity y) = map Identity (range (x, y)) - index (Identity x, Identity y) (Identity i) = index (x, y) i - inRange (Identity x, Identity y) (Identity e) = inRange (x, y) e - rangeSize (Identity x, Identity y) = rangeSize (x, y) - -instance (Integral a) => Integral (Identity a) where - quot (Identity x) (Identity y) = Identity (quot x y) - rem (Identity x) (Identity y) = Identity (rem x y) - div (Identity x) (Identity y) = Identity (div x y) - mod (Identity x) (Identity y) = Identity (mod x y) - quotRem (Identity x) (Identity y) = (Identity *** Identity) (quotRem x y) - divMod (Identity x) (Identity y) = (Identity *** Identity) (divMod x y) - toInteger (Identity x) = toInteger x - -instance (Monoid a) => Monoid (Identity a) where - mempty = Identity mempty - mappend (Identity x) (Identity y) = Identity (mappend x y) - -instance (Num a) => Num (Identity a) where - Identity x + Identity y = Identity (x + y) - Identity x - Identity y = Identity (x - y) - Identity x * Identity y = Identity (x * y) - negate (Identity x) = Identity (negate x) - abs (Identity x) = Identity (abs x) - signum (Identity x) = Identity (signum x) - fromInteger n = Identity (fromInteger n) - -instance (Real a) => Real (Identity a) where - toRational (Identity x) = toRational x - -instance (RealFloat a) => RealFloat (Identity a) where - floatRadix (Identity x) = floatRadix x - floatDigits (Identity x) = floatDigits x - floatRange (Identity x) = floatRange x - decodeFloat (Identity x) = decodeFloat x - exponent (Identity x) = exponent x - isNaN (Identity x) = isNaN x - isInfinite (Identity x) = isInfinite x - isDenormalized (Identity x) = isDenormalized x - isNegativeZero (Identity x) = isNegativeZero x - isIEEE (Identity x) = isIEEE x - significand (Identity x) = significand (Identity x) - scaleFloat s (Identity x) = Identity (scaleFloat s x) - encodeFloat m n = Identity (encodeFloat m n) - atan2 (Identity x) (Identity y) = Identity (atan2 x y) - -instance (RealFrac a) => RealFrac (Identity a) where - properFraction (Identity x) = (id *** Identity) (properFraction x) - truncate (Identity x) = truncate x - round (Identity x) = round x - ceiling (Identity x) = ceiling x - floor (Identity x) = floor x - -instance (Storable a) => Storable (Identity a) where - sizeOf (Identity x) = sizeOf x - alignment (Identity x) = alignment x - peekElemOff p i = fmap Identity (peekElemOff (castPtr p) i) - pokeElemOff p i (Identity x) = pokeElemOff (castPtr p) i x - peekByteOff p i = fmap Identity (peekByteOff p i) - pokeByteOff p i (Identity x) = pokeByteOff p i x - peek p = fmap runIdentity (peek (castPtr p)) - poke p (Identity x) = poke (castPtr p) x - --- These instances would be equivalent to the derived instances of the --- newtype if the field were removed. - -instance (Read a) => Read (Identity a) where - readsPrec d = readParen (d > 10) $ \ r -> - [(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s] - -instance (Show a) => Show (Identity a) where - showsPrec d (Identity x) = showParen (d > 10) $ - showString "Identity " . showsPrec 11 x - --- --------------------------------------------------------------------------- --- Identity instances for Functor and Monad - -instance Functor Identity where - fmap f m = Identity (f (runIdentity m)) - -instance Foldable Identity where - foldMap f (Identity x) = f x - -instance Traversable Identity where - traverse f (Identity x) = Identity <$> f x - -instance Applicative Identity where - pure a = Identity a - Identity f <*> Identity x = Identity (f x) - -instance Monad Identity where - return a = Identity a - m >>= k = k (runIdentity m) - -instance MonadFix Identity where - mfix f = Identity (fix (runIdentity . f)) - -#if MIN_VERSION_base(4,4,0) -instance MonadZip Identity where - mzipWith f (Identity x) (Identity y) = Identity (f x y) - munzip (Identity (a, b)) = (Identity a, Identity b) -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs deleted file mode 100644 index 7c74d4ef0d..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.IO.Class --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Class of monads based on @IO@. ------------------------------------------------------------------------------ - -module Control.Monad.IO.Class ( - MonadIO(..) - ) where - -#if __GLASGOW_HASKELL__ >= 708 -import Data.Typeable -#endif - --- | Monads in which 'IO' computations may be embedded. --- Any monad built by applying a sequence of monad transformers to the --- 'IO' monad will be an instance of this class. --- --- Instances should satisfy the following laws, which state that 'liftIO' --- is a transformer of monads: --- --- * @'liftIO' . 'return' = 'return'@ --- --- * @'liftIO' (m >>= f) = 'liftIO' m >>= ('liftIO' . f)@ - -class (Monad m) => MonadIO m where - -- | Lift a computation from the 'IO' monad. - liftIO :: IO a -> m a - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable MonadIO -#endif - -instance MonadIO IO where - liftIO = id diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs deleted file mode 100644 index bda1749643..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs +++ /dev/null @@ -1,529 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Classes --- Copyright : (c) Ross Paterson 2013 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to --- unary and binary type constructors. --- --- These classes are needed to express the constraints on arguments of --- transformers in portable Haskell. Thus for a new transformer @T@, --- one might write instances like --- --- > instance (Eq1 f) => Eq1 (T f) where ... --- > instance (Ord1 f) => Ord1 (T f) where ... --- > instance (Read1 f) => Read1 (T f) where ... --- > instance (Show1 f) => Show1 (T f) where ... --- --- If these instances can be defined, defining instances of the base --- classes is mechanical: --- --- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1 --- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1 --- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1 --- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1 --- ------------------------------------------------------------------------------ - -module Data.Functor.Classes ( - -- * Liftings of Prelude classes - -- ** For unary constructors - Eq1(..), eq1, - Ord1(..), compare1, - Read1(..), readsPrec1, - Show1(..), showsPrec1, - -- ** For binary constructors - Eq2(..), eq2, - Ord2(..), compare2, - Read2(..), readsPrec2, - Show2(..), showsPrec2, - -- * Helper functions - -- $example - readsData, - readsUnaryWith, - readsBinaryWith, - showsUnaryWith, - showsBinaryWith, - -- ** Obsolete helpers - readsUnary, - readsUnary1, - readsBinary1, - showsUnary, - showsUnary1, - showsBinary1, - ) where - -import Control.Applicative (Const(Const)) -import Data.Functor.Identity (Identity(Identity)) -import Data.Monoid (mappend) -#if MIN_VERSION_base(4,7,0) -import Data.Proxy (Proxy(Proxy)) -#endif -#if __GLASGOW_HASKELL__ >= 708 -import Data.Typeable -#endif -import Text.Show (showListWith) - --- | Lifting of the 'Eq' class to unary type constructors. -class Eq1 f where - -- | Lift an equality test through the type constructor. - -- - -- The function will usually be applied to an equality function, - -- but the more general type ensures that the implementation uses - -- it to compare elements of the first container with elements of - -- the second. - liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Eq1 -#endif - --- | Lift the standard @('==')@ function through the type constructor. -eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool -eq1 = liftEq (==) - --- | Lifting of the 'Ord' class to unary type constructors. -class (Eq1 f) => Ord1 f where - -- | Lift a 'compare' function through the type constructor. - -- - -- The function will usually be applied to a comparison function, - -- but the more general type ensures that the implementation uses - -- it to compare elements of the first container with elements of - -- the second. - liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Ord1 -#endif - --- | Lift the standard 'compare' function through the type constructor. -compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering -compare1 = liftCompare compare - --- | Lifting of the 'Read' class to unary type constructors. -class Read1 f where - -- | 'readsPrec' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument type. - liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a) - - -- | 'readList' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument type. - -- The default implementation using standard list syntax is correct - -- for most types. - liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a] - liftReadList rp rl = readListWith (liftReadsPrec rp rl 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Read1 -#endif - --- | Read a list (using square brackets and commas), given a function --- for reading elements. -readListWith :: ReadS a -> ReadS [a] -readListWith rp = - readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s]) - where - readl s = [([],t) | ("]",t) <- lex s] ++ - [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t] - readl' s = [([],t) | ("]",t) <- lex s] ++ - [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u] - --- | Lift the standard 'readsPrec' and 'readList' functions through the --- type constructor. -readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a) -readsPrec1 = liftReadsPrec readsPrec readList - --- | Lifting of the 'Show' class to unary type constructors. -class Show1 f where - -- | 'showsPrec' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument type. - liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - Int -> f a -> ShowS - - -- | 'showList' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument type. - -- The default implementation using standard list syntax is correct - -- for most types. - liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - [f a] -> ShowS - liftShowList sp sl = showListWith (liftShowsPrec sp sl 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Show1 -#endif - --- | Lift the standard 'showsPrec' and 'showList' functions through the --- type constructor. -showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS -showsPrec1 = liftShowsPrec showsPrec showList - --- | Lifting of the 'Eq' class to binary type constructors. -class Eq2 f where - -- | Lift equality tests through the type constructor. - -- - -- The function will usually be applied to equality functions, - -- but the more general type ensures that the implementation uses - -- them to compare elements of the first container with elements of - -- the second. - liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Eq2 -#endif - --- | Lift the standard @('==')@ function through the type constructor. -eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool -eq2 = liftEq2 (==) (==) - --- | Lifting of the 'Ord' class to binary type constructors. -class (Eq2 f) => Ord2 f where - -- | Lift 'compare' functions through the type constructor. - -- - -- The function will usually be applied to comparison functions, - -- but the more general type ensures that the implementation uses - -- them to compare elements of the first container with elements of - -- the second. - liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) -> - f a c -> f b d -> Ordering - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Ord2 -#endif - --- | Lift the standard 'compare' function through the type constructor. -compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering -compare2 = liftCompare2 compare compare - --- | Lifting of the 'Read' class to binary type constructors. -class Read2 f where - -- | 'readsPrec' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument types. - liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> - (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b) - - -- | 'readList' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument types. - -- The default implementation using standard list syntax is correct - -- for most types. - liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> - (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b] - liftReadList2 rp1 rl1 rp2 rl2 = - readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Read2 -#endif - --- | Lift the standard 'readsPrec' function through the type constructor. -readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b) -readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList - --- | Lifting of the 'Show' class to binary type constructors. -class Show2 f where - -- | 'showsPrec' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument types. - liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS - - -- | 'showList' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument types. - -- The default implementation using standard list syntax is correct - -- for most types. - liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS - liftShowList2 sp1 sl1 sp2 sl2 = - showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Show2 -#endif - --- | Lift the standard 'showsPrec' function through the type constructor. -showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS -showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList - --- Instances for Prelude type constructors - -instance Eq1 Maybe where - liftEq _ Nothing Nothing = True - liftEq _ Nothing (Just _) = False - liftEq _ (Just _) Nothing = False - liftEq eq (Just x) (Just y) = eq x y - -instance Ord1 Maybe where - liftCompare _ Nothing Nothing = EQ - liftCompare _ Nothing (Just _) = LT - liftCompare _ (Just _) Nothing = GT - liftCompare comp (Just x) (Just y) = comp x y - -instance Read1 Maybe where - liftReadsPrec rp _ d = - readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r]) - `mappend` - readsData (readsUnaryWith rp "Just" Just) d - -instance Show1 Maybe where - liftShowsPrec _ _ _ Nothing = showString "Nothing" - liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x - -instance Eq1 [] where - liftEq _ [] [] = True - liftEq _ [] (_:_) = False - liftEq _ (_:_) [] = False - liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys - -instance Ord1 [] where - liftCompare _ [] [] = EQ - liftCompare _ [] (_:_) = LT - liftCompare _ (_:_) [] = GT - liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys - -instance Read1 [] where - liftReadsPrec _ rl _ = rl - -instance Show1 [] where - liftShowsPrec _ sl _ = sl - -instance Eq2 (,) where - liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2 - -instance Ord2 (,) where - liftCompare2 comp1 comp2 (x1, y1) (x2, y2) = - comp1 x1 x2 `mappend` comp2 y1 y2 - -instance Read2 (,) where - liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r -> - [((x,y), w) | ("(",s) <- lex r, - (x,t) <- rp1 0 s, - (",",u) <- lex t, - (y,v) <- rp2 0 u, - (")",w) <- lex v] - -instance Show2 (,) where - liftShowsPrec2 sp1 _ sp2 _ _ (x, y) = - showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')' - -instance (Eq a) => Eq1 ((,) a) where - liftEq = liftEq2 (==) - -instance (Ord a) => Ord1 ((,) a) where - liftCompare = liftCompare2 compare - -instance (Read a) => Read1 ((,) a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList - -instance (Show a) => Show1 ((,) a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - -instance Eq2 Either where - liftEq2 e1 _ (Left x) (Left y) = e1 x y - liftEq2 _ _ (Left _) (Right _) = False - liftEq2 _ _ (Right _) (Left _) = False - liftEq2 _ e2 (Right x) (Right y) = e2 x y - -instance Ord2 Either where - liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y - liftCompare2 _ _ (Left _) (Right _) = LT - liftCompare2 _ _ (Right _) (Left _) = GT - liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y - -instance Read2 Either where - liftReadsPrec2 rp1 _ rp2 _ = readsData $ - readsUnaryWith rp1 "Left" Left `mappend` - readsUnaryWith rp2 "Right" Right - -instance Show2 Either where - liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x - liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x - -instance (Eq a) => Eq1 (Either a) where - liftEq = liftEq2 (==) - -instance (Ord a) => Ord1 (Either a) where - liftCompare = liftCompare2 compare - -instance (Read a) => Read1 (Either a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList - -instance (Show a) => Show1 (Either a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - -#if MIN_VERSION_base(4,7,0) -instance Eq1 Proxy where - liftEq _ _ _ = True - -instance Ord1 Proxy where - liftCompare _ _ _ = EQ - -instance Show1 Proxy where - liftShowsPrec _ _ _ _ = showString "Proxy" - -instance Read1 Proxy where - liftReadsPrec _ _ d = - readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ]) -#endif - --- Instances for other functors defined in the base package - -instance Eq1 Identity where - liftEq eq (Identity x) (Identity y) = eq x y - -instance Ord1 Identity where - liftCompare comp (Identity x) (Identity y) = comp x y - -instance Read1 Identity where - liftReadsPrec rp _ = readsData $ - readsUnaryWith rp "Identity" Identity - -instance Show1 Identity where - liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x - -instance Eq2 Const where - liftEq2 eq _ (Const x) (Const y) = eq x y - -instance Ord2 Const where - liftCompare2 comp _ (Const x) (Const y) = comp x y - -instance Read2 Const where - liftReadsPrec2 rp _ _ _ = readsData $ - readsUnaryWith rp "Const" Const - -instance Show2 Const where - liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x - -instance (Eq a) => Eq1 (Const a) where - liftEq = liftEq2 (==) -instance (Ord a) => Ord1 (Const a) where - liftCompare = liftCompare2 compare -instance (Read a) => Read1 (Const a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList -instance (Show a) => Show1 (Const a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - --- Building blocks - --- | @'readsData' p d@ is a parser for datatypes where each alternative --- begins with a data constructor. It parses the constructor and --- passes it to @p@. Parsers for various constructors can be constructed --- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with --- @mappend@ from the @Monoid@ class. -readsData :: (String -> ReadS a) -> Int -> ReadS a -readsData reader d = - readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s] - --- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor --- and then parses its argument using @rp@. -readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t -readsUnaryWith rp name cons kw s = - [(cons x,t) | kw == name, (x,t) <- rp 11 s] - --- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary --- data constructor and then parses its arguments using @rp1@ and @rp2@ --- respectively. -readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) -> - String -> (a -> b -> t) -> String -> ReadS t -readsBinaryWith rp1 rp2 name cons kw s = - [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t] - --- | @'showsUnaryWith' sp n d x@ produces the string representation of a --- unary data constructor with name @n@ and argument @x@, in precedence --- context @d@. -showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS -showsUnaryWith sp name d x = showParen (d > 10) $ - showString name . showChar ' ' . sp 11 x - --- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string --- representation of a binary data constructor with name @n@ and arguments --- @x@ and @y@, in precedence context @d@. -showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> - String -> Int -> a -> b -> ShowS -showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $ - showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y - --- Obsolete building blocks - --- | @'readsUnary' n c n'@ matches the name of a unary data constructor --- and then parses its argument using 'readsPrec'. -{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-} -readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t -readsUnary name cons kw s = - [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s] - --- | @'readsUnary1' n c n'@ matches the name of a unary data constructor --- and then parses its argument using 'readsPrec1'. -{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-} -readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t -readsUnary1 name cons kw s = - [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s] - --- | @'readsBinary1' n c n'@ matches the name of a binary data constructor --- and then parses its arguments using 'readsPrec1'. -{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-} -readsBinary1 :: (Read1 f, Read1 g, Read a) => - String -> (f a -> g a -> t) -> String -> ReadS t -readsBinary1 name cons kw s = - [(cons x y,u) | kw == name, - (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t] - --- | @'showsUnary' n d x@ produces the string representation of a unary data --- constructor with name @n@ and argument @x@, in precedence context @d@. -{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-} -showsUnary :: (Show a) => String -> Int -> a -> ShowS -showsUnary name d x = showParen (d > 10) $ - showString name . showChar ' ' . showsPrec 11 x - --- | @'showsUnary1' n d x@ produces the string representation of a unary data --- constructor with name @n@ and argument @x@, in precedence context @d@. -{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-} -showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS -showsUnary1 name d x = showParen (d > 10) $ - showString name . showChar ' ' . showsPrec1 11 x - --- | @'showsBinary1' n d x y@ produces the string representation of a binary --- data constructor with name @n@ and arguments @x@ and @y@, in precedence --- context @d@. -{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-} -showsBinary1 :: (Show1 f, Show1 g, Show a) => - String -> Int -> f a -> g a -> ShowS -showsBinary1 name d x y = showParen (d > 10) $ - showString name . showChar ' ' . showsPrec1 11 x . - showChar ' ' . showsPrec1 11 y - -{- $example -These functions can be used to assemble 'Read' and 'Show' instances for -new algebraic types. For example, given the definition - -> data T f a = Zero a | One (f a) | Two a (f a) - -a standard 'Read1' instance may be defined as - -> instance (Read1 f) => Read1 (T f) where -> liftReadsPrec rp rl = readsData $ -> readsUnaryWith rp "Zero" Zero `mappend` -> readsUnaryWith (liftReadsPrec rp rl) "One" One `mappend` -> readsBinaryWith rp (liftReadsPrec rp rl) "Two" Two - -and the corresponding 'Show1' instance as - -> instance (Show1 f) => Show1 (T f) where -> liftShowsPrec sp _ d (Zero x) = -> showsUnaryWith sp "Zero" d x -> liftShowsPrec sp sl d (One x) = -> showsUnaryWith (liftShowsPrec sp sl) "One" d x -> liftShowsPrec sp sl d (Two x y) = -> showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y - --} diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs deleted file mode 100644 index ed781309af..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE AutoDeriveTypeable #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Compose --- Copyright : (c) Ross Paterson 2010 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Composition of functors. ------------------------------------------------------------------------------ - -module Data.Functor.Compose ( - Compose(..), - ) where - -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif - -import Control.Applicative -#if __GLASGOW_HASKELL__ >= 708 -import Data.Data -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 702 -import GHC.Generics -#endif - -infixr 9 `Compose` - --- | Right-to-left composition of functors. --- The composition of applicative functors is always applicative, --- but the composition of monads is not always a monad. -newtype Compose f g a = Compose { getCompose :: f (g a) } - -#if __GLASGOW_HASKELL__ >= 702 -deriving instance Generic (Compose f g a) - -instance Functor f => Generic1 (Compose f g) where - type Rep1 (Compose f g) = - D1 MDCompose - (C1 MCCompose - (S1 MSCompose (f :.: Rec1 g))) - from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x)))) - to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x)) - -data MDCompose -data MCCompose -data MSCompose - -instance Datatype MDCompose where - datatypeName _ = "Compose" - moduleName _ = "Data.Functor.Compose" -# if __GLASGOW_HASKELL__ >= 708 - isNewtype _ = True -# endif - -instance Constructor MCCompose where - conName _ = "Compose" - conIsRecord _ = True - -instance Selector MSCompose where - selName _ = "getCompose" -#endif - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Compose -deriving instance (Data (f (g a)), Typeable f, Typeable g, Typeable a) - => Data (Compose (f :: * -> *) (g :: * -> *) (a :: *)) -#endif - --- Instances of lifted Prelude classes - -instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where - liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y - -instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where - liftCompare comp (Compose x) (Compose y) = - liftCompare (liftCompare comp) x y - -instance (Read1 f, Read1 g) => Read1 (Compose f g) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Show1 f, Show1 g) => Show1 (Compose f g) where - liftShowsPrec sp sl d (Compose x) = - showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - --- Instances of Prelude classes - -instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where - (==) = eq1 - -instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where - compare = compare1 - -instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where - readsPrec = readsPrec1 - -instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where - showsPrec = showsPrec1 - --- Functor instances - -instance (Functor f, Functor g) => Functor (Compose f g) where - fmap f (Compose x) = Compose (fmap (fmap f) x) - -instance (Foldable f, Foldable g) => Foldable (Compose f g) where - foldMap f (Compose t) = foldMap (foldMap f) t - -instance (Traversable f, Traversable g) => Traversable (Compose f g) where - traverse f (Compose t) = Compose <$> traverse (traverse f) t - -instance (Applicative f, Applicative g) => Applicative (Compose f g) where - pure x = Compose (pure (pure x)) - Compose f <*> Compose x = Compose ((<*>) <$> f <*> x) - -instance (Alternative f, Applicative g) => Alternative (Compose f g) where - empty = Compose empty - Compose x <|> Compose y = Compose (x <|> y) - -#if MIN_VERSION_base(4,12,0) -instance (Functor f, Contravariant g) => Contravariant (Compose f g) where - contramap f (Compose fga) = Compose (fmap (contramap f) fga) -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs deleted file mode 100644 index ba0dc0407e..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs +++ /dev/null @@ -1,156 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE AutoDeriveTypeable #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Product --- Copyright : (c) Ross Paterson 2010 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Products, lifted to functors. ------------------------------------------------------------------------------ - -module Data.Functor.Product ( - Product(..), - ) where - -import Control.Applicative -import Control.Monad (MonadPlus(..)) -import Control.Monad.Fix (MonadFix(..)) -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -#if __GLASGOW_HASKELL__ >= 708 -import Data.Data -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Monoid (mappend) -import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 702 -import GHC.Generics -#endif - --- | Lifted product of functors. -data Product f g a = Pair (f a) (g a) - -#if __GLASGOW_HASKELL__ >= 702 -deriving instance Generic (Product f g a) - -instance Generic1 (Product f g) where - type Rep1 (Product f g) = - D1 MDProduct - (C1 MCPair - (S1 NoSelector (Rec1 f) :*: S1 NoSelector (Rec1 g))) - from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g))) - to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g) - -data MDProduct -data MCPair - -instance Datatype MDProduct where - datatypeName _ = "Product" - moduleName _ = "Data.Functor.Product" - -instance Constructor MCPair where - conName _ = "Pair" -#endif - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Product -deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a) - => Data (Product (f :: * -> *) (g :: * -> *) (a :: *)) -#endif - -instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where - liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2 - -instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where - liftCompare comp (Pair x1 y1) (Pair x2 y2) = - liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2 - -instance (Read1 f, Read1 g) => Read1 (Product f g) where - liftReadsPrec rp rl = readsData $ - readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair - -instance (Show1 f, Show1 g) => Show1 (Product f g) where - liftShowsPrec sp sl d (Pair x y) = - showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y - -instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) - where (==) = eq1 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where - compare = compare1 -instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where - readsPrec = readsPrec1 -instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where - showsPrec = showsPrec1 - -instance (Functor f, Functor g) => Functor (Product f g) where - fmap f (Pair x y) = Pair (fmap f x) (fmap f y) - -instance (Foldable f, Foldable g) => Foldable (Product f g) where - foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y - -instance (Traversable f, Traversable g) => Traversable (Product f g) where - traverse f (Pair x y) = Pair <$> traverse f x <*> traverse f y - -instance (Applicative f, Applicative g) => Applicative (Product f g) where - pure x = Pair (pure x) (pure x) - Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y) - -instance (Alternative f, Alternative g) => Alternative (Product f g) where - empty = Pair empty empty - Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2) - -instance (Monad f, Monad g) => Monad (Product f g) where -#if !(MIN_VERSION_base(4,8,0)) - return x = Pair (return x) (return x) -#endif - Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f) - where - fstP (Pair a _) = a - sndP (Pair _ b) = b - -instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where - mzero = Pair mzero mzero - Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2) - -instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where - mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f)) - where - fstP (Pair a _) = a - sndP (Pair _ b) = b - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where - mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2) -#endif - -#if MIN_VERSION_base(4,12,0) -instance (Contravariant f, Contravariant g) => Contravariant (Product f g) where - contramap f (Pair a b) = Pair (contramap f a) (contramap f b) -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs deleted file mode 100644 index e6d1428b30..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs +++ /dev/null @@ -1,136 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE AutoDeriveTypeable #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Sum --- Copyright : (c) Ross Paterson 2014 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Sums, lifted to functors. ------------------------------------------------------------------------------ - -module Data.Functor.Sum ( - Sum(..), - ) where - -import Control.Applicative -#if __GLASGOW_HASKELL__ >= 708 -import Data.Data -#endif -import Data.Foldable (Foldable(foldMap)) -import Data.Functor.Classes -#if MIN_VERSION_base(4,12,0) -import Data.Functor.Contravariant -#endif -import Data.Monoid (mappend) -import Data.Traversable (Traversable(traverse)) -#if __GLASGOW_HASKELL__ >= 702 -import GHC.Generics -#endif - --- | Lifted sum of functors. -data Sum f g a = InL (f a) | InR (g a) - -#if __GLASGOW_HASKELL__ >= 702 -deriving instance Generic (Sum f g a) - -instance Generic1 (Sum f g) where - type Rep1 (Sum f g) = - D1 MDSum (C1 MCInL (S1 NoSelector (Rec1 f)) - :+: C1 MCInR (S1 NoSelector (Rec1 g))) - from1 (InL f) = M1 (L1 (M1 (M1 (Rec1 f)))) - from1 (InR g) = M1 (R1 (M1 (M1 (Rec1 g)))) - to1 (M1 (L1 (M1 (M1 f)))) = InL (unRec1 f) - to1 (M1 (R1 (M1 (M1 g)))) = InR (unRec1 g) - -data MDSum -data MCInL -data MCInR - -instance Datatype MDSum where - datatypeName _ = "Sum" - moduleName _ = "Data.Functor.Sum" - -instance Constructor MCInL where - conName _ = "InL" - -instance Constructor MCInR where - conName _ = "InR" -#endif - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Sum -deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a) - => Data (Sum (f :: * -> *) (g :: * -> *) (a :: *)) -#endif - -instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where - liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2 - liftEq _ (InL _) (InR _) = False - liftEq _ (InR _) (InL _) = False - liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2 - -instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where - liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2 - liftCompare _ (InL _) (InR _) = LT - liftCompare _ (InR _) (InL _) = GT - liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2 - -instance (Read1 f, Read1 g) => Read1 (Sum f g) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend` - readsUnaryWith (liftReadsPrec rp rl) "InR" InR - -instance (Show1 f, Show1 g) => Show1 (Sum f g) where - liftShowsPrec sp sl d (InL x) = - showsUnaryWith (liftShowsPrec sp sl) "InL" d x - liftShowsPrec sp sl d (InR y) = - showsUnaryWith (liftShowsPrec sp sl) "InR" d y - -instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where - (==) = eq1 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where - compare = compare1 -instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where - readsPrec = readsPrec1 -instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where - showsPrec = showsPrec1 - -instance (Functor f, Functor g) => Functor (Sum f g) where - fmap f (InL x) = InL (fmap f x) - fmap f (InR y) = InR (fmap f y) - -instance (Foldable f, Foldable g) => Foldable (Sum f g) where - foldMap f (InL x) = foldMap f x - foldMap f (InR y) = foldMap f y - -instance (Traversable f, Traversable g) => Traversable (Sum f g) where - traverse f (InL x) = InL <$> traverse f x - traverse f (InR y) = InR <$> traverse f y - -#if MIN_VERSION_base(4,12,0) -instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where - contramap f (InL xs) = InL (contramap f xs) - contramap f (InR ys) = InR (contramap f ys) -#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/transformers.cabal b/third_party/bazel/rules_haskell/examples/transformers/transformers.cabal deleted file mode 100644 index 945adda910..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/transformers.cabal +++ /dev/null @@ -1,91 +0,0 @@ -name: transformers -version: 0.5.6.2 -license: BSD3 -license-file: LICENSE -author: Andy Gill, Ross Paterson -maintainer: Ross Paterson <R.Paterson@city.ac.uk> -bug-reports: http://hub.darcs.net/ross/transformers/issues -category: Control -synopsis: Concrete functor and monad transformers -description: - A portable library of functor and monad transformers, inspired by - the paper - . - * \"Functional Programming with Overloading and Higher-Order - Polymorphism\", by Mark P Jones, - in /Advanced School of Functional Programming/, 1995 - (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>). - . - This package contains: - . - * the monad transformer class (in "Control.Monad.Trans.Class") - . - * concrete functor and monad transformers, each with associated - operations and functions to lift operations associated with other - transformers. - . - The package can be used on its own in portable Haskell code, in - which case operations need to be manually lifted through transformer - stacks (see "Control.Monad.Trans.Class" for some examples). - Alternatively, it can be used with the non-portable monad classes in - the @mtl@ or @monads-tf@ packages, which automatically lift operations - introduced by monad transformers through other transformers. -build-type: Simple -extra-source-files: - changelog -cabal-version: >= 1.6 - -source-repository head - type: darcs - location: http://hub.darcs.net/ross/transformers - -library - build-depends: base >= 2 && < 6 - hs-source-dirs: . - if !impl(ghc>=7.9) - -- Data.Functor.Identity was moved into base-4.8.0.0 (GHC 7.10) - -- see also https://ghc.haskell.org/trac/ghc/ticket/9664 - -- NB: using impl(ghc>=7.9) instead of fragile Cabal flags - hs-source-dirs: legacy/pre709 - exposed-modules: Data.Functor.Identity - if !impl(ghc>=7.11) - -- modules moved into base-4.9.0 (GHC 8.0) - -- see https://ghc.haskell.org/trac/ghc/ticket/10773 - -- see https://ghc.haskell.org/trac/ghc/ticket/11135 - hs-source-dirs: legacy/pre711 - exposed-modules: - Control.Monad.IO.Class - Data.Functor.Classes - Data.Functor.Compose - Data.Functor.Product - Data.Functor.Sum - if impl(ghc>=7.2 && <7.5) - -- Prior to GHC 7.5, GHC.Generics lived in ghc-prim - build-depends: ghc-prim - exposed-modules: - Control.Applicative.Backwards - Control.Applicative.Lift - Control.Monad.Signatures - Control.Monad.Trans.Accum - Control.Monad.Trans.Class - Control.Monad.Trans.Cont - Control.Monad.Trans.Except - Control.Monad.Trans.Error - Control.Monad.Trans.Identity - Control.Monad.Trans.List - Control.Monad.Trans.Maybe - Control.Monad.Trans.Reader - Control.Monad.Trans.RWS - Control.Monad.Trans.RWS.CPS - Control.Monad.Trans.RWS.Lazy - Control.Monad.Trans.RWS.Strict - Control.Monad.Trans.Select - Control.Monad.Trans.State - Control.Monad.Trans.State.Lazy - Control.Monad.Trans.State.Strict - Control.Monad.Trans.Writer - Control.Monad.Trans.Writer.CPS - Control.Monad.Trans.Writer.Lazy - Control.Monad.Trans.Writer.Strict - Data.Functor.Constant - Data.Functor.Reverse |