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 =
  a -> NonEmpty Text -> Value -> a
forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
SData.lookupAeson a
x NonEmpty Text
k (Value -> a) -> (ModelT f -> Value) -> ModelT f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> ModelT f -> Value
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 = LMLRoute -> ModelT f -> Maybe Note
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
modelLookupNoteByRoute LMLRoute
mr ModelT f
model
   in Value -> LMLRoute -> ModelT f -> Value
forall (f :: Type -> Type). Value -> LMLRoute -> ModelT f -> Value
getEffectiveRouteMetaWith (Value -> (Note -> Value) -> Maybe Note -> Value
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)
forall (ext :: FileType SourceExt).
R @SourceExt ext -> NonEmpty (R @SourceExt ext)
R.routeInits @'R.Yaml ((forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> R @SourceExt 'Yaml)
-> LMLRoute -> R @SourceExt 'Yaml
forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> R @SourceExt 'Yaml
coerce LMLRoute
mr)
      defaults :: [Value]
defaults = ((R @SourceExt 'Yaml -> Maybe Value)
 -> [R @SourceExt 'Yaml] -> [Value])
-> [R @SourceExt 'Yaml]
-> (R @SourceExt 'Yaml -> Maybe Value)
-> [Value]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (R @SourceExt 'Yaml -> Maybe Value)
-> [R @SourceExt 'Yaml] -> [Value]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NonEmpty (R @SourceExt 'Yaml) -> [R @SourceExt 'Yaml]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty (R @SourceExt 'Yaml)
defaultFiles) ((R @SourceExt 'Yaml -> Maybe Value) -> [Value])
-> (R @SourceExt 'Yaml -> Maybe Value) -> [Value]
forall a b. (a -> b) -> a -> b
$ \R @SourceExt 'Yaml
r -> do
        Value
v <- R @SourceExt 'Yaml -> ModelT f -> Maybe Value
forall (f :: Type -> Type).
R @SourceExt 'Yaml -> ModelT f -> Maybe Value
getYamlMeta R @SourceExt 'Yaml
r ModelT f
model
        Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Aeson.Null
        Value -> Maybe Value
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Value
v
      metas :: [Value]
metas = [Value]
defaults [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value] -> (Value -> [Value]) -> Maybe Value -> [Value]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Value]
forall a. Monoid a => a
mempty Value -> [Value]
forall x. One x => OneItem x -> x
one (Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Value
frontmatter Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Aeson.Null) Maybe () -> Maybe Value -> Maybe Value
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Value -> Maybe Value
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Value
frontmatter)
   in Value
-> (NonEmpty Value -> Value) -> Maybe (NonEmpty Value) -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null NonEmpty Value -> Value
SData.mergeAesons (Maybe (NonEmpty Value) -> Value)
-> Maybe (NonEmpty Value) -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe (NonEmpty Value)
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 =
  (SData -> Value) -> Maybe SData -> Maybe Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (SData -> Optic' A_Lens NoIx SData Value -> Value
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SData Value
sdataValue) (Maybe SData -> Maybe Value)
-> (IxSet SDataIxs SData -> Maybe SData)
-> IxSet SDataIxs SData
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxSet SDataIxs SData -> Maybe SData
forall a (ixs :: [Type]). Ord a => IxSet ixs a -> Maybe a
Ix.getOne (IxSet SDataIxs SData -> Maybe SData)
-> (IxSet SDataIxs SData -> IxSet SDataIxs SData)
-> IxSet SDataIxs SData
-> Maybe SData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @SourceExt 'Yaml -> IxSet SDataIxs SData -> IxSet SDataIxs SData
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ R @SourceExt 'Yaml
r (IxSet SDataIxs SData -> Maybe Value)
-> IxSet SDataIxs SData -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ModelT f
model ModelT f
-> Optic' A_Lens NoIx (ModelT f) (IxSet SDataIxs SData)
-> IxSet SDataIxs SData
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (ModelT f) (IxSet SDataIxs SData)
forall (encF :: Type -> Type).
Lens' (ModelT encF) (IxSet SDataIxs SData)
modelSData