module Ema.Route.Prism.Type where

import Optics.Core (A_Prism, Is, NoIx, Optic', Prism', castOptic, preview, prism', review, (%))

--  DerivingVia prevents us from directly using Prism' here
--  https://stackoverflow.com/q/71489589/55246

{- | Isomorphic to @Prism' s a@, but coercion-friendly.

 Use `fromPrism_` and `toPrism_` to convert between the optics @Prism'@ and this
 @Prism_@.
-}
type Prism_ s a = (a -> s, s -> Maybe a)

-- | Convert a `Prism_` to a @Prism'@.
fromPrism_ :: Prism_ s a -> Prism' s a
fromPrism_ :: forall s a. Prism_ s a -> Prism' s a
fromPrism_ = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'

-- | Convert a @Prism'@ to a `Prism_`.
toPrism_ :: Prism' s a -> Prism_ s a
toPrism_ :: forall s a. Prism' s a -> Prism_ s a
toPrism_ = forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview

-- | map over the filepath, route and model of the given route prism.
mapRoutePrism ::
  (pr `Is` A_Prism, pf `Is` A_Prism) =>
  -- | How to transform the encoded `FilePath`
  Optic' pf NoIx FilePath FilePath ->
  -- | How to transform the decode route
  Optic' pr NoIx r1 r2 ->
  -- | How to transform (contramap) the resultant model
  (b -> a) ->
  -- | The route prism to fmap.
  (a -> Prism_ FilePath r1) ->
  (b -> Prism_ FilePath r2)
mapRoutePrism :: forall pr pf r1 r2 b a.
(Is pr A_Prism, Is pf A_Prism) =>
Optic' pf NoIx FilePath FilePath
-> Optic' pr NoIx r1 r2
-> (b -> a)
-> (a -> Prism_ FilePath r1)
-> b
-> Prism_ FilePath r2
mapRoutePrism (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic -> Optic A_Prism NoIx FilePath FilePath FilePath FilePath
fp) (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic -> Optic A_Prism NoIx r1 r1 r2 r2
rp) b -> a
m a -> Prism_ FilePath r1
enc =
  forall s a. Prism' s a -> Prism_ s a
toPrism_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c d x y.
Prism' b a
-> Prism' c d -> (y -> x) -> (x -> Prism' a c) -> y -> Prism' b d
cpmap Optic A_Prism NoIx FilePath FilePath FilePath FilePath
fp Optic A_Prism NoIx r1 r1 r2 r2
rp b -> a
m (forall s a. Prism_ s a -> Prism' s a
fromPrism_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Prism_ FilePath r1
enc)
  where
    cpmap ::
      forall a b c d x y.
      Prism' b a ->
      Prism' c d ->
      (y -> x) ->
      (x -> Prism' a c) ->
      (y -> Prism' b d)
    cpmap :: forall a b c d x y.
Prism' b a
-> Prism' c d -> (y -> x) -> (x -> Prism' a c) -> y -> Prism' b d
cpmap Prism' b a
p Prism' c d
q y -> x
f x -> Prism' a c
r y
x =
      Prism' b a
p forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% x -> Prism' a c
r (y -> x
f y
x) forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Prism' c d
q