{- |
Module      : Control.Lens.Grate
Description : grates
Copyright   : (C) 2025 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable

See O'Connor, [Grate: A new kind of Optic]
(https://r6research.livejournal.com/28050.html)
-}

module Control.Lens.Grate
  ( -- * Grate
    Grate
  , AGrate
    -- * Combinators
  , grate
  , withGrate
  , cloneGrate
  , mapGrate
  , cotraversed
  , represented
  , cotraverseOf
  , distributeOf
  , collectOf
  , distributing
    -- * Grating
  , Grating (..)
  ) where

import Data.Distributive
import Data.Function
import Data.Functor.Identity
import Data.Functor.Rep
import Data.Profunctor
import Data.Profunctor.Distributor

{- | `Grate`s are an optic that are dual to
`Control.Lens.Traversal.Traversal`s, as `Distributive` is `Traversable`.

Every `Control.Lens.Monocle.Monocle` is a `Grate`.

`Grate`s are isomorphic to `Grating`s.
-}
type Grate s t a b = forall p f.
  (Closed p, Monoidal p, Distributive f, Applicative f)
    => p a (f b) -> p s (f t)

{- | If you see `AGrate` in a signature for a function,
the function is expecting a `Grate`. -}
type AGrate s t a b =
  Grating a b a (Identity b) -> Grating a b s (Identity t)

{- | Build a `Grate`. -}
grate :: (((s -> a) -> b) -> t) -> Grate s t a b
grate :: forall s a b t. (((s -> a) -> b) -> t) -> Grate s t a b
grate ((s -> a) -> b) -> t
f = (s -> (s -> a) -> a)
-> (((s -> a) -> f b) -> f t)
-> p ((s -> a) -> a) ((s -> a) -> f b)
-> p s (f t)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> (s -> a) -> a
forall a b. a -> (a -> b) -> b
(&) ((((s -> a) -> b) -> t) -> ((s -> a) -> f b) -> f t
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(f a -> b) -> f (g a) -> g b
cotraverse ((s -> a) -> b) -> t
f) (p ((s -> a) -> a) ((s -> a) -> f b) -> p s (f t))
-> (p a (f b) -> p ((s -> a) -> a) ((s -> a) -> f b))
-> p a (f b)
-> p s (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> p ((s -> a) -> a) ((s -> a) -> f b)
forall a b x. p a b -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed

{- | Build a `Grate` from a `Distributive`. -}
cotraversed :: Distributive g => Grate (g a) (g b) a b
cotraversed :: forall (g :: * -> *) a b. Distributive g => Grate (g a) (g b) a b
cotraversed = (((g a -> a) -> b) -> g b) -> Grate (g a) (g b) a b
forall s a b t. (((s -> a) -> b) -> t) -> Grate s t a b
grate ((((g a -> a) -> b) -> g b) -> Grate (g a) (g b) a b)
-> (((g a -> a) -> b) -> g b) -> Grate (g a) (g b) a b
forall a b. (a -> b) -> a -> b
$ (((g a -> a) -> b) -> (g a -> g a) -> g b)
-> (g a -> g a) -> ((g a -> a) -> b) -> g b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((g a -> a) -> b) -> (g a -> g a) -> g b
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(f a -> b) -> f (g a) -> g b
cotraverse g a -> g a
forall a. a -> a
id

{- | Build a `Grate` from a `Representable`. -}
represented :: Representable g => Grate (g a) (g b) a b
represented :: forall (g :: * -> *) a b. Representable g => Grate (g a) (g b) a b
represented = (((g a -> a) -> b) -> g b) -> Grate (g a) (g b) a b
forall s a b t. (((s -> a) -> b) -> t) -> Grate s t a b
grate ((((g a -> a) -> b) -> g b) -> Grate (g a) (g b) a b)
-> (((g a -> a) -> b) -> g b) -> Grate (g a) (g b) a b
forall a b. (a -> b) -> a -> b
$ (Rep g -> b) -> g b
forall a. (Rep g -> a) -> g a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate ((Rep g -> b) -> g b)
-> (((g a -> a) -> b) -> Rep g -> b) -> ((g a -> a) -> b) -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((g a -> a) -> b) -> (Rep g -> g a -> a) -> Rep g -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> Rep g -> a) -> Rep g -> g a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip g a -> Rep g -> a
forall a. g a -> Rep g -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index)

