{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Proton.Kaleidoscope (Reflector(..), Kaleidoscope, Kaleidoscope', pointWise) where

-- ala http://events.cs.bham.ac.uk/syco/strings3-syco5/slides/roman.pdf
-- https://cs.ttu.ee/events/nwpt2019/abstracts/paper14.pdf

import Data.Profunctor
import Control.Applicative
import Data.Profunctor.Reflector

type Kaleidoscope s t a b = forall p. Reflector p => p a b -> p s t
type Kaleidoscope' s a = Kaleidoscope s s a a

pointWise :: Kaleidoscope [a] [b] a b
pointWise :: p a b -> p [a] [b]
pointWise = ([a] -> ZipList a)
-> (ZipList b -> [b]) -> p (ZipList a) (ZipList b) -> p [a] [b]
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList ZipList b -> [b]
forall a. ZipList a -> [a]
getZipList (p (ZipList a) (ZipList b) -> p [a] [b])
-> (p a b -> p (ZipList a) (ZipList b)) -> p a b -> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (ZipList a) (ZipList b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Reflector p, Applicative f) =>
p a b -> p (f a) (f b)
reflected

-- collapse :: forall p f a b c g. (Traversable g, Applicative g, Alternative f, Corepresentable p, Corep p ~ g)
--         => Optic' p (f a) a
-- collapse p = cotabulate done
--   where
--     func :: g (f a) -> (f a)
--     func = cosieve (convolving p)
--     done :: g (f a) -> f a
--     done = func . pure @g . asum