{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TupleSections #-}
module Proton.Internal.Orphans where

import Data.Profunctor
import Control.Comonad
-- import Proton.Types
-- import Proton.Setter
-- import Proton.Getter

-- Steal this from Cokleisli at some point
-- instance Comonad w => Choice (Costar w) where

instance Comonad f => Strong (Costar f) where
  -- Not quite right
  first' :: Costar f a b -> Costar f (a, c) (b, c)
first' (Costar f :: f a -> b
f) = ((f (a, c) -> (b, c)) -> Costar f (a, c) (b, c)
forall (f :: * -> *) d c. (f d -> c) -> Costar f d c
Costar (f (b, c) -> (b, c)
forall (w :: * -> *) a. Comonad w => w a -> a
extract (f (b, c) -> (b, c))
-> (f (a, c) -> f (b, c)) -> f (a, c) -> (b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a, c) -> (b, c)) -> f (a, c) -> f (b, c)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\x :: f (a, c)
x -> (, (a, c) -> c
forall a b. (a, b) -> b
snd ((a, c) -> c) -> (f (a, c) -> (a, c)) -> f (a, c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (a, c) -> (a, c)
forall (w :: * -> *) a. Comonad w => w a -> a
extract (f (a, c) -> c) -> f (a, c) -> c
forall a b. (a -> b) -> a -> b
$ f (a, c)
x) (b -> (b, c)) -> b -> (b, c)
forall a b. (a -> b) -> a -> b
$ f a -> b
f ((a, c) -> a
forall a b. (a, b) -> a
fst ((a, c) -> a) -> f (a, c) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, c)
x))))

-- Don't think this is useful for anything; but we can get a Strong instance for Costar
-- using an adjunction between Star/Costar through (,) (->).

-- instance Strong (Costar ((,) e)) where
--   second' co = costarFlip $ second' (starFlip co)

-- starFlip :: Costar ((,) e) a b -> Star ((->) e) a b
-- starFlip (Costar f) = Star (\e a ->  f (a, e))

-- costarFlip :: Star ((->) e) a b -> Costar ((,) e) a b
-- costarFlip (Star f) = Costar (\(e, a) ->  f a e)