{-# LANGUAGE CPP        #-}
{-# LANGUAGE RankNTypes #-}

#ifndef MIN_VERSION_profunctors
#define MIN_VERSION_profunctors(x,y,z) 0
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Machine.MooreT
-- Copyright   :  (C) 2012 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- <http://en.wikipedia.org/wiki/Moore_machine>
----------------------------------------------------------------------------
module Data.Machine.MooreT
  ( MooreT(..)
  , unfoldMooreT
  , upgrade
  , hoist
  , couple
  , firstM
  , secondM
  ) where

import Control.Monad.Trans (lift)
import Data.Distributive   (Distributive(..), cotraverse)
import Data.Machine
import Data.Machine.MealyT (MealyT(runMealyT))
import Data.Pointed        (Pointed(..))
import Data.Profunctor     (Costrong(..), Profunctor(..))

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

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

-- | 'Moore' machine, with applicative effects
newtype MooreT m a b = MooreT { MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT :: m (b, a -> MooreT m a b) }

-- | Construct a MooreT machine from a state valuation and transition action
unfoldMooreT :: Functor m => (s -> m (b, a -> s)) -> s -> MooreT m a b
unfoldMooreT :: (s -> m (b, a -> s)) -> s -> MooreT m a b
unfoldMooreT s -> m (b, a -> s)
f = s -> MooreT m a b
go where
  go :: s -> MooreT m a b
go s
s = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> m (b, a -> MooreT m a b) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$ (\(b
b, a -> s
k) -> (b
b, s -> MooreT m a b
go (s -> MooreT m a b) -> (a -> s) -> a -> MooreT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> s
k)) ((b, a -> s) -> (b, a -> MooreT m a b))
-> m (b, a -> s) -> m (b, a -> MooreT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (b, a -> s)
f s
s
{-# INLINE unfoldMooreT #-}

upgrade :: Applicative m => Moore a b -> MooreT m a b
upgrade :: Moore a b -> MooreT m a b
upgrade (Moore b
b a -> Moore a b
f) = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> m (b, a -> MooreT m a b) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$ (b, a -> MooreT m a b) -> m (b, a -> MooreT m a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, Moore a b -> MooreT m a b
forall (m :: * -> *) a b.
Applicative m =>
Moore a b -> MooreT m a b
upgrade (Moore a b -> MooreT m a b)
-> (a -> Moore a b) -> a -> MooreT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moore a b
f)
{-# INLINE upgrade #-}

firstM :: (Functor m, Monad m) => (a' -> m a) -> MooreT m a b -> MooreT m a' b
firstM :: (a' -> m a) -> MooreT m a b -> MooreT m a' b
firstM a' -> m a
f = m (b, a' -> MooreT m a' b) -> MooreT m a' b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a' -> MooreT m a' b) -> MooreT m a' b)
-> (MooreT m a b -> m (b, a' -> MooreT m a' b))
-> MooreT m a b
-> MooreT m a' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ((b, a -> MooreT m a b) -> (b, a' -> MooreT m a' b))
-> m (b, a -> MooreT m a b) -> m (b, a' -> MooreT m a' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> MooreT m a b) -> a' -> MooreT m a' b)
-> (b, a -> MooreT m a b) -> (b, a' -> MooreT m a' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> MooreT m a b) -> a' -> MooreT m a' b
forall b. (a -> MooreT m a b) -> a' -> MooreT m a' b
go) (m (b, a -> MooreT m a b) -> m (b, a' -> MooreT m a' b))
-> (MooreT m a b -> m (b, a -> MooreT m a b))
-> MooreT m a b
-> m (b, a' -> MooreT m a' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m a b -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT
  where
    go :: (a -> MooreT m a b) -> a' -> MooreT m a' b
go a -> MooreT m a b
m a'
x = m (b, a' -> MooreT m a' b) -> MooreT m a' b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a' -> MooreT m a' b) -> MooreT m a' b)
-> m (b, a' -> MooreT m a' b) -> MooreT m a' b
forall a b. (a -> b) -> a -> b
$ a' -> m a
f a'
x m a
-> (a -> m (b, a' -> MooreT m a' b)) -> m (b, a' -> MooreT m a' b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((b, a -> MooreT m a b) -> (b, a' -> MooreT m a' b))
-> m (b, a -> MooreT m a b) -> m (b, a' -> MooreT m a' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> MooreT m a b) -> a' -> MooreT m a' b)
-> (b, a -> MooreT m a b) -> (b, a' -> MooreT m a' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> MooreT m a b) -> a' -> MooreT m a' b
go) (m (b, a -> MooreT m a b) -> m (b, a' -> MooreT m a' b))
-> (a -> m (b, a -> MooreT m a b))
-> a
-> m (b, a' -> MooreT m a' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m a b -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT (MooreT m a b -> m (b, a -> MooreT m a b))
-> (a -> MooreT m a b) -> a -> m (b, a -> MooreT m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MooreT m a b
m
{-# INLINE firstM #-}

secondM :: Monad m => (b -> m b') -> MooreT m a b -> MooreT m a b'
secondM :: (b -> m b') -> MooreT m a b -> MooreT m a b'
secondM b -> m b'
f MooreT m a b
m = m (b', a -> MooreT m a b') -> MooreT m a b'
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b', a -> MooreT m a b') -> MooreT m a b')
-> m (b', a -> MooreT m a b') -> MooreT m a b'
forall a b. (a -> b) -> a -> b
$ do
  (b
b, a -> MooreT m a b
m') <- MooreT m a b -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m a b
m
  b'
b' <- b -> m b'
f b
b
  (b', a -> MooreT m a b') -> m (b', a -> MooreT m a b')
forall (m :: * -> *) a. Monad m => a -> m a
return (b'
b', (b -> m b') -> MooreT m a b -> MooreT m a b'
forall (m :: * -> *) b b' a.
Monad m =>
(b -> m b') -> MooreT m a b -> MooreT m a b'
secondM b -> m b'
f (MooreT m a b -> MooreT m a b')
-> (a -> MooreT m a b) -> a -> MooreT m a b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MooreT m a b
m')
{-# INLINE secondM #-}

hoist :: Functor n => (forall x. m x -> n x) -> MooreT m a b -> MooreT n a b
hoist :: (forall x. m x -> n x) -> MooreT m a b -> MooreT n a b
hoist forall x. m x -> n x
f = let go :: MooreT m a b -> MooreT n a b
go = n (b, a -> MooreT n a b) -> MooreT n a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (n (b, a -> MooreT n a b) -> MooreT n a b)
-> (MooreT m a b -> n (b, a -> MooreT n a b))
-> MooreT m a b
-> MooreT n a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a -> MooreT m a b) -> (b, a -> MooreT n a b))
-> n (b, a -> MooreT m a b) -> n (b, a -> MooreT n a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, a -> MooreT m a b
m') -> (b
b, MooreT m a b -> MooreT n a b
go (MooreT m a b -> MooreT n a b)
-> (a -> MooreT m a b) -> a -> MooreT n a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MooreT m a b
m')) (n (b, a -> MooreT m a b) -> n (b, a -> MooreT n a b))
-> (MooreT m a b -> n (b, a -> MooreT m a b))
-> MooreT m a b
-> n (b, a -> MooreT n a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (b, a -> MooreT m a b) -> n (b, a -> MooreT m a b)
forall x. m x -> n x
f (m (b, a -> MooreT m a b) -> n (b, a -> MooreT m a b))
-> (MooreT m a b -> m (b, a -> MooreT m a b))
-> MooreT m a b
-> n (b, a -> MooreT m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m a b -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT in MooreT m a b -> MooreT n a b
forall a b. MooreT m a b -> MooreT n a b
go
{-# INLINE hoist #-}

couple :: Monad m => MooreT m a b -> MealyT m b a -> m c
couple :: MooreT m a b -> MealyT m b a -> m c
couple MooreT m a b
x MealyT m b a
y = do
  (b
b, a -> MooreT m a b
x') <- MooreT m a b -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m a b
x
  (a
a, MealyT m b a
y') <- MealyT m b a -> b -> m (a, MealyT m b a)
forall (m :: * -> *) a b. MealyT m a b -> a -> m (b, MealyT m a b)
runMealyT MealyT m b a
y b
b
  MooreT m a b -> MealyT m b a -> m c
forall (m :: * -> *) a b c.
Monad m =>
MooreT m a b -> MealyT m b a -> m c
couple (a -> MooreT m a b
x' a
a) MealyT m b a
y'
{-# INLINE couple #-}

instance AutomatonM MooreT where
  autoT :: MooreT m a b -> ProcessT m a b
autoT = PlanT (Is a) b m Any -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (PlanT (Is a) b m Any -> ProcessT m a b)
-> (MooreT m a b -> PlanT (Is a) b m Any)
-> MooreT m a b
-> ProcessT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m a b -> PlanT (Is a) b m Any
forall (m :: * -> *) (k :: * -> * -> *) a o b.
(Monad m, Category k) =>
MooreT m a o -> PlanT (k a) o m b
go where
    go :: MooreT m a o -> PlanT (k a) o m b
go MooreT m a o
m = do
      (o
b, a -> MooreT m a o
m') <- m (o, a -> MooreT m a o) -> PlanT (k a) o m (o, a -> MooreT m a o)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MooreT m a o -> m (o, a -> MooreT m a o)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m a o
m)
      o -> Plan (k a) o ()
forall o (k :: * -> *). o -> Plan k o ()
yield o
b
      PlanT (k a) o m a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (k a) o m a -> (a -> PlanT (k a) o m b) -> PlanT (k a) o m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MooreT m a o -> PlanT (k a) o m b
go (MooreT m a o -> PlanT (k a) o m b)
-> (a -> MooreT m a o) -> a -> PlanT (k a) o m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MooreT m a o
m'
  {-# INLINE autoT #-}

instance Functor m => Functor (MooreT m a) where
  fmap :: (a -> b) -> MooreT m a a -> MooreT m a b
fmap a -> b
f = let go :: MooreT m a a -> MooreT m a b
go = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> (MooreT m a a -> m (b, a -> MooreT m a b))
-> MooreT m a a
-> MooreT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a -> MooreT m a a) -> (b, a -> MooreT m a b))
-> m (a, a -> MooreT m a a) -> m (b, a -> MooreT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
b, a -> MooreT m a a
m') -> (a -> b
f a
b, MooreT m a a -> MooreT m a b
go (MooreT m a a -> MooreT m a b)
-> (a -> MooreT m a a) -> a -> MooreT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MooreT m a a
m')) (m (a, a -> MooreT m a a) -> m (b, a -> MooreT m a b))
-> (MooreT m a a -> m (a, a -> MooreT m a a))
-> MooreT m a a
-> m (b, a -> MooreT m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m a a -> m (a, a -> MooreT m a a)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT in MooreT m a a -> MooreT m a b
forall a. MooreT m a a -> MooreT m a b
go
  {-# INLINE fmap #-}

instance Functor m => Profunctor (MooreT m) where
  rmap :: (b -> c) -> MooreT m a b -> MooreT m a c
rmap = (b -> c) -> MooreT m a b -> MooreT m a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE rmap #-}
  lmap :: (a -> b) -> MooreT m b c -> MooreT m a c
lmap a -> b
f = let go :: MooreT m b b -> MooreT m a b
go = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> (MooreT m b b -> m (b, a -> MooreT m a b))
-> MooreT m b b
-> MooreT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b -> MooreT m b b) -> (b, a -> MooreT m a b))
-> m (b, b -> MooreT m b b) -> m (b, a -> MooreT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, b -> MooreT m b b
m') -> (b
b, MooreT m b b -> MooreT m a b
go (MooreT m b b -> MooreT m a b)
-> (a -> MooreT m b b) -> a -> MooreT m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> MooreT m b b
m' (b -> MooreT m b b) -> (a -> b) -> a -> MooreT m b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)) (m (b, b -> MooreT m b b) -> m (b, a -> MooreT m a b))
-> (MooreT m b b -> m (b, b -> MooreT m b b))
-> MooreT m b b
-> m (b, a -> MooreT m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m b b -> m (b, b -> MooreT m b b)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT in MooreT m b c -> MooreT m a c
forall b. MooreT m b b -> MooreT m a b
go
  {-# INLINE lmap #-}
#if MIN_VERSION_profunctors(3,1,1)
  dimap :: (a -> b) -> (c -> d) -> MooreT m b c -> MooreT m a d
dimap a -> b
f c -> d
g = let go :: MooreT m b c -> MooreT m a d
go = m (d, a -> MooreT m a d) -> MooreT m a d
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (d, a -> MooreT m a d) -> MooreT m a d)
-> (MooreT m b c -> m (d, a -> MooreT m a d))
-> MooreT m b c
-> MooreT m a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c, b -> MooreT m b c) -> (d, a -> MooreT m a d))
-> m (c, b -> MooreT m b c) -> m (d, a -> MooreT m a d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(c
b, b -> MooreT m b c
m') -> (c -> d
g c
b, MooreT m b c -> MooreT m a d
go (MooreT m b c -> MooreT m a d)
-> (a -> MooreT m b c) -> a -> MooreT m a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> MooreT m b c
m' (b -> MooreT m b c) -> (a -> b) -> a -> MooreT m b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)) (m (c, b -> MooreT m b c) -> m (d, a -> MooreT m a d))
-> (MooreT m b c -> m (c, b -> MooreT m b c))
-> MooreT m b c
-> m (d, a -> MooreT m a d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MooreT m b c -> m (c, b -> MooreT m b c)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT in MooreT m b c -> MooreT m a d
go
  {-# INLINE dimap #-}
#endif

instance Applicative m => Applicative (MooreT m a) where
  pure :: a -> MooreT m a a
pure a
x = let r :: MooreT m a a
r = m (a, a -> MooreT m a a) -> MooreT m a a
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (a, a -> MooreT m a a) -> MooreT m a a)
-> m (a, a -> MooreT m a a) -> MooreT m a a
forall a b. (a -> b) -> a -> b
$ (a, a -> MooreT m a a) -> m (a, a -> MooreT m a a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, MooreT m a a -> a -> MooreT m a a
forall a b. a -> b -> a
const MooreT m a a
r) in MooreT m a a
forall a. MooreT m a a
r
  {-# INLINE pure #-}
  MooreT m a (a -> b)
fm <*> :: MooreT m a (a -> b) -> MooreT m a a -> MooreT m a b
<*> MooreT m a a
xm = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> m (b, a -> MooreT m a b) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$
    (\(a -> b
f, a -> MooreT m a (a -> b)
fm') (a
x, a -> MooreT m a a
xm') -> (a -> b
f a
x, \a
a -> a -> MooreT m a (a -> b)
fm' a
a MooreT m a (a -> b) -> MooreT m a a -> MooreT m a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> MooreT m a a
xm' a
a)) ((a -> b, a -> MooreT m a (a -> b))
 -> (a, a -> MooreT m a a) -> (b, a -> MooreT m a b))
-> m (a -> b, a -> MooreT m a (a -> b))
-> m ((a, a -> MooreT m a a) -> (b, a -> MooreT m a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MooreT m a (a -> b) -> m (a -> b, a -> MooreT m a (a -> b))
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m a (a -> b)
fm m ((a, a -> MooreT m a a) -> (b, a -> MooreT m a b))
-> m (a, a -> MooreT m a a) -> m (b, a -> MooreT m a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MooreT m a a -> m (a, a -> MooreT m a a)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m a a
xm
  {-# INLINE (<*>) #-}

instance Applicative m => Pointed (MooreT m a) where
  point :: a -> MooreT m a a
point = a -> MooreT m a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE point #-}

instance (Functor m, Monad m) => Costrong (MooreT m) where
  unfirst :: MooreT m (a, d) (b, d) -> MooreT m a b
unfirst MooreT m (a, d) (b, d)
m = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> m (b, a -> MooreT m a b) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$ do
    ((b
b, d
d), (a, d) -> MooreT m (a, d) (b, d)
m') <- MooreT m (a, d) (b, d)
-> m ((b, d), (a, d) -> MooreT m (a, d) (b, d))
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m (a, d) (b, d)
m
    (b, a -> MooreT m a b) -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, \a
a -> MooreT m (a, d) (b, d) -> MooreT m a b
forall (p :: * -> * -> *) a d b.
Costrong p =>
p (a, d) (b, d) -> p a b
unfirst (MooreT m (a, d) (b, d) -> MooreT m a b)
-> MooreT m (a, d) (b, d) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$ (a, d) -> MooreT m (a, d) (b, d)
m' (a
a, d
d))
  {-# INLINE unfirst #-}
  unsecond :: MooreT m (d, a) (d, b) -> MooreT m a b
unsecond MooreT m (d, a) (d, b)
m = m (b, a -> MooreT m a b) -> MooreT m a b
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (b, a -> MooreT m a b) -> MooreT m a b)
-> m (b, a -> MooreT m a b) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$ do
    ((d
d, b
b), (d, a) -> MooreT m (d, a) (d, b)
m') <- MooreT m (d, a) (d, b)
-> m ((d, b), (d, a) -> MooreT m (d, a) (d, b))
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT MooreT m (d, a) (d, b)
m
    (b, a -> MooreT m a b) -> m (b, a -> MooreT m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, \a
a -> MooreT m (d, a) (d, b) -> MooreT m a b
forall (p :: * -> * -> *) d a b.
Costrong p =>
p (d, a) (d, b) -> p a b
unsecond (MooreT m (d, a) (d, b) -> MooreT m a b)
-> MooreT m (d, a) (d, b) -> MooreT m a b
forall a b. (a -> b) -> a -> b
$ (d, a) -> MooreT m (d, a) (d, b)
m' (d
d, a
a))
  {-# INLINE unsecond #-}

instance (Distributive m, Applicative m) => Distributive (MooreT m a) where
  distribute :: f (MooreT m a a) -> MooreT m a (f a)
distribute f (MooreT m a a)
m = m (f a, a -> MooreT m a (f a)) -> MooreT m a (f a)
forall (m :: * -> *) a b. m (b, a -> MooreT m a b) -> MooreT m a b
MooreT (m (f a, a -> MooreT m a (f a)) -> MooreT m a (f a))
-> m (f a, a -> MooreT m a (f a)) -> MooreT m a (f a)
forall a b. (a -> b) -> a -> b
$
    (f (a, a -> MooreT m a a) -> (f a, a -> MooreT m a (f a)))
-> f (m (a, a -> MooreT m a a)) -> m (f a, a -> MooreT m a (f a))
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(f a -> b) -> f (g a) -> g b
cotraverse (\f (a, a -> MooreT m a a)
x -> (((a, a -> MooreT m a a) -> a) -> f (a, a -> MooreT m a a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, a -> MooreT m a a) -> a
forall a b. (a, b) -> a
fst f (a, a -> MooreT m a a)
x, (f (MooreT m a a) -> MooreT m a (f a))
-> (a -> f (MooreT m a a)) -> a -> MooreT m a (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (MooreT m a a) -> MooreT m a (f a)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute ((a -> f (MooreT m a a)) -> a -> MooreT m a (f a))
-> (a -> f (MooreT m a a)) -> a -> MooreT m a (f a)
forall a b. (a -> b) -> a -> b
$ f (a -> MooreT m a a) -> a -> f (MooreT m a a)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute (f (a -> MooreT m a a) -> a -> f (MooreT m a a))
-> f (a -> MooreT m a a) -> a -> f (MooreT m a a)
forall a b. (a -> b) -> a -> b
$ ((a, a -> MooreT m a a) -> a -> MooreT m a a)
-> f (a, a -> MooreT m a a) -> f (a -> MooreT m a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, a -> MooreT m a a) -> a -> MooreT m a a
forall a b. (a, b) -> b
snd f (a, a -> MooreT m a a)
x))
    (f (m (a, a -> MooreT m a a)) -> m (f a, a -> MooreT m a (f a)))
-> f (m (a, a -> MooreT m a a)) -> m (f a, a -> MooreT m a (f a))
forall a b. (a -> b) -> a -> b
$ (MooreT m a a -> m (a, a -> MooreT m a a))
-> f (MooreT m a a) -> f (m (a, a -> MooreT m a a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MooreT m a a -> m (a, a -> MooreT m a a)
forall (m :: * -> *) a b. MooreT m a b -> m (b, a -> MooreT m a b)
runMooreT f (MooreT m a a)
m
  {-# INLINE distribute #-}

instance (Applicative m, Semigroup b) => Semigroup (MooreT m a b) where
  MooreT m a b
a <> :: MooreT m a b -> MooreT m a b -> MooreT m a b
<> MooreT m a b
b = b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>) (b -> b -> b) -> MooreT m a b -> MooreT m a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MooreT m a b
a MooreT m a (b -> b) -> MooreT m a b -> MooreT m a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MooreT m a b
b
  {-# INLINE (<>) #-}

instance (Applicative m, Monoid b) => Monoid (MooreT m a b) where
  mempty :: MooreT m a b
mempty = b -> MooreT m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
  mappend a b = mappend <$> a <*> b
  {-# INLINE mappend #-}
#endif