{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Special Zettel links in Markdown
module Neuron.Zettelkasten.Link.View where

import Lucid
import Neuron.Zettelkasten.ID
import Neuron.Zettelkasten.Link.Action
import Neuron.Zettelkasten.Query
import Neuron.Zettelkasten.Route (Route (..))
import Neuron.Zettelkasten.Store
import Neuron.Zettelkasten.Type
import Relude
import qualified Rib

linkActionRender :: Monad m => ZettelStore -> MarkdownLink -> LinkAction -> HtmlT m ()
linkActionRender :: ZettelStore -> MarkdownLink -> LinkAction -> HtmlT m ()
linkActionRender store :: ZettelStore
store MarkdownLink {..} = \case
  LinkAction_ConnectZettel _conn :: Connection
_conn -> do
    -- The inner link text is supposed to be the zettel ID
    let zid :: ZettelID
zid = Text -> ZettelID
parseZettelID Text
markdownLinkText
    LinkTheme -> ZettelStore -> ZettelID -> HtmlT m ()
forall (m :: * -> *).
Monad m =>
LinkTheme -> ZettelStore -> ZettelID -> HtmlT m ()
renderZettelLink LinkTheme
LinkTheme_Default ZettelStore
store ZettelID
zid
  LinkAction_QueryZettels _conn :: Connection
_conn linkTheme :: LinkTheme
linkTheme q :: [Query]
q -> do
    forall (m :: * -> *). (ToHtml Text, Monad m) => Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw @Text (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ "<!--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Query] -> Text
forall b a. (Show a, IsString b) => a -> b
show [Query]
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-->"
    let zettels :: [ZettelID]
zettels = [ZettelID] -> [ZettelID]
forall a. [a] -> [a]
reverse ([ZettelID] -> [ZettelID]) -> [ZettelID] -> [ZettelID]
forall a b. (a -> b) -> a -> b
$ [ZettelID] -> [ZettelID]
forall a. Ord a => [a] -> [a]
sort ([ZettelID] -> [ZettelID]) -> [ZettelID] -> [ZettelID]
forall a b. (a -> b) -> a -> b
$ Match -> ZettelID
matchID (Match -> ZettelID) -> [Match] -> [ZettelID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZettelStore -> [Query] -> [Match]
runQuery ZettelStore
store [Query]
q
    HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
ul_ (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ do
      [ZettelID] -> (ZettelID -> HtmlT m ()) -> HtmlT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ZettelID]
zettels ((ZettelID -> HtmlT m ()) -> HtmlT m ())
-> (ZettelID -> HtmlT m ()) -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ \zid :: ZettelID
zid -> do
        HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
li_ (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ LinkTheme -> ZettelStore -> ZettelID -> HtmlT m ()
forall (m :: * -> *).
Monad m =>
LinkTheme -> ZettelStore -> ZettelID -> HtmlT m ()
renderZettelLink LinkTheme
linkTheme ZettelStore
store ZettelID
zid

renderZettelLink :: forall m. Monad m => LinkTheme -> ZettelStore -> ZettelID -> HtmlT m ()
renderZettelLink :: LinkTheme -> ZettelStore -> ZettelID -> HtmlT m ()
renderZettelLink ltheme :: LinkTheme
ltheme store :: ZettelStore
store zid :: ZettelID
zid = do
  let Zettel {..} = ZettelID -> ZettelStore -> Zettel
lookupStore ZettelID
zid ZettelStore
store
      zurl :: Text
zurl = Route ZettelStore ZettelGraph () -> Text
forall (r :: * -> *) a. IsRoute r => r a -> Text
Rib.routeUrlRel (Route ZettelStore ZettelGraph () -> Text)
-> Route ZettelStore ZettelGraph () -> Text
forall a b. (a -> b) -> a -> b
$ ZettelID -> Route ZettelStore ZettelGraph ()
Route_Zettel ZettelID
zid
      renderDefault :: ToHtml a => a -> HtmlT m ()
      renderDefault :: a -> HtmlT m ()
renderDefault linkInline :: a
linkInline = do
        [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ "zettel-link"] (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ do
          [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ "zettel-link-idlink"] (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ do
            [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ Text
zurl] (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ a -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
linkInline
          [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ "zettel-link-title"] (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ Text
zettelTitle
  case LinkTheme
ltheme of
    LinkTheme_Default -> do
      -- Special consistent styling for Zettel links
      -- Uses ZettelID as link text. Title is displayed aside.
      ZettelID -> HtmlT m ()
forall a. ToHtml a => a -> HtmlT m ()
renderDefault ZettelID
zid
    LinkTheme_WithDate -> do
      Text -> HtmlT m ()
forall a. ToHtml a => a -> HtmlT m ()
renderDefault (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ forall a. (Show a, IsString Text) => a -> Text
forall b a. (Show a, IsString b) => a -> b
show @Text (Day -> Text) -> Day -> Text
forall a b. (a -> b) -> a -> b
$ ZettelID -> Day
zettelIDDate ZettelID
zid
    LinkTheme_Simple -> do
      Text -> Text -> Text -> HtmlT m ()
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Text -> Text -> a -> HtmlT m ()
renderZettelLinkSimpleWith Text
zurl (ZettelID -> Text
unZettelID ZettelID
zid) Text
zettelTitle

-- | Render a normal looking zettel link with a custom body.
renderZettelLinkSimpleWith :: forall m a. (Monad m, ToHtml a) => Text -> Text -> a -> HtmlT m ()
renderZettelLinkSimpleWith :: Text -> Text -> a -> HtmlT m ()
renderZettelLinkSimpleWith url :: Text
url title :: Text
title body :: a
body =
  [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
class_ "zettel-link item", Text -> Attribute
href_ Text
url, Text -> Attribute
forall arg result. Term arg result => arg -> result
title_ Text
title] (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ do
    [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ "zettel-link-title"] (HtmlT m () -> HtmlT m ()) -> HtmlT m () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ do
      a -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
body