    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MonoLocalBinds #-}
    #if __GLASGOW_HASKELL__ >= 702
    {-# LANGUAGE Trustworthy #-}
    #endif

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Semigroup.Monad
    -- Copyright   :  (c) Edward Kmett 2009
    -- License     :  BSD-style
    -- Maintainer  :  ekmett@gmail.com
    -- Stability   :  experimental
    -- Portability :  non-portable (MPTCs)
    --
    -- Semigroups for working with 'Monad's.
    --
    -----------------------------------------------------------------------------

    module Data.Semigroup.Monad
        ( Action(..)
        , Mon(..)
        ) where

    import Control.Monad (liftM, liftM2)
    import Data.Semigroup.Reducer (Reducer(..))

    #if !(MIN_VERSION_base(4,8,0))
    import Control.Applicative (Applicative(..))
    import Data.Monoid (Monoid(..))
    #endif

    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup (Semigroup(..))
    #endif

    -- | A 'Action' uses an glues together monadic actions with (>>)
    --   in the manner of 'mapM_' from "Data.Foldable". Any values returned by
    --   reduced actions are discarded.
    newtype Action f = Action { forall (f :: * -> *). Action f -> f ()
    getAction :: f () }

    instance Monad f => Semigroup (Action f) where
      Action f ()
    a <> :: Action f -> Action f -> Action f
    <> Action f ()
    b = f () -> Action f
    forall (f :: * -> *). f () -> Action f
    Action (f ()
    a f () -> f () -> f ()
    forall a b. f a -> f b -> f b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> f ()
    b)

    instance Monad f => Monoid (Action f) where
      mempty :: Action f
    mempty = f () -> Action f
    forall (f :: * -> *). f () -> Action f
    Action (() -> f ()
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
    #if !(MIN_VERSION_base(4,11,0))
      Action a `mappend` Action b = Action (a >> b)
    #endif

    instance Monad f => Reducer (f a) (Action f) where
      unit :: f a -> Action f
    unit f a
    a            = f () -> Action f
    forall (f :: * -> *). f () -> Action f
    Action (f a
    a f a -> f () -> f ()
    forall a b. f a -> f b -> f b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> f ()
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
      f a
    a cons :: f a -> Action f -> Action f
    `cons` Action f ()
    b = f () -> Action f
    forall (f :: * -> *). f () -> Action f
    Action (f a
    a f a -> f () -> f ()
    forall a b. f a -> f b -> f b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> f ()
    b)
      Action f ()
    a snoc :: Action f -> f a -> Action f
    `snoc` f a
    b = f () -> Action f
    forall (f :: * -> *). f () -> Action f
    Action (f ()
    a f () -> f a -> f a
    forall a b. f a -> f b -> f b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> f a
    b f a -> f () -> f ()
    forall a b. f a -> f b -> f b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> f ()
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    -- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()
    --   A rewrite rule automatically applies this when possible
    snocAction :: Reducer (f ()) (Action f) => Action f -> f () -> Action f
    snocAction :: forall (f :: * -> *).
    Reducer (f ()) (Action f) =>
    Action f -> f () -> Action f
    snocAction Action f
    a = Action f -> Action f -> Action f
    forall a. Semigroup a => a -> a -> a
    (<>) Action f
    a (Action f -> Action f) -> (f () -> Action f) -> f () -> Action f
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f () -> Action f
    forall (f :: * -> *). f () -> Action f
    Action
    {-# RULES "unitAction" unit = Action #-}
    {-# RULES "snocAction" snoc = snocAction #-}

    newtype Mon f m = Mon { forall (f :: * -> *) m. Mon f m -> f m
    getMon :: f m }
      deriving ((forall a b. (a -> b) -> Mon f a -> Mon f b)
    -> (forall a b. a -> Mon f b -> Mon f a) -> Functor (Mon f)
    forall a b. a -> Mon f b -> Mon f a
    forall a b. (a -> b) -> Mon f a -> Mon f b
    forall (f :: * -> *) a b. Functor f => a -> Mon f b -> Mon f a
    forall (f :: * -> *) a b.
    Functor f =>
    (a -> b) -> Mon f a -> Mon f b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall (f :: * -> *) a b.
    Functor f =>
    (a -> b) -> Mon f a -> Mon f b
    fmap :: forall a b. (a -> b) -> Mon f a -> Mon f b
    $c<$ :: forall (f :: * -> *) a b. Functor f => a -> Mon f b -> Mon f a
    <$ :: forall a b. a -> Mon f b -> Mon f a
    Functor,Functor (Mon f)
    Functor (Mon f) =>
    (forall a. a -> Mon f a)
    -> (forall a b. Mon f (a -> b) -> Mon f a -> Mon f b)
    -> (forall a b c. (a -> b -> c) -> Mon f a -> Mon f b -> Mon f c)
    -> (forall a b. Mon f a -> Mon f b -> Mon f b)
    -> (forall a b. Mon f a -> Mon f b -> Mon f a)
    -> Applicative (Mon f)
    forall a. a -> Mon f a
    forall a b. Mon f a -> Mon f b -> Mon f a
    forall a b. Mon f a -> Mon f b -> Mon f b
    forall a b. Mon f (a -> b) -> Mon f a -> Mon f b
    forall a b c. (a -> b -> c) -> Mon f a -> Mon f b -> Mon f c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    forall (f :: * -> *). Applicative f => Functor (Mon f)
    forall (f :: * -> *) a. Applicative f => a -> Mon f a
    forall (f :: * -> *) a b.
    Applicative f =>
    Mon f a -> Mon f b -> Mon f a
    forall (f :: * -> *) a b.
    Applicative f =>
    Mon f a -> Mon f b -> Mon f b
    forall (f :: * -> *) a b.
    Applicative f =>
    Mon f (a -> b) -> Mon f a -> Mon f b
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> Mon f a -> Mon f b -> Mon f c
    $cpure :: forall (f :: * -> *) a. Applicative f => a -> Mon f a
    pure :: forall a. a -> Mon f a
    $c<*> :: forall (f :: * -> *) a b.
    Applicative f =>
    Mon f (a -> b) -> Mon f a -> Mon f b
    <*> :: forall a b. Mon f (a -> b) -> Mon f a -> Mon f b
    $cliftA2 :: forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> Mon f a -> Mon f b -> Mon f c
    liftA2 :: forall a b c. (a -> b -> c) -> Mon f a -> Mon f b -> Mon f c
    $c*> :: forall (f :: * -> *) a b.
    Applicative f =>
    Mon f a -> Mon f b -> Mon f b
    *> :: forall a b. Mon f a -> Mon f b -> Mon f b
    $c<* :: forall (f :: * -> *) a b.
    Applicative f =>
    Mon f a -> Mon f b -> Mon f a
    <* :: forall a b. Mon f a -> Mon f b -> Mon f a
    Applicative,Applicative (Mon f)
    Applicative (Mon f) =>
    (forall a b. Mon f a -> (a -> Mon f b) -> Mon f b)
    -> (forall a b. Mon f a -> Mon f b -> Mon f b)
    -> (forall a. a -> Mon f a)
    -> Monad (Mon f)
    forall a. a -> Mon f a
    forall a b. Mon f a -> Mon f b -> Mon f b
    forall a b. Mon f a -> (a -> Mon f b) -> Mon f b
    forall (f :: * -> *). Monad f => Applicative (Mon f)
    forall (f :: * -> *) a. Monad f => a -> Mon f a
    forall (f :: * -> *) a b. Monad f => Mon f a -> Mon f b -> Mon f b
    forall (f :: * -> *) a b.
    Monad f =>
    Mon f a -> (a -> Mon f b) -> Mon f b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall (f :: * -> *) a b.
    Monad f =>
    Mon f a -> (a -> Mon f b) -> Mon f b
    >>= :: forall a b. Mon f a -> (a -> Mon f b) -> Mon f b
    $c>> :: forall (f :: * -> *) a b. Monad f => Mon f a -> Mon f b -> Mon f b
    >> :: forall a b. Mon f a -> Mon f b -> Mon f b
    $creturn :: forall (f :: * -> *) a. Monad f => a -> Mon f a
    return :: forall a. a -> Mon f a
    Monad)

    instance (Monad f, Semigroup m) => Semigroup (Mon f m) where
      <> :: Mon f m -> Mon f m -> Mon f m
    (<>) = (m -> m -> m) -> Mon f m -> Mon f m -> Mon f m
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 m -> m -> m
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance (Monad f, Monoid m) => Monoid (Mon f m) where
      mempty :: Mon f m
    mempty = m -> Mon f m
    forall a. a -> Mon f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return m
    forall a. Monoid a => a
    mempty
    #if !(MIN_VERSION_base(4,11,0))
      mappend = liftM2 mappend
    #endif

    instance (Monad f, Reducer c m) => Reducer (f c) (Mon f m) where
      unit :: f c -> Mon f m
    unit = (c -> m) -> Mon f c -> Mon f m
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM c -> m
    forall c m. Reducer c m => c -> m
    unit (Mon f c -> Mon f m) -> (f c -> Mon f c) -> f c -> Mon f m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f c -> Mon f c
    forall (f :: * -> *) m. f m -> Mon f m
    Mon