Merge pull request #375 from srid/inline-tags

Add inline tags support

CHANGELOG.md

@@ -18,6 +18,7 @@
   - Allow specifying time in the `date` metadata propery (#343)
   - Add `unlisted` metadata property to hide a zettel from z-index (#318)
   - Markdown: 
+    - Inline tags (#189)
     - support for [fancy lists](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/fancy_lists.md) (#335)
     - Fix hard line breaks to actually work (#354)
 - CLI

guide/2011404.md

@@ -3,10 +3,11 @@
 Zettel files are written in Markdown[^other], per the [CommonMark](https://commonmark.org/) specification. Neuron uses [commonmark-hs](https://github.com/jgm/commonmark-hs) to parse them into the [Pandoc AST](https://pandoc.org/using-the-pandoc-api.html), as well as provides an extention on top to handle zettel links.
 
 * [[[2011504]]]
+* [[[535407ad]]]
 * [[[2011505]]]
 * [[[2013702]]] 
 * [[[2013701]]] 
 * [[[2016401]]]
-* Styling elements using Semantic UI ([#176](https://github.com/srid/neuron/issues/176))
+* Styling elements using Semantic UI ([\#176](https://github.com/srid/neuron/issues/176))
 
 [^other]: Neuron is designed to be extended with other markup formats as well. Org-mode is currently supported (see the `formats` setting in [[2011701]]) but is [experimental](https://github.com/srid/neuron/issues/275). Neuron recommends Markdown, which is supported everywhere including [[041726b3]].  

guide/2011505.md

@@ -2,39 +2,21 @@
 
 Zettels may contain optional metadata in the YAML frontmatter.
 
-## Tags
-
-You can attach one or more tags to your zettels using the "tags" metadata property[^kw]:
-
-```markdown
----
-tags:
-  - science
----
-```
-
-Tags can be also be nested; see [[[535407ad]]]. 
-
-[^kw]: For interoperability with other Zettelkasten apps, neuron also accepts "keywords" as an alternative to "tags" in the YAML frontmatter.
-:::
-
 ## Date
 
 The date of the zettels can be specified in the "date" metadata field (`neuron new` automatically fills in this field):
 
 ```markdown
 ---
 date: 2020-08-21T13:06
-tags:
-  - journal
 ---
 ```
 
 This date can be made to display in a query result by using the `timeline` flag (see [[2011506]]).
 
 ## Pinning
 
-Zettels can be pinned in the z-index so that they appear at the top. To pin a zettel, add the "pinned" tag to it.
+Zettels can be pinned in the z-index so that they appear at the top. To pin a zettel, add the "pinned" tag (see [[535407ad]]) to it.
 
 ```markdown
 ---
@@ -52,3 +34,10 @@ Sometimes you want to "draft" a note, and as such wish to hide it from the rest
 unlisted: true 
 ---
 ```
+
+## Other metadata 
+
+You can explicitly specify a title using the `title` metadata; otherwise, Neuron will infer it from the Markdown body. 
+
+The metadata key `tags` or `keywords` can be used to specify tags, although neuron supports inline tags as well (see [[[535407ad]]]).
+

guide/2014401.md

@@ -1,7 +1,7 @@
 # MMark Limitations
 
 {.ui .warning .message}
-**NOTE**: This page only applies to neuron version 0.4 or below, which used the mmark Markdown parser. Beginning from neuron version 0.5, however, Pandoc (via commonmark-hs) is used to represent Markdown, where these limitations do not apply. This page is left here for legacy reference. See [issue #137](https://github.com/srid/neuron/issues/137) for details.
+**NOTE**: This page only applies to neuron version 0.4 or below, which used the mmark Markdown parser. Beginning from neuron version 0.5, however, Pandoc (via commonmark-hs) is used to represent Markdown, where these limitations do not apply. This page is left here for legacy reference. See [issue \#137](https://github.com/srid/neuron/issues/137) for details.
 
 Zettel Markdown format is limited in a few ways owing to the strict parsing nature of `mmark`, the parser library used by neuron. 
 

guide/535407ad.md

@@ -1,4 +1,23 @@
-# Hierarchical tags
+# Tags
+
+Neuron supports Twitter like tags. Tags are added by prefixing them with `#`, and they can appear anywhere in the note text. For example:
+
+```markdown
+Gaslighting is enabled by the victim's #cognitive-distortion without which the
+victimizer is rendered powerless to influence their victim.
+```
+
+In the above example, the note is tagged with `#cognitive-distortion` which also links to the tag page.
+
+Tags can also be specified in the [[2011505]] block. The above tag can be specified alternatively as follows:
+
+```markdown
+---
+tags:
+  - cognitive-distortion 
+```
+
+## Hierarchical tags
 
 Tags can be nested using a "tag/subtag" syntax, to allow a more fine-grained organization of your Zettelkasten, especially when using advanced queries as shown in [[2011506]].
 

neuron/neuron.cabal

@@ -1,7 +1,7 @@
 cabal-version: 2.4
 name: neuron
 -- This version must be in sync with what's in Default.dhall
-version: 0.6.6.2
+version: 0.6.7.0
 license: AGPL-3.0-only
 copyright: 2020 Sridhar Ratnakumar
 maintainer: [email protected]

neuron/src/lib/Neuron/Reader/Markdown.hs

@@ -105,6 +105,7 @@ neuronSpec =
   mconcat
     [ autoLinkSpec,
       wikiLinkSpec,
+      inlineTagSpec,
       gfmExtensionsSansEmoji,
       CE.fancyListSpec,
       CE.footnoteSpec,
@@ -124,6 +125,23 @@ neuronSpec =
         <> CE.autoIdentifiersSpec
         <> CE.taskListSpec
 
+inlineTagSpec ::
+  (Monad m, CM.IsBlock il bl, CM.IsInline il) =>
+  CM.SyntaxSpec m il bl
+inlineTagSpec =
+  mempty
+    { CM.syntaxInlineParsers = [pInlineTag]
+    }
+  where
+    pInlineTag ::
+      (Monad m, CM.IsInline il) =>
+      CM.InlineParser m il
+    pInlineTag = P.try $ do
+      _ <- symbol '#'
+      tag <- CM.untokenize <$> idP
+      let tagQuery = "z:tag/" <> tag
+      pure $! cmAutoLink tagQuery
+
 -- | Convert the given wrapped link to a `B.Link`.
 autoLinkSpec ::
   (Monad m, CM.IsBlock il bl, CM.IsInline il) =>
@@ -139,8 +157,13 @@ autoLinkSpec =
     pLink = P.try $ do
       x <- angleBracketLinkP
       let url = CM.untokenize x
-          title = ""
-      pure $! CM.link url title $ CM.str url
+      pure $! cmAutoLink url
+
+cmAutoLink :: CM.IsInline a => Text -> a
+cmAutoLink url =
+  CM.link url title $ CM.str url
+  where
+    title = ""
 
 wikiLinkSpec ::
   (Monad m, CM.IsBlock il bl, CM.IsInline il) =>
@@ -173,10 +196,15 @@ wikiLinkSpec =
     wikiLinkP :: Monad m => Int -> P.ParsecT [CM.Tok] s m [CM.Tok]
     wikiLinkP n = do
       void $ M.count n $ symbol '['
-      x <- some (noneOfToks [Symbol ']', Spaces, UnicodeSpace, LineEnd])
+      x <- idP
       void $ M.count n $ symbol ']'
       pure x
 
+-- TODO: Unify this with the megaparsec parser from ID.hs
+idP :: Monad m => P.ParsecT [CM.Tok] s m [CM.Tok]
+idP =
+  some (noneOfToks [Symbol ']', Spaces, UnicodeSpace, LineEnd])
+
 -- rawHtmlSpec eats angle bracket links as html tags
 defaultBlockSpecsSansRawHtml :: (Monad m, CM.IsBlock il bl) => [CM.BlockSpec m il bl]
 defaultBlockSpecsSansRawHtml =

neuron/src/lib/Neuron/Web/Query/View.hs

@@ -66,6 +66,10 @@ renderQueryResult minner = \case
     el "section" $ do
       renderQuery $ Some q
       renderTagTree $ foldTagTree $ tagTree res
+  ZettelQuery_TagZettel tag :=> Identity () ->
+    renderInlineTag tag mempty $ do
+      text "#"
+      text $ unTag tag
   where
     -- TODO: Instead of doing this here, group the results in runQuery itself.
     groupZettelsByTagsMatching pats matches =
@@ -93,6 +97,8 @@ renderQuery someQ =
       Some (ZettelQuery_Tags (fmap unTagPattern -> pats)) -> do
         let qs = toText $ intercalate ", " pats
         text $ "Tags matching '" <> qs <> "'"
+      Some (ZettelQuery_TagZettel _tag) -> do
+        blank
 
 -- | Render a link to an individual zettel.
 renderZettelLink ::
@@ -178,11 +184,8 @@ renderTagTree t =
           tit = show count <> " zettels tagged"
           cls = bool "" "inactive" $ count == 0
       divClass "node" $ do
-        neuronRouteLink
-          (Some $ Route_Search $ Just tag)
-          ("class" =: cls <> "title" =: tit)
-          $ do
-            text $ renderTagNode tagNode
+        renderInlineTag tag ("class" =: cls <> "title" =: tit) $
+          text $ renderTagNode tagNode
     renderTagNode :: NonEmpty TagNode -> Text
     renderTagNode = \case
       n :| (nonEmpty -> mrest) ->
@@ -192,6 +195,10 @@ renderTagTree t =
           Just rest ->
             unTagNode n <> "/" <> renderTagNode rest
 
+renderInlineTag :: DomBuilder t m => Tag -> Map Text Text -> m () -> NeuronWebT t m ()
+renderInlineTag tag attr body =
+  neuronRouteLink (Some $ Route_Search $ Just tag) attr body
+
 style :: Css
 style = do
   zettelLinkCss

neuron/src/lib/Neuron/Zettelkasten/Query.hs

@@ -45,6 +45,8 @@ runZettelQuery zs = \case
     Right allTags
   ZettelQuery_Tags pats ->
     Right $ Map.filterWithKey (const . tagMatchAny pats) allTags
+  ZettelQuery_TagZettel _tag ->
+    Right ()
   where
     allTags :: Map.Map Tag Natural
     allTags =
@@ -96,6 +98,8 @@ zettelQueryResultJson q er skippedZettels =
         toJSON r
       ZettelQuery_Tags _ ->
         toJSON $ fmap treeToJson . tagTree $ r
+      ZettelQuery_TagZettel _ ->
+        toJSON r
     treeToJson (Node (tag, count) children) =
       object
         [ "name" .= tag,

neuron/src/lib/Neuron/Zettelkasten/Query/Eval.hs

@@ -78,6 +78,8 @@ queryConnections Zettel {..} = do
         (conn,) <$> res
       ZettelQuery_Tags _ :=> _ ->
         mempty
+      ZettelQuery_TagZettel _ :=> _ ->
+        mempty
 
 runSomeZettelQuery ::
   ( MonadError QueryResultError m,

neuron/src/lib/Neuron/Zettelkasten/Query/Parser.hs

@@ -21,7 +21,7 @@ where
 
 import Control.Monad.Except
 import Data.Some
-import Data.TagTree (TagPattern, mkTagPattern)
+import Data.TagTree (TagNode (..), TagPattern, constructTag, mkTagPattern)
 import Neuron.Reader.Type (ZettelFormat (..))
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.ID
@@ -99,6 +99,10 @@ queryFromURI defConn uri = do
           (URI.unRText -> "tags") :| []
             | noSlash -> do
               pure $ Some $ ZettelQuery_Tags (tagPatterns uri "filter")
+          -- Parse z:tag/foo
+          (URI.unRText -> "tag") :| (nonEmpty . fmap (TagNode . URI.unRText) -> Just tagNodes)
+            | noSlash -> do
+              pure $ Some $ ZettelQuery_TagZettel (constructTag tagNodes)
           _ -> empty
 
 parseQueryZettelID :: MonadError QueryParseError m => URI -> Text -> m ZettelID

neuron/src/lib/Neuron/Zettelkasten/Zettel.hs

@@ -43,6 +43,7 @@ data ZettelQuery r where
   ZettelQuery_ZettelByID :: ZettelID -> Connection -> ZettelQuery Zettel
   ZettelQuery_ZettelsByTag :: [TagPattern] -> Connection -> ZettelsView -> ZettelQuery [Zettel]
   ZettelQuery_Tags :: [TagPattern] -> ZettelQuery (Map Tag Natural)
+  ZettelQuery_TagZettel :: Tag -> ZettelQuery ()
 
 -- | A zettel note
 --

neuron/src/lib/Neuron/Zettelkasten/Zettel/Parser.hs

@@ -1,12 +1,17 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Neuron.Zettelkasten.Zettel.Parser where
 
 import Control.Monad.Writer
+import Data.List (nub)
 import Data.Some
+import Data.TagTree (Tag)
 import qualified Data.Text as T
 import Data.Time.DateMayTime (mkDateMayTime)
 import Neuron.Reader.Type
@@ -37,14 +42,16 @@ parseZettel format zreader fn zid s = do
             Nothing -> fromMaybe ("Untitled", False) $ do
               ((,True) . plainify . snd <$> getH1 doc)
                 <|> ((,False) . takeInitial . plainify <$> getFirstParagraphText doc)
-          tags = fromMaybe [] $ Meta.tags =<< meta
+          metaTags = fromMaybe [] $ Meta.tags =<< meta
           date = case zid of
             -- We ignore the "data" meta field on legacy Date IDs, which encode the
             -- creation date in the ID.
             ZettelDateID v _ -> Just $ mkDateMayTime $ Left v
             ZettelCustomID _ -> Meta.date =<< meta
           unlisted = fromMaybe False $ Meta.unlisted =<< meta
           (queries, errors) = runWriter $ extractQueries doc
+          queryTags = getInlineTag `mapMaybe` queries
+          tags = nub $ metaTags <> queryTags
        in Right $ Zettel zid format fn title titleInBody tags date unlisted queries errors doc
   where
     -- Extract all (valid) queries from the Pandoc document
@@ -58,6 +65,10 @@ parseZettel format zreader fn zid s = do
               pure Nothing
             Right v ->
               pure v
+    getInlineTag :: Some ZettelQuery -> Maybe Tag
+    getInlineTag = \case
+      Some (ZettelQuery_TagZettel tag) -> Just tag
+      _ -> Nothing
     takeInitial =
       (<> " ...") . T.take 18
 

neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs

@@ -57,6 +57,12 @@ spec = do
     it "z:tags?filter=foo" $ do
       queryFromURILink (shortLink "z:tags?filter=foo")
         `shouldBe` Right (Just $ Some $ ZettelQuery_Tags [mkTagPattern "foo"])
+    it "z:tag/foo" $ do
+      queryFromURILink (shortLink "z:tag/foo")
+        `shouldBe` Right (Just $ Some $ ZettelQuery_TagZettel (Tag "foo"))
+    it "z:tag/foo/bar/baz" $ do
+      queryFromURILink (shortLink "z:tag/foo/bar/baz")
+        `shouldBe` Right (Just $ Some $ ZettelQuery_TagZettel (Tag "foo/bar/baz"))
   let normalLink = mkURILink "some link text"
   describe "flexible links (regular markdown)" $ do
     it "Default connection type should be cf" $ do