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 {forall (prefix :: Symbol) r. FolderRoute prefix r -> r
unFolderRoute :: r}
  deriving newtype (FolderRoute prefix r -> FolderRoute prefix r -> Bool
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, 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
Ord, 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 :: forall x. 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 :: forall x. 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) = forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy @k t
Proxy @prefix) forall a. Semigroup a => a -> a -> a
<> String
"/:" forall a. Semigroup a => a -> a -> a
<> 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 = forall (prefix :: Symbol) r.
KnownSymbol prefix =>
(RouteModel r -> Prism_ String r)
-> RouteModel r -> Prism_ String (FolderRoute prefix r)
prefixRoutePrism @prefix @r forall a b. (a -> b) -> a -> b
$ 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 = forall (prefix :: Symbol) r. r -> FolderRoute prefix r
FolderRoute forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. IsRoute r => RouteModel r -> [r]
routeUniverse @r RouteModel (FolderRoute prefix r)
m

instance (EmaStaticSite r, KnownSymbol prefix) => EmaSite (FolderRoute prefix r) where
  type SiteArg (FolderRoute prefix r) = SiteArg r
  siteInput :: forall (m :: Type -> Type).
(MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action
-> SiteArg (FolderRoute prefix r)
-> m (Dynamic m (RouteModel (FolderRoute prefix r)))
siteInput Some @Type Action
cliAct =
    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 :: forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
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 =
    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 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
% forall a s. Coercible @Type s a => Iso' s a
coercedTo) RouteModel (FolderRoute prefix r)
m (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 :: forall (prefix :: Symbol) r.
KnownSymbol prefix =>
(RouteModel r -> Prism_ String r)
-> RouteModel r -> Prism_ String (FolderRoute prefix r)
prefixRoutePrism =
  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
    (forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (String
prefix </>) String -> Maybe String
stripPrefix)
    forall a s. Coercible @Type s a => Iso' s a
coercedTo
    forall a. a -> a
id
  where
    prefix :: String
prefix = forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy @k t
Proxy @prefix)
    stripPrefix :: String -> Maybe String
stripPrefix =
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
T.stripPrefix (forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ String
prefix forall a. Semigroup a => a -> a -> a
<> String
"/") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText