Reader.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Data.Reader.Reader where

import Control.Applicative ( Applicative(pure) )
import Control.Arrow ( Kleisli )
import Control.Category ( Category(..) )
import Control.Lens
    ( _Wrapped,
      over,
      review,
      iso,
      view,
      Iso,
      Rewrapped,
      Wrapped(Unwrapped) )
import Data.Profunctor ( Star )

-- |
--
-- Iso (Reader a b) (Reader a' b') (a -> b) (a' -> b')
reader ::
  (Rewrapped s s, Rewrapped t t, Rewrapped s' s', Rewrapped t' t', Unwrapped t ~ (a -> t'), Unwrapped s ~ (a' -> s')) =>
  Iso
    s
    t
    (a' -> Unwrapped s')
    (a -> Unwrapped t')
reader =
  iso
    (\r -> view _Wrapped . view _Wrapped r)
    (\f -> review _Wrapped (review _Wrapped . f))

-- |
--
-- Iso (LensLike f s t a b) (LensLike f' s' t' a' b') (ReaderT a f b -> ReaderT s f t) (ReaderT a' f b' -> ReaderT s' f t')
readerLens ::
  (Rewrapped s s, Rewrapped t t, Rewrapped s' s', Rewrapped t' t') =>
  Iso
    (Unwrapped s -> Unwrapped t)
    (Unwrapped t' -> Unwrapped s')
    (s -> t)
    (t' -> s')
readerLens =
  iso
    (\k f -> review _Wrapped (k (view _Wrapped f)))
    (\k f -> view _Wrapped (k (review _Wrapped f)))

-- |
--
-- Applicative f => Reader a b -> ReaderT a f b
pureReader ::
  (Applicative f, Rewrapped s t, Rewrapped t s, Rewrapped s' s', Unwrapped s ~ (a -> s'), Unwrapped t ~ (a -> f (Unwrapped s'))) =>
  s
  -> t
pureReader =
  over _Wrapped (\f -> pure . view _Wrapped . f)

-- |
--
-- (forall x. f x -> g x) -> ReaderT a f b -> ReaderT a g b
homReader ::
  (Rewrapped s t, Rewrapped t s, Category cat, Unwrapped s ~ cat a b, Unwrapped t ~ cat a c) =>
  cat b c
  -> s
  -> t
homReader f =
  over _Wrapped (f .)

-- |
--
-- Iso (Star f a b) (Star f' a' b') (ReaderT a f b) (ReaderT a' f' b')
star ::
  (Rewrapped a a, Rewrapped b b, Unwrapped a ~ (x -> f y), Unwrapped b ~ (x' -> f' y')) =>
  Iso
    (Star f x y)
    (Star f' x' y')
    a
    b
star =
  reader'

-- |
--
-- Iso (Kleisli f a b) (Kleisli f' a' b') (ReaderT a f b) (ReaderT a' f' b')
kleisli ::
  (Rewrapped a a, Rewrapped b b, Unwrapped a ~ (x -> m y), Unwrapped b ~ (x' -> m' y')) =>
  Iso
    (Kleisli m x y)
    (Kleisli m' x' y')
    a
    b
kleisli =
  reader'

-- |
--
-- Iso (ReaderT a f b) (ReaderT a' f' b') (Reader a (f b)) (Reader a' (f' b'))
liftReader ::
  (Rewrapped s s, Rewrapped t t, Rewrapped a a, Rewrapped b b, Rewrapped s' s', Rewrapped t' t',
  Unwrapped s ~ (a'' -> Unwrapped s'), Unwrapped t ~ (a' -> Unwrapped t'), Unwrapped a ~ (a'' -> s'), Unwrapped b ~ (a' -> t')) =>
  Iso s t a b
liftReader =
  iso
    (review reader . view _Wrapped)
    (review _Wrapped . view reader)

reader' ::
  (Rewrapped s s, Rewrapped t t, Rewrapped a a, Rewrapped b b, Unwrapped a ~ Unwrapped s, Unwrapped b ~ Unwrapped t) =>
  Iso
    s
    t
    a
    b
reader' =
  iso
    (review _Wrapped . view _Wrapped)
    (review _Wrapped . view _Wrapped)