module Ema.Route.Lib.Folder (
  FolderRoute (FolderRoute, unFolderRoute),
  prefixRoutePrism,
) where

import Data.Text qualified as T
import Ema.Route.Class (IsRoute (..))
import Ema.Route.Prism (Prism_, mapRoutePrism)
import Ema.Site (EmaSite (..), EmaStaticSite)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Optics.Core (coercedTo, prism', (%))
import System.FilePath ((</>))
import Text.Show (Show (show))

-- | A route that is prefixed at some URL prefix
newtype FolderRoute (prefix :: Symbol) r = FolderRoute {FolderRoute prefix r -> r
unFolderRoute :: r}
  deriving newtype (FolderRoute prefix r -> FolderRoute prefix r -> Bool
(FolderRoute prefix r -> FolderRoute prefix r -> Bool)
-> (FolderRoute prefix r -> FolderRoute prefix r -> Bool)
-> Eq (FolderRoute prefix r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (prefix :: Symbol) r.
Eq r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
/= :: FolderRoute prefix r -> FolderRoute prefix r -> Bool
$c/= :: forall (prefix :: Symbol) r.
Eq r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
== :: FolderRoute prefix r -> FolderRoute prefix r -> Bool
$c== :: forall (prefix :: Symbol) r.
Eq r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
Eq, Eq (FolderRoute prefix r)
Eq (FolderRoute prefix r)
-> (FolderRoute prefix r -> FolderRoute prefix r -> Ordering)
-> (FolderRoute prefix r -> FolderRoute prefix r -> Bool)
-> (FolderRoute prefix r -> FolderRoute prefix r -> Bool)
-> (FolderRoute prefix r -> FolderRoute prefix r -> Bool)
-> (FolderRoute prefix r -> FolderRoute prefix r -> Bool)
-> (FolderRoute prefix r
    -> FolderRoute prefix r -> FolderRoute prefix r)
-> (FolderRoute prefix r
    -> FolderRoute prefix r -> FolderRoute prefix r)
-> Ord (FolderRoute prefix r)
FolderRoute prefix r -> FolderRoute prefix r -> Bool
FolderRoute prefix r -> FolderRoute prefix r -> Ordering
FolderRoute prefix r
-> FolderRoute prefix r -> FolderRoute prefix r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {prefix :: Symbol} {r}. Ord r => Eq (FolderRoute prefix r)
forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Ordering
forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r
-> FolderRoute prefix r -> FolderRoute prefix r
min :: FolderRoute prefix r
-> FolderRoute prefix r -> FolderRoute prefix r
$cmin :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r
-> FolderRoute prefix r -> FolderRoute prefix r
max :: FolderRoute prefix r
-> FolderRoute prefix r -> FolderRoute prefix r
$cmax :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r
-> FolderRoute prefix r -> FolderRoute prefix r
>= :: FolderRoute prefix r -> FolderRoute prefix r -> Bool
$c>= :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
> :: FolderRoute prefix r -> FolderRoute prefix r -> Bool
$c> :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
<= :: FolderRoute prefix r -> FolderRoute prefix r -> Bool
$c<= :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
< :: FolderRoute prefix r -> FolderRoute prefix r -> Bool
$c< :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Bool
compare :: FolderRoute prefix r -> FolderRoute prefix r -> Ordering
$ccompare :: forall (prefix :: Symbol) r.
Ord r =>
FolderRoute prefix r -> FolderRoute prefix r -> Ordering
$cp1Ord :: forall {prefix :: Symbol} {r}. Ord r => Eq (FolderRoute prefix r)
Ord, Rep (FolderRoute prefix r) x -> FolderRoute prefix r
FolderRoute prefix r -> Rep (FolderRoute prefix r) x
(forall x. FolderRoute prefix r -> Rep (FolderRoute prefix r) x)
-> (forall x. Rep (FolderRoute prefix r) x -> FolderRoute prefix r)
-> Generic (FolderRoute prefix r)
forall x. Rep (FolderRoute prefix r) x -> FolderRoute prefix r
forall x. FolderRoute prefix r -> Rep (FolderRoute prefix r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (prefix :: Symbol) r x.
Generic r =>
Rep (FolderRoute prefix r) x -> FolderRoute prefix r
forall (prefix :: Symbol) r x.
Generic r =>
FolderRoute prefix r -> Rep (FolderRoute prefix r) x
to :: Rep (FolderRoute prefix r) x -> FolderRoute prefix r
$cto :: forall (prefix :: Symbol) r x.
Generic r =>
Rep (FolderRoute prefix r) x -> FolderRoute prefix r
from :: FolderRoute prefix r -> Rep (FolderRoute prefix r) x
$cfrom :: forall (prefix :: Symbol) r x.
Generic r =>
FolderRoute prefix r -> Rep (FolderRoute prefix r) x
Generic)

instance (Show r, KnownSymbol prefix) => Show (FolderRoute prefix r) where
  show :: FolderRoute prefix r -> String
show (FolderRoute r
r) = Proxy @Symbol prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy @Symbol prefix
forall {k} (t :: k). Proxy @k t
Proxy @prefix) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> r -> String
forall a. Show a => a -> String
Text.Show.show r
r

instance (IsRoute r, KnownSymbol prefix) => IsRoute (FolderRoute prefix r) where
  type RouteModel (FolderRoute prefix r) = RouteModel r
  routePrism :: RouteModel (FolderRoute prefix r)
-> Prism_ String (FolderRoute prefix r)
routePrism = KnownSymbol prefix =>
(RouteModel r -> Prism_ String r)
-> RouteModel r -> Prism_ String (FolderRoute prefix r)
forall (prefix :: Symbol) r.
KnownSymbol prefix =>
(RouteModel r -> Prism_ String r)
-> RouteModel r -> Prism_ String (FolderRoute prefix r)
prefixRoutePrism @prefix @r ((RouteModel r -> Prism_ String r)
 -> RouteModel r -> Prism_ String (FolderRoute prefix r))
-> (RouteModel r -> Prism_ String r)
-> RouteModel r
-> Prism_ String (FolderRoute prefix r)
forall a b. (a -> b) -> a -> b
$ IsRoute r => RouteModel r -> Prism_ String r
forall r. IsRoute r => RouteModel r -> Prism_ String r
routePrism @r
  routeUniverse :: RouteModel (FolderRoute prefix r) -> [FolderRoute prefix r]
routeUniverse RouteModel (FolderRoute prefix r)
m = r -> FolderRoute prefix r
forall (prefix :: Symbol) r. r -> FolderRoute prefix r
FolderRoute (r -> FolderRoute prefix r) -> [r] -> [FolderRoute prefix r]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> RouteModel r -> [r]
forall r. IsRoute r => RouteModel r -> [r]
routeUniverse @r RouteModel r
RouteModel (FolderRoute prefix r)
m

instance (EmaStaticSite r, KnownSymbol prefix) => EmaSite (FolderRoute prefix r) where
  type SiteArg (FolderRoute prefix r) = SiteArg r
  siteInput :: Some @Type Action
-> SiteArg (FolderRoute prefix r)
-> m (Dynamic m (RouteModel (FolderRoute prefix r)))
siteInput Some @Type Action
cliAct =
    Some @Type Action -> SiteArg r -> m (Dynamic m (RouteModel r))
forall r (m :: Type -> Type).
(EmaSite r, MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action -> SiteArg r -> m (Dynamic m (RouteModel r))
siteInput @r Some @Type Action
cliAct
  siteOutput :: Prism' String (FolderRoute prefix r)
-> RouteModel (FolderRoute prefix r)
-> FolderRoute prefix r
-> m (SiteOutput (FolderRoute prefix r))
siteOutput Prism' String (FolderRoute prefix r)
rp RouteModel (FolderRoute prefix r)
m FolderRoute prefix r
r =
    Prism' String r -> RouteModel r -> r -> m (SiteOutput r)
forall r (m :: Type -> Type).
(EmaSite r, MonadIO m, MonadLoggerIO m) =>
Prism' String r -> RouteModel r -> r -> m (SiteOutput r)
siteOutput @r (Prism' String (FolderRoute prefix r)
rp Prism' String (FolderRoute prefix r)
-> Optic
     An_Iso NoIx (FolderRoute prefix r) (FolderRoute prefix r) r r
-> Prism' String r
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
% Optic An_Iso NoIx (FolderRoute prefix r) (FolderRoute prefix r) r r
forall a s. Coercible @Type s a => Iso' s a
coercedTo) RouteModel r
RouteModel (FolderRoute prefix r)
m (FolderRoute prefix r -> r
forall (prefix :: Symbol) r. FolderRoute prefix r -> r
unFolderRoute FolderRoute prefix r
r)

-- | Prefix the encoding of the given route prism.
prefixRoutePrism ::
  forall prefix r.
  KnownSymbol prefix =>
  (RouteModel r -> Prism_ FilePath r) ->
  (RouteModel r -> Prism_ FilePath (FolderRoute prefix r))
prefixRoutePrism :: (RouteModel r -> Prism_ String r)
-> RouteModel r -> Prism_ String (FolderRoute prefix r)
prefixRoutePrism =
  Optic' A_Prism NoIx String String
-> Optic' An_Iso NoIx r (FolderRoute prefix r)
-> (RouteModel r -> RouteModel r)
-> (RouteModel r -> Prism_ String r)
-> RouteModel r
-> Prism_ String (FolderRoute prefix r)
forall pr pf r1 r2 b a.
(Is pr A_Prism, Is pf A_Prism) =>
Optic' pf NoIx String String
-> Optic' pr NoIx r1 r2
-> (b -> a)
-> (a -> Prism_ String r1)
-> b
-> Prism_ String r2
mapRoutePrism
    (ShowS
-> (String -> Maybe String) -> Optic' A_Prism NoIx String String
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (String
prefix String -> ShowS
</>) String -> Maybe String
stripPrefix)
    Optic' An_Iso NoIx r (FolderRoute prefix r)
forall a s. Coercible @Type s a => Iso' s a
coercedTo
    RouteModel r -> RouteModel r
forall a. a -> a
id
  where
    prefix :: String
prefix = Proxy @Symbol prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy @Symbol prefix
forall {k} (t :: k). Proxy @k t
Proxy @prefix)
    stripPrefix :: String -> Maybe String
stripPrefix =
      (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.stripPrefix (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/") (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