module Emanote.Model.Link.Resolve where

import Commonmark.Extensions.WikiLink qualified as WL
import Emanote.Model.Link.Rel qualified as Rel
import Emanote.Model.Note qualified as MN
import Emanote.Model.StaticFile qualified as SF
import Emanote.Model.Type (Model)
import Emanote.Model.Type qualified as M
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute qualified as SR
import Relude

resolveUnresolvedRelTarget ::
  Model ->
  Rel.UnresolvedRelTarget ->
  Rel.ResolvedRelTarget SR.SiteRoute
resolveUnresolvedRelTarget :: Model -> UnresolvedRelTarget -> ResolvedRelTarget SiteRoute
resolveUnresolvedRelTarget Model
model = \case
  Rel.URTWikiLink (WikiLinkType
_wlType, WikiLink
wl) -> do
    Model -> WikiLink -> ResolvedRelTarget (Either Note StaticFile)
resolveWikiLinkMustExist Model
model WikiLink
wl
      forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Either Note StaticFile -> SiteRoute
resourceSiteRoute
  Rel.URTResource ModelRoute
r ->
    Model -> ModelRoute -> ResolvedRelTarget (Either Note StaticFile)
resolveModelRoute Model
model ModelRoute
r
      forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Either Note StaticFile -> SiteRoute
resourceSiteRoute
  Rel.URTVirtual VirtualRoute
virtualRoute -> do
    forall a. a -> ResolvedRelTarget a
Rel.RRTFound forall a b. (a -> b) -> a -> b
$
      VirtualRoute -> SiteRoute
SR.SiteRoute_VirtualRoute
        VirtualRoute
virtualRoute

resolveWikiLinkMustExist ::
  Model -> WL.WikiLink -> Rel.ResolvedRelTarget (Either MN.Note SF.StaticFile)
resolveWikiLinkMustExist :: Model -> WikiLink -> ResolvedRelTarget (Either Note StaticFile)
resolveWikiLinkMustExist Model
model WikiLink
wl =
  forall a. [a] -> ResolvedRelTarget a
Rel.resolvedRelTargetFromCandidates forall a b. (a -> b) -> a -> b
$ WikiLink -> Model -> [Either Note StaticFile]
M.modelWikiLinkTargets WikiLink
wl Model
model

resolveModelRoute ::
  Model -> R.ModelRoute -> Rel.ResolvedRelTarget (Either MN.Note SF.StaticFile)
resolveModelRoute :: Model -> ModelRoute -> ResolvedRelTarget (Either Note StaticFile)
resolveModelRoute Model
model ModelRoute
lr =
  forall (t :: Type -> Type -> Type) (f :: Type -> Type) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
    (forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
`M.modelLookupNoteByRoute` Model
model)
    (forall (f :: Type -> Type).
R @SourceExt 'AnyExt -> ModelT f -> Maybe StaticFile
`M.modelLookupStaticFileByRoute` Model
model)
    (ModelRoute -> Either LMLRoute (R @SourceExt 'AnyExt)
R.modelRouteCase ModelRoute
lr)
    forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ResolvedRelTarget a
Rel.RRTMissing forall a. a -> ResolvedRelTarget a
Rel.RRTFound

resourceSiteRoute :: Either MN.Note SF.StaticFile -> SR.SiteRoute
resourceSiteRoute :: Either Note StaticFile -> SiteRoute
resourceSiteRoute =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Note -> SiteRoute
SR.noteFileSiteRoute StaticFile -> SiteRoute
SR.staticFileSiteRoute