{-# LANGUAGE DeriveAnyClass #-}

module Emanote.View.Export (
  renderGraphExport,
  Link (..),
  modelRels,
) where

import Data.Aeson (ToJSON)
import Data.Aeson qualified as Aeson
import Data.Map.Strict qualified as Map
import Emanote.Model (Model)
import Emanote.Model qualified as M
import Emanote.Model.Graph qualified as G
import Emanote.Model.Link.Rel qualified as Rel
import Emanote.Model.Link.Resolve qualified as Resolve
import Emanote.Model.Title qualified as Tit
import Emanote.Route (LMLRoute)
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute qualified as SR
import Emanote.Route.SiteRoute.Class (lmlSiteRoute)
import Optics.Operators ((^.))
import Relude

data Export = Export
  { Export -> Word
version :: Word
  , Export -> Map Text SourceFile
files :: Map Text SourceFile
  }
  deriving stock (forall x. Rep Export x -> Export
forall x. Export -> Rep Export x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Export x -> Export
$cfrom :: forall x. Export -> Rep Export x
Generic, Int -> Export -> ShowS
[Export] -> ShowS
Export -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Export] -> ShowS
$cshowList :: [Export] -> ShowS
show :: Export -> FilePath
$cshow :: Export -> FilePath
showsPrec :: Int -> Export -> ShowS
$cshowsPrec :: Int -> Export -> ShowS
Show)
  deriving anyclass ([Export] -> Encoding
[Export] -> Value
Export -> Encoding
Export -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Export] -> Encoding
$ctoEncodingList :: [Export] -> Encoding
toJSONList :: [Export] -> Value
$ctoJSONList :: [Export] -> Value
toEncoding :: Export -> Encoding
$ctoEncoding :: Export -> Encoding
toJSON :: Export -> Value
$ctoJSON :: Export -> Value
ToJSON)

currentVersion :: Word
currentVersion :: Word
currentVersion = Word
1

-- | A source file in `Model`
data SourceFile = SourceFile
  { SourceFile -> Text
title :: Text
  , SourceFile -> Text
filePath :: Text
  , SourceFile -> Maybe Text
parentNote :: Maybe Text
  , SourceFile -> Text
url :: Text
  , SourceFile -> Value
meta :: Aeson.Value
  , SourceFile -> [Link]
links :: [Link]
  }
  deriving stock (forall x. Rep SourceFile x -> SourceFile
forall x. SourceFile -> Rep SourceFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceFile x -> SourceFile
$cfrom :: forall x. SourceFile -> Rep SourceFile x
Generic, Int -> SourceFile -> ShowS
[SourceFile] -> ShowS
SourceFile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SourceFile] -> ShowS
$cshowList :: [SourceFile] -> ShowS
show :: SourceFile -> FilePath
$cshow :: SourceFile -> FilePath
showsPrec :: Int -> SourceFile -> ShowS
$cshowsPrec :: Int -> SourceFile -> ShowS
Show)
  deriving anyclass ([SourceFile] -> Encoding
[SourceFile] -> Value
SourceFile -> Encoding
SourceFile -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SourceFile] -> Encoding
$ctoEncodingList :: [SourceFile] -> Encoding
toJSONList :: [SourceFile] -> Value
$ctoJSONList :: [SourceFile] -> Value
toEncoding :: SourceFile -> Encoding
$ctoEncoding :: SourceFile -> Encoding
toJSON :: SourceFile -> Value
$ctoJSON :: SourceFile -> Value
ToJSON)

