{-# LANGUAGE TupleSections #-}
module Proton.PreGrate where

import Proton.Grate
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Profunctor
import Data.Maybe
import Proton.Types
import Data.Pair
import Data.Functor.Rep
import Data.Distributive
import Data.Functor.Contravariant
import Control.Comonad
import qualified Data.List.NonEmpty as NE
import Data.Profunctor.MStrong
import Data.Semigroup
import Data.Coerce


alignMaybeWithDefault :: a -> Grate (Maybe a) (Maybe b) a b
alignMaybeWithDefault :: a -> Grate (Maybe a) (Maybe b) a b
alignMaybeWithDefault def :: a
def = (Maybe a -> a) -> (b -> Maybe b) -> p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) b -> Maybe b
forall a. a -> Maybe a
Just

aligner :: (s -> k -> a) -> ((k -> b) -> t) -> Grate s t a b
aligner :: (s -> k -> a) -> ((k -> b) -> t) -> Grate s t a b
aligner index :: s -> k -> a
index generate :: (k -> b) -> t
generate = (s -> k -> a) -> ((k -> b) -> t) -> p (k -> a) (k -> b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> k -> a
index (k -> b) -> t
generate (p (k -> a) (k -> b) -> p s t)
-> (p a b -> p (k -> a) (k -> b)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (k -> a) (k -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed

alignMap :: (Ord k) => S.Set k -> Grate (M.Map k a) (M.Map k b) (Maybe a) (Maybe b)
alignMap :: Set k -> Grate (Map k a) (Map k b) (Maybe a) (Maybe b)
alignMap keys :: Set k
keys = (Map k a -> k -> Maybe a)
-> ((k -> Maybe b) -> Map k b)
-> p (k -> Maybe a) (k -> Maybe b)
-> p (Map k a) (Map k b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((k -> Map k a -> Maybe a) -> Map k a -> k -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup) (k -> Maybe b) -> Map k b
project (p (k -> Maybe a) (k -> Maybe b) -> p (Map k a) (Map k b))
-> (p (Maybe a) (Maybe b) -> p (k -> Maybe a) (k -> Maybe b))
-> p (Maybe a) (Maybe b)
-> p (Map k a) (Map k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Maybe a) (Maybe b) -> p (k -> Maybe a) (k -> Maybe b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed
  where
    project :: (k -> Maybe b) -> Map k b
project f :: k -> Maybe b
f = [(k, b)] -> Map k b
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, b)] -> Map k b)
-> ([Maybe (k, b)] -> [(k, b)]) -> [Maybe (k, b)] -> Map k b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (k, b)] -> [(k, b)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (k, b)] -> Map k b) -> [Maybe (k, b)] -> Map k b
forall a b. (a -> b) -> a -> b
$ ((\k :: k
k -> (k
k,) (b -> (k, b)) -> Maybe b -> Maybe (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Maybe b
f k
k) (k -> Maybe (k, b)) -> [k] -> [Maybe (k, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set k -> [k]
forall a. Set a -> [a]
S.toList Set k
keys)

alignMapWithDefault :: (Ord k) => S.Set k -> a -> Grate (M.Map k a) (M.Map k b) a b
alignMapWithDefault :: Set k -> a -> Grate (Map k a) (Map k b) a b
alignMapWithDefault keys :: Set k
keys def :: a
def = Set k -> Grate (Map k a) (Map k b) (Maybe a) (Maybe b)
forall k a b.
Ord k =>
Set k -> Grate (Map k a) (Map k b) (Maybe a) (Maybe b)
alignMap Set k
keys (p (Maybe a) (Maybe b) -> p (Map k a) (Map k b))
-> (p a b -> p (Maybe a) (Maybe b))
-> p a b
-> p (Map k a) (Map k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a) -> (b -> Maybe b) -> p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) b -> Maybe b
forall a. a -> Maybe a
Just

alignList :: Int -> Grate [a] [b] (Maybe a) (Maybe b)
alignList :: Int -> Grate [a] [b] (Maybe a) (Maybe b)
alignList bound :: Int
bound = ([a] -> Int -> Maybe a)
-> ((Int -> Maybe b) -> [b])
-> p (Int -> Maybe a) (Int -> Maybe b)
-> p [a] [b]
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((Int -> [a] -> Maybe a) -> [a] -> Int -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [a] -> Maybe a
forall x. Int -> [x] -> Maybe x
safeIndex) (\f :: Int -> Maybe b
f -> [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe b] -> [b]) -> [Maybe b] -> [b]
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe b) -> [Int] -> [Maybe b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe b
f [0..Int
boundInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ) (p (Int -> Maybe a) (Int -> Maybe b) -> p [a] [b])
-> (p (Maybe a) (Maybe b) -> p (Int -> Maybe a) (Int -> Maybe b))
-> p (Maybe a) (Maybe b)
-> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Maybe a) (Maybe b) -> p (Int -> Maybe a) (Int -> Maybe b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed
  where
    safeIndex :: Int -> [x] -> Maybe x
    safeIndex :: Int -> [x] -> Maybe x
safeIndex _ [] = Maybe x
forall a. Maybe a
Nothing
    safeIndex n :: Int
n _ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Maybe x
forall a. Maybe a
Nothing
    safeIndex 0 (x :: x
x:_) = x -> Maybe x
forall a. a -> Maybe a
Just x
x
    safeIndex n :: Int
n (_:xs :: [x]
xs) = Int -> [x] -> Maybe x
forall x. Int -> [x] -> Maybe x
safeIndex (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [x]
xs

alignListWithDefault :: Int -> a -> Grate [a] [b] a b
alignListWithDefault :: Int -> a -> Grate [a] [b] a b
alignListWithDefault bound :: Int
bound def :: a
def = Int -> Grate [a] [b] (Maybe a) (Maybe b)
forall a b. Int -> Grate [a] [b] (Maybe a) (Maybe b)
alignList Int
bound (p (Maybe a) (Maybe b) -> p [a] [b])
-> (p a b -> p (Maybe a) (Maybe b)) -> p a b -> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a) -> (b -> Maybe b) -> p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) b -> Maybe b
forall a. a -> Maybe a
Just

alignMapMonoid :: (Monoid a, Ord k) => (S.Set k) -> Grate (M.Map k a) (M.Map k b) a b
alignMapMonoid :: Set k -> Grate (Map k a) (Map k b) a b
alignMapMonoid n :: Set k
n = Set k -> a -> Grate (Map k a) (Map k b) a b
forall k a b. Ord k => Set k -> a -> Grate (Map k a) (Map k b) a b
alignMapWithDefault Set k
n a
forall a. Monoid a => a
mempty

alignListMonoid :: Monoid a => Int -> Grate [a] [b] a b
alignListMonoid :: Int -> Grate [a] [b] a b
alignListMonoid n :: Int
n = Int -> a -> Grate [a] [b] a b
forall a b. Int -> a -> Grate [a] [b] a b
alignListWithDefault Int
n a
forall a. Monoid a => a
mempty

x :: M.Map Int [String]
x :: Map Int [String]
x = [(Int, [String])] -> Map Int [String]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(1, ["Gala", "Spartan", "Fuji"])]

