module Emanote.Model.Meta (
  lookupRouteMeta,
  getEffectiveRouteMeta,
  getEffectiveRouteMetaWith,
) where

import Data.Aeson (FromJSON)
import Data.Aeson qualified as Aeson
import Data.IxSet.Typed qualified as Ix
import Emanote.Model (ModelT, modelLookupNoteByRoute, modelSData)
import Emanote.Model.Note (_noteMeta)
import Emanote.Model.SData (sdataValue)
import Emanote.Model.SData qualified as SData
import Emanote.Route qualified as R
import Optics.Operators as Lens ((^.))
import Relude

-- | Look up a specific key in the meta for a given route.
lookupRouteMeta :: FromJSON a => a -> NonEmpty Text -> R.LMLRoute -> ModelT f -> a
lookupRouteMeta :: forall a (f :: Type -> Type).
FromJSON a =>
a -> NonEmpty Text -> LMLRoute -> ModelT f -> a
lookupRouteMeta a
x NonEmpty Text
k LMLRoute
r =
  forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
SData.lookupAeson a
x NonEmpty Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type). LMLRoute -> ModelT f -> Value
getEffectiveRouteMeta LMLRoute
r

{- | Get the (final) metadata of a note at the given route, by merging it with
 the defaults specified in parent routes all the way upto index.yaml.
-}
getEffectiveRouteMeta :: R.LMLRoute -> ModelT f -> Aeson.Value
getEffectiveRouteMeta :: forall (f :: Type -> Type). LMLRoute -> ModelT f -> Value
getEffectiveRouteMeta LMLRoute
mr ModelT f
model =
  let mNote :: Maybe Note
mNote = forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
modelLookupNoteByRoute LMLRoute
mr ModelT f
model
   in forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
getEffectiveRouteMetaWith (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null Note -> Value
_noteMeta Maybe Note
mNote) LMLRoute
mr ModelT f
model

getEffectiveRouteMetaWith :: Aeson.Value -> R.LMLRoute -> ModelT f -> Aeson.Value
getEffectiveRouteMetaWith :: forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
getEffectiveRouteMetaWith Value
frontmatter LMLRoute
mr ModelT f
model =
  let defaultFiles :: NonEmpty (R @SourceExt 'Yaml)
defaultFiles = forall {a} (ext :: FileType a). R @a ext -> NonEmpty (R @a ext)
R.routeInits @('R.Yaml) (forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute coerce :: forall a b. Coercible @Type a b => a -> b
coerce LMLRoute
mr)
      defaults :: [Value]
defaults = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty (R @SourceExt 'Yaml)
defaultFiles) forall a b. (a -> b) -> a -> b
$ \R @SourceExt 'Yaml
r -> do
        Value
v <- forall (f :: Type -> Type).
R @SourceExt 'Yaml -> ModelT f -> Maybe Value
getYamlMeta R @SourceExt 'Yaml
r ModelT f
model
        forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Value
v forall a. Eq a => a -> a -> Bool
/= Value
Aeson.Null
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Value
v
      metas :: [Value]
metas = [Value]
defaults forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall x. One x => OneItem x -> x
one (forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Value
frontmatter forall a. Eq a => a -> a -> Bool
/= Value
Aeson.Null) forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Value
frontmatter)
   in forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null NonEmpty Value -> Value
SData.mergeAesons forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Value]
metas

getYamlMeta :: R.R 'R.Yaml -> ModelT f -> Maybe Aeson.Value
getYamlMeta :: forall (f :: Type -> Type).
R @SourceExt 'Yaml -> ModelT f -> Maybe Value
getYamlMeta R @SourceExt 'Yaml
r ModelT f
model =
  forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' SData Value
sdataValue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ixs :: [Type]). Ord a => IxSet ixs a -> Maybe a
Ix.getOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ R @SourceExt 'Yaml
r forall a b. (a -> b) -> a -> b
$ ModelT f
model forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type).
Lens' (ModelT encF) (IxSet SDataIxs SData)
modelSData