Action.hs

{-# 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.Action where

import Control.Foldl (Fold (..))
import qualified Data.Set as Set
import Neuron.Zettelkasten.ID
import Neuron.Zettelkasten.Query
import Neuron.Zettelkasten.Store
import Relude
import Text.MMark (MMark, runScanner)
import qualified Text.MMark.Extension as Ext
import Text.MMark.Extension (Inline (..))
import qualified Text.URI as URI

data LinkTheme
  = LinkTheme_Default
  | LinkTheme_Simple
  | LinkTheme_WithDate
  deriving (Eq, Show, Ord)

data LinkAction
  = LinkAction_ConnectZettel Connection
  | -- | Render a list (or should it be tree?) of links to queries zettels
    -- TODO: Should this automatically establish a connection in graph??
    LinkAction_QueryZettels Connection LinkTheme [Query]
  deriving (Eq, Show)

linkActionFromUri :: URI.URI -> Maybe LinkAction
linkActionFromUri uri =
  -- NOTE: We should probably drop the 'cf' variants in favour of specifying
  -- the connection type as a query param or something.
  case fmap URI.unRText (URI.uriScheme uri) of
    Just "z" ->
      Just $ LinkAction_ConnectZettel Folgezettel
    Just "zcf" ->
      Just $ LinkAction_ConnectZettel OrdinaryConnection
    Just "zquery" ->
      Just $ LinkAction_QueryZettels Folgezettel (fromMaybe LinkTheme_Default $ linkThemeFromUri uri) (queryFromUri uri)
    Just "zcfquery" ->
      Just $ LinkAction_QueryZettels OrdinaryConnection (fromMaybe LinkTheme_Default $ linkThemeFromUri uri) (queryFromUri uri)
    _ ->
      Nothing

queryFromUri :: URI.URI -> [Query]
queryFromUri uri =
  flip mapMaybe (URI.uriQuery uri) $ \case
    URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
      case key of
        "tag" -> Just $ ByTag val
        _ -> Nothing
    _ -> Nothing

linkThemeFromUri :: URI.URI -> Maybe LinkTheme
linkThemeFromUri uri =
  listToMaybe $ flip mapMaybe (URI.uriQuery uri) $ \case
    URI.QueryFlag _ -> Nothing
    URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
      case key of
        "linkTheme" ->
          case val of
            "default" -> Just LinkTheme_Default
            "simple" -> Just LinkTheme_Simple
            "withDate" -> Just LinkTheme_WithDate
            _ -> error $ "Unknown link theme: " <> val
        _ -> Nothing

data MarkdownLink
  = MarkdownLink
      { markdownLinkText :: Text,
        markdownLinkUri :: URI.URI
      }
  deriving (Eq, Ord)

linkActionConnections :: ZettelStore -> MarkdownLink -> [ZettelConnection]
linkActionConnections store MarkdownLink {..} =
  case linkActionFromUri markdownLinkUri of
    Just (LinkAction_ConnectZettel conn) ->
      let zid = parseZettelID markdownLinkText
       in [(conn, zid)]
    Just (LinkAction_QueryZettels conn _linkTheme q) ->
      (conn,) . matchID <$> runQuery store q
    Nothing ->
      []

-- | Extract all links from the Markdown document
extractLinks :: MMark -> [MarkdownLink]
extractLinks = Set.toList . Set.fromList . flip runScanner (Fold go [] id)
  where
    go acc blk = acc <> concat (fmap f (relevantInlines blk))
    f = \case
      Link inner uri _title ->
        [MarkdownLink (Ext.asPlainText inner) uri]
      _ ->
        []
    relevantInlines = \case
      Ext.Naked xs -> toList xs
      Ext.Paragraph xs -> toList xs
      Ext.OrderedList _ xs -> concat $ concat $ fmap (fmap relevantInlines) xs
      Ext.UnorderedList xs -> concat $ concat $ fmap (fmap relevantInlines) xs
      _ -> []