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(Kleisli) )
import Control.Category ( Category(..) )
import Control.Lens
    ( _Wrapped,
      over,
      review,
      iso,
      view,
      Iso,
      Rewrapped,
      Wrapped(Unwrapped) )
import Data.Profunctor ( Star(Star) )

-- |
--
-- Iso (Reader a b) (Reader a' b') (a -> b) (a' -> b')
reader ::
  (Rewrapped t t, Rewrapped s1 s1, Rewrapped s2 s2, Rewrapped c c, Unwrapped t ~ (a1 -> c), Unwrapped s1 ~ (a2 -> s2)) =>
  Iso s1 t (a2 -> Unwrapped s2) (a1 -> Unwrapped c)
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') (Reader1Lens f s t a b) (Reader1Lens f' s' t' a' b')
readerLens ::
  (Rewrapped t1 t1, Rewrapped s1 s1, Rewrapped s2 s2, Rewrapped t2 t2) =>
  Iso
    (Unwrapped s1 -> Unwrapped t1)
    (Unwrapped t2 -> Unwrapped s2)
    (s1 -> t1)
    (t2 -> s2)
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 s1 t, Rewrapped t s1, Rewrapped s2 s2, Unwrapped t ~ (a -> f (Unwrapped s2)), Unwrapped s1 ~ (a -> s2)) =>
  s1
  -> 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 t ~ cat a c, Unwrapped s ~ cat a b) =>
  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 s s, Unwrapped a ~ (d1 -> f2 c1), Unwrapped s ~ (d2 -> f3 c2)) =>
  Iso (Star f2 d1 c1) (Star f3 d2 c2) a s
star =
  iso
    (\(Star k) -> review _Wrapped k)
    (Star . view _Wrapped)

-- |
--
-- Iso (Kleisli f a b) (Kleisli f' a' b') (ReaderT a f b) (ReaderT a' f' b')
kleisli ::
  (Rewrapped a1 a1, Rewrapped s s, Unwrapped a1 ~ (a2 -> m1 b1), Unwrapped s ~ (a3 -> m2 b2)) =>
  Iso (Kleisli m1 a2 b1) (Kleisli m2 a3 b2) a1 s
kleisli =
  iso
    (\(Kleisli k) -> review _Wrapped k)
    (Kleisli . view _Wrapped)