{- | Action of `AGrate` on `Closed` `Profunctor`s. -}
mapGrate :: Closed p => AGrate s t a b -> p a b -> p s t
mapGrate :: forall (p :: * -> * -> *) s t a b.
Closed p =>
AGrate s t a b -> p a b -> p s t
mapGrate AGrate s t a b
grt = (s -> (s -> a) -> a)
-> (((s -> a) -> b) -> t)
-> p ((s -> a) -> a) ((s -> a) -> b)
-> p s t
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> (s -> a) -> a
forall a b. a -> (a -> b) -> b
(&) (AGrate s t a b -> ((s -> a) -> b) -> t
forall s t a b. AGrate s t a b -> ((s -> a) -> b) -> t
withGrate AGrate s t a b
grt) (p ((s -> a) -> a) ((s -> a) -> b) -> p s t)
-> (p a b -> p ((s -> a) -> a) ((s -> a) -> b)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p ((s -> a) -> a) ((s -> a) -> b)
forall a b x. p a b -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed

{- | Clone `AGrate` so that you can reuse the same
monomorphically typed `Grate` for different purposes.
-}
cloneGrate :: AGrate s t a b -> Grate s t a b
cloneGrate :: forall s t a b. AGrate s t a b -> Grate s t a b
cloneGrate = (((s -> a) -> b) -> t) -> Grate s t a b
forall s a b t. (((s -> a) -> b) -> t) -> Grate s t a b
grate ((((s -> a) -> b) -> t) -> Grate s t a b)
-> (AGrate s t a b -> ((s -> a) -> b) -> t)
-> AGrate s t a b
-> Grate s t a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AGrate s t a b -> ((s -> a) -> b) -> t
forall s t a b. AGrate s t a b -> ((s -> a) -> b) -> t
withGrate

{- | Run `AGrate`. -}
withGrate :: AGrate s t a b -> ((s -> a) -> b) -> t
withGrate :: forall s t a b. AGrate s t a b -> ((s -> a) -> b) -> t
withGrate AGrate s t a b
grt = Grating a b s t -> ((s -> a) -> b) -> t
forall a b s t. Grating a b s t -> ((s -> a) -> b) -> t
runGrating (Grating a b s t -> ((s -> a) -> b) -> t)
-> Grating a b s t -> ((s -> a) -> b) -> t
forall a b. (a -> b) -> a -> b
$ Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Grating a b s (Identity t) -> Grating a b s t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AGrate s t a b
grt (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> Grating a b a b -> Grating a b a (Identity b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Grating a b a b
forall a b (p :: * -> * -> *). Tokenized a b p => p a b
anyToken)

{- | Distribute over a `Closed` `Profunctor`. -}
distributing
  :: (Closed p, forall x. Functor (p x), Distributive g)
  => AGrate s t a b -> p a (g b) -> g (p s t)
distributing :: forall (p :: * -> * -> *) (g :: * -> *) s t a b.
(Closed p, forall x. Functor (p x), Distributive g) =>
AGrate s t a b -> p a (g b) -> g (p s t)
distributing AGrate s t a b
grt
  = p s (g t) -> g (p s t)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
forall (f :: * -> *) a. Functor f => f (g a) -> g (f a)
distribute
  (p s (g t) -> g (p s t))
-> (p a (g b) -> p s (g t)) -> p a (g b) -> g (p s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (s -> a) -> a)
-> (((s -> a) -> g b) -> g t)
-> p ((s -> a) -> a) ((s -> a) -> g b)
-> p s (g t)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> (s -> a) -> a
forall a b. a -> (a -> b) -> b
(&) ((((s -> a) -> b) -> t) -> ((s -> a) -> g b) -> g t
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(f a -> b) -> f (g a) -> g b
cotraverse (AGrate s t a b -> ((s -> a) -> b) -> t
forall s t a b. AGrate s t a b -> ((s -> a) -> b) -> t
withGrate AGrate s t a b
grt))
  (p ((s -> a) -> a) ((s -> a) -> g b) -> p s (g t))
-> (p a (g b) -> p ((s -> a) -> a) ((s -> a) -> g b))
-> p a (g b)
-> p s (g t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (g b) -> p ((s -> a) -> a) ((s -> a) -> g b)
forall a b x. p a b -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed

{- | Dual to `Control.Lens.Combinators.traverseOf`. -}
cotraverseOf :: Functor f => AGrate s t a b -> (f a -> b) -> f s -> t
cotraverseOf :: forall (f :: * -> *) s t a b.
Functor f =>
AGrate s t a b -> (f a -> b) -> f s -> t
cotraverseOf AGrate s t a b
grt = Costar f s t -> f s -> t
forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
runCostar (Costar f s t -> f s -> t)
-> ((f a -> b) -> Costar f s t) -> (f a -> b) -> f s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AGrate s t a b -> Costar f a b -> Costar f s t
forall (p :: * -> * -> *) s t a b.
Closed p =>
AGrate s t a b -> p a b -> p s t
mapGrate AGrate s t a b
grt (Costar f a b -> Costar f s t)
-> ((f a -> b) -> Costar f a b) -> (f a -> b) -> Costar f s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> b) -> Costar f a b
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar

{- | Dual to `Control.Lens.Combinators.sequenceAOf`. -}
distributeOf :: Functor f => AGrate s t b (f b) -> f s -> t
distributeOf :: forall (f :: * -> *) s t b.
Functor f =>
AGrate s t b (f b) -> f s -> t
distributeOf AGrate s t b (f b)
grt = AGrate s t b (f b) -> (f b -> f b) -> f s -> t
forall (f :: * -> *) s t a b.
Functor f =>
AGrate s t a b -> (f a -> b) -> f s -> t
cotraverseOf AGrate s t b (f b)
grt f b -> f b
forall a. a -> a
id

{- | `collect` with `AGrate`. -}
collectOf :: Functor f => AGrate s t b (f b) -> (a -> s) -> f a -> t
collectOf :: forall (f :: * -> *) s t b a.
Functor f =>
AGrate s t b (f b) -> (a -> s) -> f a -> t
collectOf AGrate s t b (f b)
grt a -> s
f = AGrate s t b (f b) -> f s -> t
forall (f :: * -> *) s t b.
Functor f =>
AGrate s t b (f b) -> f s -> t
distributeOf AGrate s t b (f b)
grt (f s -> t) -> (f a -> f s) -> f a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> s) -> f a -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
f

{- | `Grating` provides an efficient
concrete representation of `Grate`s. -}
newtype Grating a b s t = Grating
  {forall a b s t. Grating a b s t -> ((s -> a) -> b) -> t
runGrating :: ((s -> a) -> b) -> t}
instance Functor (Grating a b s) where fmap :: forall a b. (a -> b) -> Grating a b s a -> Grating a b s b
fmap = (a -> b) -> Grating a b s a -> Grating a b s b
forall (f :: * -> *) a b. Representable f => (a -> b) -> f a -> f b
fmapRep
instance Applicative (Grating a b s) where
  pure :: forall a. a -> Grating a b s a
pure = a -> Grating a b s a
forall (f :: * -> *) a. Representable f => a -> f a
pureRep
  <*> :: forall a b.
Grating a b s (a -> b) -> Grating a b s a -> Grating a b s b
(<*>) = Grating a b s (a -> b) -> Grating a b s a -> Grating a b s b
forall (f :: * -> *) a b.
Representable f =>
f (a -> b) -> f a -> f b
apRep
instance Tokenized a b (Grating a b) where
  anyToken :: Grating a b a b
anyToken = (((a -> a) -> b) -> b) -> Grating a b a b
forall a b s t. (((s -> a) -> b) -> t) -> Grating a b s t
Grating (((a -> a) -> b) -> (a -> a) -> b
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. a -> a
id)
instance Distributive (Grating a b s) where
  distribute :: forall (f :: * -> *) a.
Functor f =>
f (Grating a b s a) -> Grating a b s (f a)
distribute = f (Grating a b s a) -> Grating a b s (f a)
forall (f :: * -> *) (w :: * -> *) a.
(Representable f, Functor w) =>
w (f a) -> f (w a)
distributeRep
  collect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Grating a b s b) -> f a -> Grating a b s (f b)
collect = (a -> Grating a b s b) -> f a -> Grating a b s (f b)
forall (f :: * -> *) (w :: * -> *) a b.
(Representable f, Functor w) =>
(a -> f b) -> w a -> f (w b)
collectRep
instance Representable (Grating a b s) where
  type Rep (Grating a b s) = (s -> a) -> b
  index :: forall a. Grating a b s a -> Rep (Grating a b s) -> a
index (Grating ((s -> a) -> b) -> a
k) Rep (Grating a b s)
f = ((s -> a) -> b) -> a
k Rep (Grating a b s)
(s -> a) -> b
f
  tabulate :: forall a. (Rep (Grating a b s) -> a) -> Grating a b s a
tabulate = (Rep (Grating a b s) -> a) -> Grating a b s a
(((s -> a) -> b) -> a) -> Grating a b s a
forall a b s t. (((s -> a) -> b) -> t) -> Grating a b s t
Grating