module Ema.Route.Prism (
  module X,

  -- * Handy encoders
  eitherRoutePrism,

  -- * Handy lenses
  htmlSuffixPrism,
  stringIso,
  showReadPrism,
) where

import Data.Text qualified as T
import Ema.Route.Prism.Check as X
import Ema.Route.Prism.Type as X
import Optics.Core (Iso', Prism', iso, preview, prism', review)

stringIso :: (ToString a, IsString a) => Iso' String a
stringIso :: Iso' String a
stringIso = (String -> a) -> (a -> String) -> Iso' String a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso String -> a
forall a. IsString a => String -> a
fromString a -> String
forall a. ToString a => a -> String
toString

showReadPrism :: (Show a, Read a) => Prism' String a
showReadPrism :: Prism' String a
showReadPrism = (a -> String) -> (String -> Maybe a) -> Prism' String a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> String
forall b a. (Show a, IsString b) => a -> b
show String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe

htmlSuffixPrism :: Prism' FilePath FilePath
htmlSuffixPrism :: Prism' String String
htmlSuffixPrism = (String -> String)
-> (String -> Maybe String) -> Prism' String String
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".html") ((Text -> String) -> Maybe Text -> Maybe String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
forall a. ToString a => a -> String
toString (Maybe Text -> Maybe String)
-> (String -> Maybe Text) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
T.stripSuffix Text
".html" (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText)

{- | Returns a new route `Prism_` that supports *either* of the input routes.

  The resulting route `Prism_`'s model type becomes the *product* of the input models.
-}
eitherRoutePrism ::
  (a -> Prism_ FilePath r1) ->
  (b -> Prism_ FilePath r2) ->
  ((a, b) -> Prism_ FilePath (Either r1 r2))
eitherRoutePrism :: (a -> Prism_ String r1)
-> (b -> Prism_ String r2)
-> (a, b)
-> Prism_ String (Either r1 r2)
eitherRoutePrism a -> Prism_ String r1
enc1 b -> Prism_ String r2
enc2 (a
m1, b
m2) =
  Prism' String (Either r1 r2) -> Prism_ String (Either r1 r2)
forall s a. Prism' s a -> Prism_ s a
toPrism_ (Prism' String (Either r1 r2) -> Prism_ String (Either r1 r2))
-> Prism' String (Either r1 r2) -> Prism_ String (Either r1 r2)
forall a b. (a -> b) -> a -> b
$ Prism' String r1
-> Prism' String r2 -> Prism' String (Either r1 r2)
forall a b.
Prism' String a -> Prism' String b -> Prism' String (Either a b)
eitherPrism (Prism_ String r1 -> Prism' String r1
forall s a. Prism_ s a -> Prism' s a
fromPrism_ (Prism_ String r1 -> Prism' String r1)
-> Prism_ String r1 -> Prism' String r1
forall a b. (a -> b) -> a -> b
$ a -> Prism_ String r1
enc1 a
m1) (Prism_ String r2 -> Prism' String r2
forall s a. Prism_ s a -> Prism' s a
fromPrism_ (Prism_ String r2 -> Prism' String r2)
-> Prism_ String r2 -> Prism' String r2
forall a b. (a -> b) -> a -> b
$ b -> Prism_ String r2
enc2 b
m2)

{- | Given two @Prism'@'s whose filepaths are distinct (ie., both @a@ and @b@
 encode to distinct filepaths), return a new @Prism'@ that combines both.

 If this distinctness property does not hold between the input @Prism'@'s, then
 the resulting @Prism'@ will not be lawful.
-}
eitherPrism :: Prism' FilePath a -> Prism' FilePath b -> Prism' FilePath (Either a b)
eitherPrism :: Prism' String a -> Prism' String b -> Prism' String (Either a b)
eitherPrism Prism' String a
p1 Prism' String b
p2 =
  (Either a b -> String)
-> (String -> Maybe (Either a b)) -> Prism' String (Either a b)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    ( (a -> String) -> (b -> String) -> Either a b -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (Prism' String a -> a -> String
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Prism' String a
p1)
        (Prism' String b -> b -> String
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Prism' String b
p2)
    )
    ( \String
fp ->
        [Maybe (Either a b)] -> Maybe (Either a b)
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Maybe a -> Maybe (Either a b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Prism' String a -> String -> Maybe a
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Prism' String a
p1 String
fp
          , b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Maybe b -> Maybe (Either a b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Prism' String b -> String -> Maybe b
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Prism' String b
p2 String
fp
          ]
    )