y :: M.Map Int [String]
y :: Map Int [String]
y = [(Int, [String])] -> Map Int [String]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(1, ["Naval", "Mandarin"]), (2, ["Watermelon"])]

l :: Grate (M.Map Int [String]) (M.Map Int [b]) String b
l :: p String b -> p (Map Int [String]) (Map Int [b])
l = Set Int
-> [String] -> Grate (Map Int [String]) (Map Int [b]) [String] [b]
forall k a b. Ord k => Set k -> a -> Grate (Map k a) (Map k b) a b
alignMapWithDefault ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [1, 2, 3]) [] (p [String] [b] -> p (Map Int [String]) (Map Int [b]))
-> (p String b -> p [String] [b])
-> p String b
-> p (Map Int [String]) (Map Int [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> Grate [String] [b] String b
forall a b. Int -> a -> Grate [a] [b] a b
alignListWithDefault 3 "def"

l' :: Grate (M.Map Int [String]) (M.Map Int [b]) (Maybe String) (Maybe b)
l' :: p (Maybe String) (Maybe b) -> p (Map Int [String]) (Map Int [b])
l' = Set Int
-> Grate
     (Map Int [String]) (Map Int [b]) (Maybe [String]) (Maybe [b])
forall k a b.
Ord k =>
Set k -> Grate (Map k a) (Map k b) (Maybe a) (Maybe b)
alignMap ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [1, 2, 3]) (p (Maybe [String]) (Maybe [b])
 -> p (Map Int [String]) (Map Int [b]))
-> (p (Maybe String) (Maybe b) -> p (Maybe [String]) (Maybe [b]))
-> p (Maybe String) (Maybe b)
-> p (Map Int [String]) (Map Int [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Grate (Maybe [String]) (Maybe [b]) [String] [b]
forall a b. a -> Grate (Maybe a) (Maybe b) a b
alignMaybeWithDefault [] (p [String] [b] -> p (Maybe [String]) (Maybe [b]))
-> (p (Maybe String) (Maybe b) -> p [String] [b])
-> p (Maybe String) (Maybe b)
-> p (Maybe [String]) (Maybe [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Grate [String] [b] (Maybe String) (Maybe b)
forall a b. Int -> Grate [a] [b] (Maybe a) (Maybe b)
alignList 3

newtype Intersection a = Intersection (S.Set a)
instance Ord a => Semigroup (Intersection a) where
  <> :: Intersection a -> Intersection a -> Intersection a
(<>) = (Set a -> Set a -> Set a)
-> Intersection a -> Intersection a -> Intersection a
forall a b. Coercible a b => a -> b
coerce Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection

fullAlignMap :: (Ord k, MStrong p, Closed p) => p a b -> p (M.Map k a) (M.Map k b)
fullAlignMap :: p a b -> p (Map k a) (Map k b)
fullAlignMap = (Map k a -> (k -> a, Maybe (Intersection k)))
-> ((k -> b, Maybe (Intersection k)) -> Map k b)
-> p (k -> a, Maybe (Intersection k))
     (k -> b, Maybe (Intersection k))
-> p (Map k a) (Map k b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Map k a -> (k -> a, Maybe (Intersection k))
forall a a. Ord a => Map a a -> (a -> a, Maybe (Intersection a))
unpack (k -> b, Maybe (Intersection k)) -> Map k b
forall k a. Ord k => (k -> a, Maybe (Intersection k)) -> Map k a
rebuild (p (k -> a, Maybe (Intersection k))
   (k -> b, Maybe (Intersection k))
 -> p (Map k a) (Map k b))
-> (p a b
    -> p (k -> a, Maybe (Intersection k))
         (k -> b, Maybe (Intersection k)))
-> p a b
-> p (Map k a) (Map k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (k -> a) (k -> b)
-> p (k -> a, Maybe (Intersection k))
     (k -> b, Maybe (Intersection k))
forall (p :: * -> * -> *) m a b.
(MStrong p, Monoid m) =>
p a b -> p (a, m) (b, m)
mfirst' (p (k -> a) (k -> b)
 -> p (k -> a, Maybe (Intersection k))
      (k -> b, Maybe (Intersection k)))
-> (p a b -> p (k -> a) (k -> b))
-> p a b
-> p (k -> a, Maybe (Intersection k))
     (k -> b, Maybe (Intersection k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (k -> a) (k -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed
  where
    unpack :: Map a a -> (a -> a, Maybe (Intersection a))
unpack m :: Map a a
m = (\k :: a
k -> Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> Map a a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
k Map a a
m, Intersection a -> Maybe (Intersection a)
forall a. a -> Maybe a
Just (Intersection a -> Maybe (Intersection a))
-> (Map a a -> Intersection a) -> Map a a -> Maybe (Intersection a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Intersection a
forall a. Set a -> Intersection a
Intersection (Set a -> Intersection a)
-> (Map a a -> Set a) -> Map a a -> Intersection a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a a -> Set a
forall k a. Map k a -> Set k
M.keysSet (Map a a -> Maybe (Intersection a))
-> Map a a -> Maybe (Intersection a)
forall a b. (a -> b) -> a -> b
$ Map a a
m)
    rebuild :: (k -> a, Maybe (Intersection k)) -> Map k a
rebuild (f :: k -> a
f, Just (Intersection ks :: Set k
ks)) = (k -> a) -> Set k -> Map k a
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet k -> a
f Set k
ks
    rebuild (_, Nothing) = Map k a
forall a. Monoid a => a
mempty

fullAlignList :: (MStrong p, Closed p) => p a b -> p [a] [b]
fullAlignList :: p a b -> p [a] [b]
fullAlignList = ([a] -> (Int -> a, Maybe (Min Int)))
-> ((Int -> b, Maybe (Min Int)) -> [b])
-> p (Int -> a, Maybe (Min Int)) (Int -> b, Maybe (Min Int))
-> p [a] [b]
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap [a] -> (Int -> a, Maybe (Min Int))
forall a. [a] -> (Int -> a, Maybe (Min Int))
unpack (Int -> b, Maybe (Min Int)) -> [b]
forall a a. (Num a, Enum a) => (a -> a, Maybe (Min a)) -> [a]
rebuild (p (Int -> a, Maybe (Min Int)) (Int -> b, Maybe (Min Int))
 -> p [a] [b])
-> (p a b
    -> p (Int -> a, Maybe (Min Int)) (Int -> b, Maybe (Min Int)))
-> p a b
-> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Int -> a) (Int -> b)
-> p (Int -> a, Maybe (Min Int)) (Int -> b, Maybe (Min Int))
forall (p :: * -> * -> *) m a b.
(MStrong p, Monoid m) =>
p a b -> p (a, m) (b, m)
mfirst' (p (Int -> a) (Int -> b)
 -> p (Int -> a, Maybe (Min Int)) (Int -> b, Maybe (Min Int)))
-> (p a b -> p (Int -> a) (Int -> b))
-> p a b
-> p (Int -> a, Maybe (Min Int)) (Int -> b, Maybe (Min Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Int -> a) (Int -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed
  where
    unpack :: [a] -> (Int -> a, Maybe (Min Int))
unpack m :: [a]
m = (\k :: Int
k -> [a]
m [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
k, Min Int -> Maybe (Min Int)
forall a. a -> Maybe a
Just (Int -> Min Int
forall a. a -> Min a
Min ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
m)))
    rebuild :: (a -> a, Maybe (Min a)) -> [a]
rebuild (_, Nothing) = []
    rebuild (f :: a -> a
f, Just (Min len :: a
len)) = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f [0..a
lena -> a -> a
forall a. Num a => a -> a -> a
-1]

-- instance (Comonad f) => Strong (Costar f) where
--   first' (Costar f) = Costar ((\a b -> (a (fmap fst b), snd . extract $ b)) f)

-- doAThing :: Distributive f => Optic (Star f) s t a b -> (a -> Pair b) -> s -> Pair t
-- doAThing o = o (Star )

tester :: M.Map Int [String]
tester :: Map Int [String]
tester = Optic
  (Costar []) (Map Int [String]) (Map Int [String]) String String
-> ([String] -> String) -> [Map Int [String]] -> Map Int [String]
forall (f :: * -> *) s t a b.
Optic (Costar f) s t a b -> (f a -> b) -> f s -> t
zipFWithOf (Costar [] [String] [String]
-> Costar [] (Map Int [String]) (Map Int [String])
forall k (p :: * -> * -> *) a b.
(Ord k, MStrong p, Closed p) =>
p a b -> p (Map k a) (Map k b)
fullAlignMap (Costar [] [String] [String]
 -> Costar [] (Map Int [String]) (Map Int [String]))
-> (Costar [] String String -> Costar [] [String] [String])
-> Optic
     (Costar []) (Map Int [String]) (Map Int [String]) String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Costar [] String String -> Costar [] [String] [String]
forall (p :: * -> * -> *) a b.
(MStrong p, Closed p) =>
p a b -> p [a] [b]
fullAlignList) [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Map Int [String]
x, Map Int [String]
y]


-- Allow splitting a record into component parts to zip as well as the "monoidal" remainder
-- Then zip the main components, mappend up the rest, and re-combine.
zipBy :: forall f p s t a b m. (Representable f, MStrong p, Closed p, Monoid m) => (s -> (f a, m)) -> (f b -> m -> t) -> p a b -> p s t
zipBy :: (s -> (f a, m)) -> (f b -> m -> t) -> p a b -> p s t
zipBy project :: s -> (f a, m)
project embed :: f b -> m -> t
embed = (s -> (Rep f -> a, m))
-> ((Rep f -> b, m) -> t)
-> p (Rep f -> a, m) (Rep f -> b, m)
-> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> (Rep f -> a, m)
unpack (Rep f -> b, m) -> t
rebuild (p (Rep f -> a, m) (Rep f -> b, m) -> p s t)
-> (p a b -> p (Rep f -> a, m) (Rep f -> b, m)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Rep f -> a) (Rep f -> b) -> p (Rep f -> a, m) (Rep f -> b, m)
forall (p :: * -> * -> *) m a b.
(MStrong p, Monoid m) =>
p a b -> p (a, m) (b, m)
mfirst' (p (Rep f -> a) (Rep f -> b) -> p (Rep f -> a, m) (Rep f -> b, m))
-> (p a b -> p (Rep f -> a) (Rep f -> b))
-> p a b
-> p (Rep f -> a, m) (Rep f -> b, m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Rep f -> a) (Rep f -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed
  where
    unpack :: s -> (Rep f -> a, m)
    unpack :: s -> (Rep f -> a, m)
unpack s :: s
s = 
        case s -> (f a, m)
project s
s of
            (fa :: f a
fa, m :: m
m) -> (f a -> Rep f -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index f a
fa, m
m)
    rebuild :: (Rep f -> b, m) -> t
    rebuild :: (Rep f -> b, m) -> t
rebuild (rep :: Rep f -> b
rep, m :: m
m) = f b -> m -> t
embed ((Rep f -> b) -> f b
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate Rep f -> b
rep) m
m

-- Strong & Closed == don't need to specify indexes, maybe I can carry them through??

-- hoistO :: Optic (Star f) s t a b -> Optic (Costar g) s t a b

-- tester :: Star ((->) Bool) a b -> Costar Pair a b
-- tester (Star f) = Costar (_ f)

-- preZipWithOf :: forall s t a b. Optic (Star ((->) Bool)) s t a b -> (a -> a -> b) -> s -> s -> t
-- preZipWithOf g f s1 s2 = zipFWithOf g (_) (_)
--   where
--     buildPair p = tabulate p
--     applyPair (Pair a b) = f a b
--     -- thin :: a -> Bool -> b
--     -- thing = 

-- -- preZipFWithOf :: forall f s t a b. Optic (Star f) s t a b -> (a -> f b) -> (s -> f t)