{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fenable-rewrite-rules -fno-warn-orphans #-}
----------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Representable.Reader
-- Copyright   :  (c) Edward Kmett 2011,
--                (c) Conal Elliott 2008
-- License     :  BSD3
--
-- Maintainer  :  [email protected]
-- Stability   :  experimental
--
-- Representable functors on Hask are all monads, because they are isomorphic to
-- a 'Reader' monad.
----------------------------------------------------------------------

module Control.Monad.Representable.Reader
  (
  -- * Representable functor monad
    Reader
  , runReader
  -- * Monad Transformer
  , ReaderT(..), readerT, runReaderT
  , MonadReader(..)
  , module Data.Functor.Rep
  ) where

import Control.Applicative
import Control.Comonad
import Control.Monad.Reader.Class
import Control.Monad.Writer.Class as Writer
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Distributive
import Data.Functor.Bind
import Data.Functor.Extend
import Data.Functor.Identity
import Data.Functor.Rep
import Data.Foldable
import Data.Traversable
import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Prelude hiding (lookup,zipWith)

type Reader f = ReaderT f Identity

runReader :: Representable f => Reader f b -> Rep f -> b
runReader :: forall (f :: * -> *) b. Representable f => Reader f b -> Rep f -> b
runReader = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b.
Representable f =>
ReaderT f m b -> Rep f -> m b
runReaderT

-- * This 'representable monad transformer' transforms any monad @m@ with a 'Representable' 'Monad'.
--   This monad in turn is also representable if @m@ is 'Representable'.
newtype ReaderT f m b = ReaderT { forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT :: f (m b) }

readerT :: Representable f => (Rep f -> m b) -> ReaderT f m b
readerT :: forall (f :: * -> *) (m :: * -> *) b.
Representable f =>
(Rep f -> m b) -> ReaderT f m b
readerT = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate

runReaderT :: Representable f => ReaderT f m b -> Rep f -> m b
runReaderT :: forall (f :: * -> *) (m :: * -> *) b.
Representable f =>
ReaderT f m b -> Rep f -> m b
runReaderT = forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT

instance (Functor f, Functor m) => Functor (ReaderT f m) where
  fmap :: forall a b. (a -> b) -> ReaderT f m a -> ReaderT f m b
fmap a -> b
f = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT

instance (Representable f, Representable m) => Representable (ReaderT f m) where
  type Rep (ReaderT f m) = (Rep f, Rep m)
  tabulate :: forall a. (Rep (ReaderT f m) -> a) -> ReaderT f m a
tabulate = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. ((a, b) -> c) -> a -> b -> c
curry
  index :: forall a. ReaderT f m a -> Rep (ReaderT f m) -> a
index = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT

instance (Representable f, Apply m) => Apply (ReaderT f m) where
  ReaderT f (m (a -> b))
ff <.> :: forall a b. ReaderT f m (a -> b) -> ReaderT f m a -> ReaderT f m b
<.> ReaderT f (m a)
fa = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT (forall (f :: * -> *) a. Co f a -> f a
unCo (forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. f a -> Co f a
Co f (m (a -> b))
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> forall (f :: * -> *) a. f a -> Co f a
Co f (m a)
fa))

instance (Representable f, Applicative m) => Applicative (ReaderT f m) where
  pure :: forall a. a -> ReaderT f m a
pure = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => a -> f a
pureRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ReaderT f (m (a -> b))
ff <*> :: forall a b. ReaderT f m (a -> b) -> ReaderT f m a -> ReaderT f m b
<*> ReaderT f (m a)
fa = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT (forall (f :: * -> *) a. Co f a -> f a
unCo (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. f a -> Co f a
Co f (m (a -> b))
ff forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. f a -> Co f a
Co f (m a)
fa))

instance (Representable f, Bind m) => Bind (ReaderT f m) where
  ReaderT f (m a)
fm >>- :: forall a b. ReaderT f m a -> (a -> ReaderT f m b) -> ReaderT f m b
>>- a -> ReaderT f m b
f = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate (\Rep f
a -> forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index f (m a)
fm Rep f
a forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index Rep f
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT f m b
f)

instance (Representable f, Monad m) => Monad (ReaderT f m) where
#if __GLASGOW_HASKELL__ < 710
  return = ReaderT . pureRep . return
#endif
  ReaderT f (m a)
fm >>= :: forall a b. ReaderT f m a -> (a -> ReaderT f m b) -> ReaderT f m b
>>= a -> ReaderT f m b
f = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate (\Rep f
a -> forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index f (m a)
fm Rep f
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index Rep f
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT f m b
f)

#if __GLASGOW_HASKELL >= 704

instance (Representable f, Monad m, Rep f ~ e) => MonadReader e (ReaderT f m) where
  ask = ReaderT (tabulate return)
  local f m = readerT $ \r -> runReaderT m (f r)
#if MIN_VERSION_transformers(0,3,0)
  reader = readerT . fmap return
#endif

#endif

instance Representable f => MonadTrans (ReaderT f) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ReaderT f m a
lift = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => a -> f a
pureRep

instance (Representable f, Distributive m) => Distributive (ReaderT f m) where
  distribute :: forall (f :: * -> *) a.
Functor f =>
f (ReaderT f m a) -> ReaderT f m (f a)
distribute = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Representable f => (a -> b) -> f a -> f b
fmapRep forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Co f a -> f a
unCo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect (forall (f :: * -> *) a. f a -> Co f a
Co forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT)

instance (Representable f, Representable m, Semigroup (Rep f), Semigroup (Rep m)) => Extend (ReaderT f m) where
  extended :: forall a b. (ReaderT f m a -> b) -> ReaderT f m a -> ReaderT f m b
extended = forall (f :: * -> *) a b.
(Representable f, Semigroup (Rep f)) =>
(f a -> b) -> f a -> f b
extendedRep
  duplicated :: forall a. ReaderT f m a -> ReaderT f m (ReaderT f m a)
duplicated = forall (f :: * -> *) a.
(Representable f, Semigroup (Rep f)) =>
f a -> f (f a)
duplicatedRep

instance (Representable f, Representable m, Monoid (Rep f), Monoid (Rep m)) => Comonad (ReaderT f m) where
  extend :: forall a b. (ReaderT f m a -> b) -> ReaderT f m a -> ReaderT f m b
extend = forall (f :: * -> *) a b.
(Representable f, Monoid (Rep f)) =>
(f a -> b) -> f a -> f b
extendRep
  duplicate :: forall a. ReaderT f m a -> ReaderT f m (ReaderT f m a)
duplicate = forall (f :: * -> *) a.
(Representable f, Monoid (Rep f)) =>
f a -> f (f a)
duplicateRep
  extract :: forall a. ReaderT f m a -> a
extract = forall (f :: * -> *) a.
(Representable f, Monoid (Rep f)) =>
f a -> a
extractRep

instance (Representable f, MonadIO m) => MonadIO (ReaderT f m) where
  liftIO :: forall a. IO a -> ReaderT f m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (Representable f, MonadWriter w m) => MonadWriter w (ReaderT f m) where
  tell :: w -> ReaderT f m ()
tell = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. ReaderT f m a -> ReaderT f m (a, w)
listen (ReaderT f (m a)
m) = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
Writer.listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index f (m a)
m
  pass :: forall a. ReaderT f m (a, w -> w) -> ReaderT f m a
pass (ReaderT f (m (a, w -> w))
m) = forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
Writer.pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index f (m (a, w -> w))
m

-- misc. instances that can exist, but aren't particularly about representability

instance (Foldable f, Foldable m) => Foldable (ReaderT f m) where
  foldMap :: forall m a. Monoid m => (a -> m) -> ReaderT f m a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT

instance (Foldable1 f, Foldable1 m) => Foldable1 (ReaderT f m) where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> ReaderT f m a -> m
foldMap1 a -> m
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT

instance (Traversable f, Traversable m) => Traversable (ReaderT f m) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ReaderT f m a -> f (ReaderT f m b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT

instance (Traversable1 f, Traversable1 m) => Traversable1 (ReaderT f m) where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> ReaderT f m a -> f (ReaderT f m b)
traverse1 a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) (m :: * -> *) b. f (m b) -> ReaderT f m b
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 a -> f b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) b. ReaderT f m b -> f (m b)
getReaderT