module Proton.Prisms where

import Data.Profunctor
import Data.Market

type Prism s t a b = forall p. Choice p => p a b -> p s t
type Prism' s a = Prism s s a a

-- dualPrism :: forall p s t a b. (Choice p, Cochoice p) => (s -> Either t a) -> (b -> Either a t) -> Optic p s t a b
-- dualPrism l r p = lmap l . go $ rmap r p
--   where
--     go :: p a (Either a t) -> p (Either t a) t
--     go = undefined

prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism build :: b -> t
build split :: s -> Either t a
split = (s -> Either t a)
-> (Either t b -> t) -> p (Either t a) (Either t b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either t a
split ((t -> t) -> (b -> t) -> Either t b -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> t
forall a. a -> a
id b -> t
build) (p (Either t a) (Either t b) -> p s t)
-> (p a b -> p (Either t a) (Either t b)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Either t a) (Either t b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' build :: b -> s
build maybeGet :: s -> Maybe a
maybeGet = (b -> s) -> (s -> Either s a) -> Prism s s a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> s
build (\s :: s
s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall a b. a -> Either a b
Left s
s) a -> Either s a
forall a b. b -> Either a b
Right (Maybe a -> Either s a) -> Maybe a -> Either s a
forall a b. (a -> b) -> a -> b
$ s -> Maybe a
maybeGet s
s)

_Just :: Prism (Maybe a) (Maybe b) a b
_Just :: p a b -> p (Maybe a) (Maybe b)
_Just = (b -> Maybe b)
-> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Maybe b
forall a. a -> Maybe a
Just (Either (Maybe b) a
-> (a -> Either (Maybe b) a) -> Maybe a -> Either (Maybe b) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> Either (Maybe b) a
forall a b. a -> Either a b
Left Maybe b
forall a. Maybe a
Nothing) a -> Either (Maybe b) a
forall a b. b -> Either a b
Right)

_Nothing :: Prism' (Maybe a) ()
_Nothing :: p () () -> p (Maybe a) (Maybe a)
_Nothing = (() -> Maybe a)
-> (Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (Maybe () -> (a -> Maybe ()) -> Maybe a -> Maybe ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Maybe ()
forall a. a -> Maybe a
Just ()) (Maybe () -> a -> Maybe ()
forall a b. a -> b -> a
const Maybe ()
forall a. Maybe a
Nothing))

_Left :: Prism (Either a b) (Either a' b) a a'
_Left :: p a a' -> p (Either a b) (Either a' b)
_Left = (a' -> Either a' b)
-> (Either a b -> Either (Either a' b) a)
-> Prism (Either a b) (Either a' b) a a'
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism a' -> Either a' b
forall a b. a -> Either a b
Left ((a -> Either (Either a' b) a)
-> (b -> Either (Either a' b) a)
-> Either a b
-> Either (Either a' b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either (Either a' b) a
forall a b. b -> Either a b
Right (Either a' b -> Either (Either a' b) a
forall a b. a -> Either a b
Left (Either a' b -> Either (Either a' b) a)
-> (b -> Either a' b) -> b -> Either (Either a' b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a' b
forall a b. b -> Either a b
Right))

_Right :: Prism (Either a b) (Either a b') b b'
_Right :: p b b' -> p (Either a b) (Either a b')
_Right = (b' -> Either a b')
-> (Either a b -> Either (Either a b') b)
-> Prism (Either a b) (Either a b') b b'
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b' -> Either a b'
forall a b. b -> Either a b
Right ((a -> Either (Either a b') b)
-> (b -> Either (Either a b') b)
-> Either a b
-> Either (Either a b') b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b' -> Either (Either a b') b
forall a b. a -> Either a b
Left (Either a b' -> Either (Either a b') b)
-> (a -> Either a b') -> a -> Either (Either a b') b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b'
forall a b. a -> Either a b
Left) b -> Either (Either a b') b
forall a b. b -> Either a b
Right)

_Show :: (Read a, Show a) => Prism' String a
_Show :: Prism' String a
_Show = (a -> String) -> (String -> Either String a) -> Prism' String a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism a -> String
forall a. Show a => a -> String
show ((String -> Either String a) -> p a a -> p String String)
-> (String -> Either String a) -> p a a -> p String String
forall a b. (a -> b) -> a -> b
$ \s :: String
s -> case ReadS a
forall a. Read a => ReadS a
reads String
s of
  [(a :: a
a,"")] -> a -> Either String a
forall a b. b -> Either a b
Right a
a
  _ -> String -> Either String a
forall a b. a -> Either a b
Left String
s

withPrism :: forall s t a b r. Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism :: Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism l :: Prism s t a b
l f :: (b -> t) -> (s -> Either t a) -> r
f = case Market a b a b -> Market a b s t
Prism s t a b
l ((b -> b) -> (a -> Either b a) -> Market a b a b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> b
forall a. a -> a
id a -> Either b a
forall a b. b -> Either a b
Right) of
  Market g :: b -> t
g h :: s -> Either t a
h -> (b -> t) -> (s -> Either t a) -> r
f b -> t
g s -> Either t a
h

matching :: Prism s t a b -> s -> Either t a
matching :: Prism s t a b -> s -> Either t a
matching p :: Prism s t a b
p s :: s
s = Prism s t a b
-> ((b -> t) -> (s -> Either t a) -> Either t a) -> Either t a
forall s t a b r.
Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Prism s t a b
p (\_ match :: s -> Either t a
match -> s -> Either t a
match s
s)

-- outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)

-- aside :: Prism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
-- aside pr = _ . pr . _

-- without :: APrism s t a b -> APrism u v c d -> Prism (Either s u) (Either t v) (Either a c) (Either b d)

-- below :: Traversable f => APrism' s a -> Prism' (f s) (f a)
--
-- isn't :: Prism s t a b -> s -> Bool

-- matching :: APrism s t a b -> s -> Either t a