data Link = Link
  { Link -> UnresolvedRelTarget
unresolvedRelTarget :: Rel.UnresolvedRelTarget
  , Link -> ResolvedRelTarget Text
resolvedRelTarget :: Rel.ResolvedRelTarget Text
  }
  deriving stock (forall x. Rep Link x -> Link
forall x. Link -> Rep Link x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Link x -> Link
$cfrom :: forall x. Link -> Rep Link x
Generic, Link -> Link -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq, Eq Link
Link -> Link -> Bool
Link -> Link -> Ordering
Link -> Link -> Link
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
min :: Link -> Link -> Link
$cmin :: Link -> Link -> Link
max :: Link -> Link -> Link
$cmax :: Link -> Link -> Link
>= :: Link -> Link -> Bool
$c>= :: Link -> Link -> Bool
> :: Link -> Link -> Bool
$c> :: Link -> Link -> Bool
<= :: Link -> Link -> Bool
$c<= :: Link -> Link -> Bool
< :: Link -> Link -> Bool
$c< :: Link -> Link -> Bool
compare :: Link -> Link -> Ordering
$ccompare :: Link -> Link -> Ordering
Ord, Int -> Link -> ShowS
[Link] -> ShowS
Link -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> FilePath
$cshow :: Link -> FilePath
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show)
  deriving anyclass ([Link] -> Encoding
[Link] -> Value
Link -> Encoding
Link -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Link] -> Encoding
$ctoEncodingList :: [Link] -> Encoding
toJSONList :: [Link] -> Value
$ctoJSONList :: [Link] -> Value
toEncoding :: Link -> Encoding
$ctoEncoding :: Link -> Encoding
toJSON :: Link -> Value
$ctoJSON :: Link -> Value
ToJSON)

renderGraphExport :: Model -> LByteString
renderGraphExport :: Model -> LByteString
renderGraphExport Model
model =
  let notes_ :: Map Text SourceFile
notes_ =
        Model -> Map LMLRoute (Title, LMLRoute, Value)
M.modelNoteMetas Model
model
          forall a b. a -> (a -> b) -> b
& forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys LMLRoute -> Text
lmlRouteKey
          forall a b. a -> (a -> b) -> b
& forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
            ( \(Title
tit, LMLRoute
r, Value
meta_) ->
                let k :: Text
k = LMLRoute -> Text
lmlRouteKey LMLRoute
r
                 in Text -> Text -> Maybe Text -> Text -> Value -> [Link] -> SourceFile
SourceFile
                      (Title -> Text
Tit.toPlain Title
tit)
                      Text
k
                      (forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> FilePath
lmlSourcePath forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Model -> LMLRoute -> Maybe LMLRoute
G.parentLmlRoute Model
model LMLRoute
r)
                      (HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
lmlSiteRoute LMLRoute
r)
                      Value
meta_
                      (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text [Link]
rels)
            )
      rels :: Map Text [Link]
rels = Model -> Map LMLRoute [Link]
modelRels Model
model forall a b. a -> (a -> b) -> b
& forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys LMLRoute -> Text
lmlRouteKey
      export :: Export
export = Word -> Map Text SourceFile -> Export
Export Word
currentVersion Map Text SourceFile
notes_
   in forall a. ToJSON a => a -> LByteString
Aeson.encode Export
export

modelRels :: Model -> Map LMLRoute [Link]
modelRels :: Model -> Map LMLRoute [Link]
modelRels Model
model =
  forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$
    Model -> [Rel]
M.modelNoteRels Model
model forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Rel
rel ->
      let from_ :: LMLRoute
from_ = Rel
rel forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Rel LMLRoute
Rel.relFrom
          to_ :: UnresolvedRelTarget
to_ = Rel
rel forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Rel UnresolvedRelTarget
Rel.relTo
          toTarget :: ResolvedRelTarget Text
toTarget =
            Model -> UnresolvedRelTarget -> ResolvedRelTarget SiteRoute
Resolve.resolveUnresolvedRelTarget Model
model UnresolvedRelTarget
to_
              forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrlStatic Model
model
       in (LMLRoute
from_, forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ UnresolvedRelTarget -> ResolvedRelTarget Text -> Link
Link UnresolvedRelTarget
to_ ResolvedRelTarget Text
toTarget)

-- An unique key to represent this LMLRoute in the exported JSON
--
-- We use the source path consistently.
lmlRouteKey :: LMLRoute -> Text
lmlRouteKey :: LMLRoute -> Text
lmlRouteKey =
  forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute

-- Path of the LML note
lmlSourcePath :: LMLRoute -> FilePath
lmlSourcePath :: LMLRoute -> FilePath
lmlSourcePath =
  forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute