From 5b2dbaeaac5b71931d21a6bae943924e618feb32 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 20:05:03 -0400
Subject: [PATCH 01/19] Refactor the query type to be a GADT

---
 neuron.cabal                          |  5 +-
 src/Neuron/CLI.hs                     | 11 +++-
 src/Neuron/CLI/Types.hs               |  7 ++-
 src/Neuron/Web/View.hs                |  9 ++--
 src/Neuron/Zettelkasten/Graph.hs      |  2 +-
 src/Neuron/Zettelkasten/Link.hs       | 30 ++++++++---
 src/Neuron/Zettelkasten/Query.hs      | 76 ++++++++++++++++-----------
 test/Neuron/Zettelkasten/LinkSpec.hs  |  5 +-
 test/Neuron/Zettelkasten/QuerySpec.hs | 14 ++---
 9 files changed, 101 insertions(+), 58 deletions(-)

diff --git a/neuron.cabal b/neuron.cabal
index 83d6d8acf..2f9e8bdcb 100644
--- a/neuron.cabal
+++ b/neuron.cabal
@@ -59,7 +59,10 @@ common library-common
     dhall >= 1.30,
     which,
     unix,
-    megaparsec >= 8.0
+    megaparsec >= 8.0,
+    some,
+    dependent-sum,
+    dependent-sum-template
 
 library
   import: library-common
diff --git a/src/Neuron/CLI.hs b/src/Neuron/CLI.hs
index ed5ee1190..4e5818281 100644
--- a/src/Neuron/CLI.hs
+++ b/src/Neuron/CLI.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -11,6 +12,7 @@ where
 
 import Data.Aeson
 import qualified Data.Aeson.Text as Aeson
+import Data.Some
 import Development.Shake (Action)
 import Neuron.CLI.New (newZettelFile)
 import Neuron.CLI.Rib
@@ -56,10 +58,15 @@ runWith act App {..} = do
         putStrLn indexHtmlPath
         let opener = if os == "darwin" then "open" else "xdg-open"
         liftIO $ executeFile opener True [indexHtmlPath] Nothing
-    Query queries ->
+    Query q ->
       runRibOnceQuietly notesDir $ do
         store <- Z.mkZettelStore =<< Rib.forEvery ["*.md"] pure
-        putLTextLn $ Aeson.encodeToLazyText $ zettelJsonWith <$> Z.runQuery store queries
+        case q of
+          Some (Z.Query_ZettelsByTag pats) -> do
+            let res = Z.runQuery store (Z.Query_ZettelsByTag pats)
+            putLTextLn $ Aeson.encodeToLazyText $ zettelJsonWith <$> res
+          Some (Z.Query_Tags _pats) -> do
+            putLTextLn "Not Implemented"
     Search searchCmd ->
       runSearch notesDir searchCmd
   where
diff --git a/src/Neuron/CLI/Types.hs b/src/Neuron/CLI/Types.hs
index bd21ace87..400ca7031 100644
--- a/src/Neuron/CLI/Types.hs
+++ b/src/Neuron/CLI/Types.hs
@@ -17,6 +17,7 @@ module Neuron.CLI.Types
   )
 where
 
+import Data.Some
 import qualified Neuron.Zettelkasten.Query as Z
 import qualified Neuron.Zettelkasten.Tag as Z
 import Options.Applicative
@@ -28,7 +29,6 @@ data App = App
   { notesDir :: FilePath,
     cmd :: Command
   }
-  deriving (Eq, Show)
 
 data NewCommand = NewCommand {title :: Text, edit :: Bool}
   deriving (Eq, Show)
@@ -52,10 +52,9 @@ data Command
   | -- | Search a zettel by title
     Search SearchCommand
   | -- | Run a query against the Zettelkasten
-    Query [Z.Query]
+    Query (Some Z.Query)
   | -- | Delegate to Rib's command parser
     Rib RibConfig
-  deriving (Eq, Show)
 
 data RibConfig = RibConfig
   { ribOutputDir :: Maybe FilePath,
@@ -95,7 +94,7 @@ commandParser defaultNotesDir = do
       pure Open
     queryCommand =
       fmap Query $
-        many (Z.Query_ZettelsByTag . Z.TagPattern <$> option str (long "tag" <> short 't'))
+        fmap (Some . Z.Query_ZettelsByTag) (many (Z.TagPattern <$> option str (long "tag" <> short 't')))
           <|> option uriReader (long "uri" <> short 'u')
     searchCommand = do
       searchBy <-
diff --git a/src/Neuron/Web/View.hs b/src/Neuron/Web/View.hs
index 5498cf83b..b3eb0353c 100644
--- a/src/Neuron/Web/View.hs
+++ b/src/Neuron/Web/View.hs
@@ -37,7 +37,7 @@ import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Graph
 import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName, zettelIDText)
 import Neuron.Zettelkasten.Link.Theme (LinkTheme (..))
-import Neuron.Zettelkasten.Link.View (zLinkExt, renderZettelLink)
+import Neuron.Zettelkasten.Link.View (renderZettelLink, zLinkExt)
 import Neuron.Zettelkasten.Markdown (neuronMMarkExts)
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Store
@@ -124,7 +124,7 @@ renderSearch store = do
     input_ [type_ "text", id_ "search-input"]
     fa "search icon fas fa-search"
   div_ [class_ "ui hidden divider"] mempty
-  let allZettels = runQuery store []
+  let allZettels = runQuery store $ Query_ZettelsByTag []
       allTags = Set.fromList $ concatMap zettelTags allZettels
       index = object ["zettels" .= fmap (object . zettelJson) allZettels, "tags" .= allTags]
   div_ [class_ "ui fluid multiple search selection dropdown", id_ "search-tags"] $ do
@@ -223,8 +223,9 @@ renderForest isRoot maxLevel ltheme s g trees =
           let zettelDiv =
                 div_
                   [class_ $ bool "" "ui black label" $ ltheme == LinkTheme_Default]
-          bool id zettelDiv isRoot $
-            renderZettelLink ltheme $ lookupStore zid s
+          bool id zettelDiv isRoot
+            $ renderZettelLink ltheme
+            $ lookupStore zid s
           when (ltheme == LinkTheme_Default) $ do
             " "
             case backlinks zid g of
diff --git a/src/Neuron/Zettelkasten/Graph.hs b/src/Neuron/Zettelkasten/Graph.hs
index 6628038da..e493a00ae 100644
--- a/src/Neuron/Zettelkasten/Graph.hs
+++ b/src/Neuron/Zettelkasten/Graph.hs
@@ -32,7 +32,7 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Tree (Forest, Tree (..))
 import Neuron.Zettelkasten.ID
-import Neuron.Zettelkasten.Link (zLinkConnections, mkZLink)
+import Neuron.Zettelkasten.Link (mkZLink, zLinkConnections)
 import Neuron.Zettelkasten.Markdown (extractLinks)
 import Neuron.Zettelkasten.Store (ZettelStore)
 import Neuron.Zettelkasten.Zettel
diff --git a/src/Neuron/Zettelkasten/Link.hs b/src/Neuron/Zettelkasten/Link.hs
index f910a22f6..82bc5e140 100644
--- a/src/Neuron/Zettelkasten/Link.hs
+++ b/src/Neuron/Zettelkasten/Link.hs
@@ -10,6 +10,7 @@
 -- | Special Zettel links in Markdown
 module Neuron.Zettelkasten.Link where
 
+import Data.Some
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Link.Theme
 import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
@@ -25,9 +26,19 @@ import qualified Text.URI as URI
 data ZLink
   = ZLink_ConnectZettel Connection ZettelID
   | -- | Render a list (or should it be tree?) of links to queries zettels
-    ZLink_QueryZettels Connection LinkTheme [Query]
+    ZLink_QueryZettels Connection LinkTheme (Query [Zettel])
   deriving (Eq, Show)
 
+connectionFromURI :: URI.URI -> Connection
+connectionFromURI uri =
+  fromMaybe Folgezettel $
+    case fmap URI.unRText (URI.uriScheme uri) of
+      Just scheme
+        | scheme `elem` ["zcf", "zcfquery"] ->
+          Just OrdinaryConnection
+      _ ->
+        Nothing
+
 mkZLink :: HasCallStack => MarkdownLink -> Maybe ZLink
 mkZLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} =
   -- NOTE: We should probably drop the 'cf' variants in favour of specifying
@@ -41,14 +52,17 @@ mkZLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} =
       -- The inner link text is supposed to be the zettel ID
       let zid = parseZettelID linkText
        in Just $ ZLink_ConnectZettel OrdinaryConnection zid
-    Just "zquery" ->
-      Just $ ZLink_QueryZettels Folgezettel (linkThemeFromURI uri) (either error id $ queryFromURI uri)
-    Just "zcfquery" ->
-      Just $ ZLink_QueryZettels OrdinaryConnection (linkThemeFromURI uri) (either error id $ queryFromURI uri)
+    Just scheme | scheme `elem` ["zquery", "zcfquery"] ->
+      case queryFromURI uri of
+        Right (Some q@(Query_ZettelsByTag _)) ->
+          Just $ ZLink_QueryZettels (connectionFromURI uri) (linkThemeFromURI uri) q
+        Right _ ->
+          error "Bad query for zquery"
+        Left err ->
+          error err
     _ -> do
-      let uriS = URI.render uri
-      guard $ uriS == linkText
-      zid <- rightToMaybe $ parseZettelID' uriS
+      guard $ linkText == URI.render uri
+      zid <- rightToMaybe $ parseZettelID' linkText
       pure $ ZLink_ConnectZettel Folgezettel zid
 
 -- | The connections referenced in a zlink.
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index bd7fa4cbd..580718dae 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -1,9 +1,13 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -11,7 +15,10 @@
 module Neuron.Zettelkasten.Query where
 
 import Control.Monad.Except
+import Data.GADT.Compare.TH
+import Data.GADT.Show.TH
 import qualified Data.Map.Strict as Map
+import Data.Some
 import Lucid
 import Neuron.Zettelkasten.Store
 import Neuron.Zettelkasten.Tag
@@ -24,51 +31,60 @@ import qualified Text.URI as URI
 -- TODO: Support querying connections, a la:
 --   LinksTo ZettelID
 --   LinksFrom ZettelID
-data Query
-  = Query_ZettelsByTag TagPattern
-  deriving (Eq, Show)
+data Query r where
+  Query_ZettelsByTag :: [TagPattern] -> Query [Zettel]
+  Query_Tags :: [TagPattern] -> Query [Tag]
 
-instance ToHtml Query where
-  toHtmlRaw = toHtml
-  toHtml (Query_ZettelsByTag (TagPattern pat)) =
-    let desc = "Zettels matching tag '" <> toText pat <> "'"
-     in span_ [class_ "ui basic pointing below black label", title_ desc] $ toHtml pat
+deriveGEq ''Query
+
+deriveGShow ''Query
+
+deriving instance Show (Query [Zettel])
+
+deriving instance Eq (Query [Zettel])
 
-instance ToHtml [Query] where
+instance ToHtml (Query [Zettel]) where
   toHtmlRaw = toHtml
-  toHtml qs =
-    div_ [class_ "ui horizontal divider", title_ "Zettel Query"] $ do
-      if null qs
-        then "All zettels"
-        else toHtml `mapM_` qs
+  toHtml = \case
+    Query_ZettelsByTag (fmap unTagPattern -> pats) ->
+      div_ [class_ "ui horizontal divider", title_ "Zettel Query"] $ do
+        if null pats
+          then "All zettels"
+          else
+            let desc = "Zettels tagged '" <> show pats <> "'"
+             in span_ [class_ "ui basic pointing below black label", title_ desc] $ toHtml $ show @Text pats
 
 type QueryResults = [Zettel]
 
-queryFromURI :: MonadError Text m => URI.URI -> m [Query]
+queryFromURI :: MonadError Text m => URI.URI -> m (Some Query)
 queryFromURI uri =
   case fmap URI.unRText (URI.uriScheme uri) of
     Just proto | proto `elem` ["zquery", "zcfquery"] ->
-      pure $ flip mapMaybe (URI.uriQuery uri) $ \case
+      pure $ Some $ Query_ZettelsByTag $ flip mapMaybe (URI.uriQuery uri) $ \case
         URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
           case key of
-            "tag" -> Just $ Query_ZettelsByTag (TagPattern $ toString val)
+            "tag" -> Just (TagPattern $ toString val)
             _ -> Nothing
         _ -> Nothing
     _ -> throwError "Bad URI (expected: zquery: or zcfquery:)"
 
-matchQuery :: Zettel -> Query -> Bool
-matchQuery Zettel {..} = \case
-  Query_ZettelsByTag pat -> any (tagMatch pat) zettelTags
+-- | Run the given query and return the results.
+runQuery :: ZettelStore -> Query r -> r
+runQuery store = \case
+  Query_ZettelsByTag pats ->
+    foldMap (queryResults pats) (Map.elems store)
+  Query_Tags _pats ->
+    -- TODO:
+    []
 
-matchQueries :: Zettel -> [Query] -> Bool
-matchQueries zettel queries = and $ matchQuery zettel <$> queries
+matchQuery :: Zettel -> TagPattern -> Bool
+matchQuery Zettel {..} pat =
+  any (tagMatch pat) zettelTags
 
-queryResults :: [Query] -> Zettel -> QueryResults
-queryResults queries zettel
-  | matchQueries zettel queries = [zettel]
-  | otherwise = mempty
+matchQueries :: Zettel -> [TagPattern] -> Bool
+matchQueries zettel pats = and $ matchQuery zettel <$> pats
 
--- | Run the given query and return the results.
-runQuery :: ZettelStore -> [Query] -> QueryResults
-runQuery store queries =
-  foldMap (queryResults queries) (Map.elems store)
+queryResults :: [TagPattern] -> Zettel -> [Zettel]
+queryResults pats zettel
+  | matchQueries zettel pats = [zettel]
+  | otherwise = mempty
diff --git a/test/Neuron/Zettelkasten/LinkSpec.hs b/test/Neuron/Zettelkasten/LinkSpec.hs
index 32427bf53..09940f2fb 100644
--- a/test/Neuron/Zettelkasten/LinkSpec.hs
+++ b/test/Neuron/Zettelkasten/LinkSpec.hs
@@ -51,11 +51,11 @@ zLinkCases =
     ),
     ( "zquery: link",
       (Right (".", "zquery://search?tag=science")),
-      Just $ ZLink_QueryZettels Folgezettel LinkTheme_Default [Query_ZettelsByTag $ TagPattern "science"]
+      Just $ ZLink_QueryZettels Folgezettel LinkTheme_Default $ zettelsByTag ["science"]
     ),
     ( "zcfquery: link, with link theme",
       (Right (".", "zcfquery://search?tag=science&linkTheme=withDate")),
-      Just $ ZLink_QueryZettels OrdinaryConnection LinkTheme_WithDate [Query_ZettelsByTag $ TagPattern "science"]
+      Just $ ZLink_QueryZettels OrdinaryConnection LinkTheme_WithDate $ zettelsByTag ["science"]
     ),
     ( "normal link",
       (Left "https://www.google.com"),
@@ -64,6 +64,7 @@ zLinkCases =
   ]
   where
     zid = parseZettelID "1234567"
+    zettelsByTag = Query_ZettelsByTag . fmap TagPattern
 
 mkMarkdownLink :: Text -> Text -> MarkdownLink
 mkMarkdownLink s l =
diff --git a/test/Neuron/Zettelkasten/QuerySpec.hs b/test/Neuron/Zettelkasten/QuerySpec.hs
index 3a8565fd4..21e876039 100644
--- a/test/Neuron/Zettelkasten/QuerySpec.hs
+++ b/test/Neuron/Zettelkasten/QuerySpec.hs
@@ -6,6 +6,7 @@ module Neuron.Zettelkasten.QuerySpec
   )
 where
 
+import Data.Some
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Tag
 import Relude
@@ -15,18 +16,19 @@ import Text.URI (mkURI)
 spec :: Spec
 spec =
   describe "Parse query URI" $ do
+    let zettelsByTag = Some . Query_ZettelsByTag . fmap TagPattern
     it "Parse all zettels URI" $
-      parseQueryString "zquery://search" `shouldBe` Right []
+      parseQueryString "zquery://search" `shouldBe` Right (zettelsByTag [])
     it "Parse single tag" $
-      parseQueryString "zquery://search?tag=foo" `shouldBe` Right [Query_ZettelsByTag $ TagPattern "foo"]
+      parseQueryString "zquery://search?tag=foo" `shouldBe` Right (zettelsByTag ["foo"])
     it "Parse hierarchical tag" $ do
-      parseQueryString "zquery://search?tag=foo/bar" `shouldBe` Right [Query_ZettelsByTag $ TagPattern "foo/bar"]
+      parseQueryString "zquery://search?tag=foo/bar" `shouldBe` Right (zettelsByTag ["foo/bar"])
     it "Parse tag pattern" $ do
-      parseQueryString "zquery://search?tag=foo/**/bar/*/baz" `shouldBe` Right [Query_ZettelsByTag $ TagPattern "foo/**/bar/*/baz"]
+      parseQueryString "zquery://search?tag=foo/**/bar/*/baz" `shouldBe` Right (zettelsByTag ["foo/**/bar/*/baz"])
     it "Parse multiple tags" $
       parseQueryString "zquery://search?tag=foo&tag=bar"
-        `shouldBe` Right [Query_ZettelsByTag $ TagPattern "foo", Query_ZettelsByTag $ TagPattern "bar"]
+        `shouldBe` Right (zettelsByTag ["foo", "bar"])
   where
-    parseQueryString :: Text -> Either Text [Query]
+    parseQueryString :: Text -> Either Text (Some Query)
     parseQueryString =
       either (Left . toText . displayException) queryFromURI . mkURI

From 3c026208d02a991614ccb88aa34e8426421e95b1 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 20:55:21 -0400
Subject: [PATCH 02/19] TypeFamilies based types

---
 src/Neuron/CLI.hs                     |  3 +++
 src/Neuron/Zettelkasten/Link.hs       | 31 +++++++++++++++++++++++++++
 src/Neuron/Zettelkasten/Link/Theme.hs |  1 +
 src/Neuron/Zettelkasten/Query.hs      |  7 ++++++
 4 files changed, 42 insertions(+)

diff --git a/src/Neuron/CLI.hs b/src/Neuron/CLI.hs
index 4e5818281..df793b9ed 100644
--- a/src/Neuron/CLI.hs
+++ b/src/Neuron/CLI.hs
@@ -62,6 +62,9 @@ runWith act App {..} = do
       runRibOnceQuietly notesDir $ do
         store <- Z.mkZettelStore =<< Rib.forEvery ["*.md"] pure
         case q of
+          Some (Z.Query_ZettelByID zid) -> do
+            let res = Z.lookupStore zid store
+            putLTextLn $ Aeson.encodeToLazyText $ zettelJsonWith res
           Some (Z.Query_ZettelsByTag pats) -> do
             let res = Z.runQuery store (Z.Query_ZettelsByTag pats)
             putLTextLn $ Aeson.encodeToLazyText $ zettelJsonWith <$> res
diff --git a/src/Neuron/Zettelkasten/Link.hs b/src/Neuron/Zettelkasten/Link.hs
index 82bc5e140..a2322c0ca 100644
--- a/src/Neuron/Zettelkasten/Link.hs
+++ b/src/Neuron/Zettelkasten/Link.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -6,6 +7,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Special Zettel links in Markdown
 module Neuron.Zettelkasten.Link where
@@ -18,8 +20,37 @@ import Neuron.Zettelkasten.Query (Query (..), queryFromURI, runQuery)
 import Neuron.Zettelkasten.Store
 import Neuron.Zettelkasten.Zettel
 import Relude
+import Neuron.Zettelkasten.Tag
+import Control.Monad.Except
 import qualified Text.URI as URI
 
+type family QueryConnection q
+
+type instance QueryConnection Zettel = Connection
+type instance QueryConnection [Zettel] = Connection
+
+type instance QueryConnection [Tag] = ()
+
+type family QueryViewTheme q
+
+type instance QueryViewTheme Zettel = LinkTheme
+type instance QueryViewTheme [Zettel] = LinkTheme
+
+type instance QueryViewTheme [Tag] = ()
+
+data NeuronLink = forall r. NeuronLink (Query r, QueryConnection r, QueryViewTheme r)
+
+neuronLinkFromURI :: MonadError Text m => URI.URI -> m NeuronLink
+neuronLinkFromURI uri = do
+  someQ <- queryFromURI uri
+  withSome someQ $ \q -> case q of
+    Query_ZettelByID _ ->
+      pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri)
+    Query_ZettelsByTag _ ->
+      pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri)
+    Query_Tags _ ->
+      pure $ NeuronLink (q, (), ())
+
 -- | A ZLink is a special link supported by Neuron
 --
 -- z:, zcf:, zquery: and zcfquery:
diff --git a/src/Neuron/Zettelkasten/Link/Theme.hs b/src/Neuron/Zettelkasten/Link/Theme.hs
index 9ca043ad8..332d35c85 100644
--- a/src/Neuron/Zettelkasten/Link/Theme.hs
+++ b/src/Neuron/Zettelkasten/Link/Theme.hs
@@ -18,6 +18,7 @@ data LinkTheme
   | LinkTheme_WithDate
   deriving (Eq, Show, Ord)
 
+-- TODO: MonadError
 linkThemeFromURI :: URI.URI -> LinkTheme
 linkThemeFromURI uri =
   fromMaybe LinkTheme_Default $ listToMaybe $ flip mapMaybe (URI.uriQuery uri) $ \case
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 580718dae..e7f408d1c 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -3,11 +3,13 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -23,6 +25,7 @@ import Lucid
 import Neuron.Zettelkasten.Store
 import Neuron.Zettelkasten.Tag
 import Neuron.Zettelkasten.Zettel
+import Neuron.Zettelkasten.ID
 import Relude
 import qualified Text.URI as URI
 
@@ -32,6 +35,7 @@ import qualified Text.URI as URI
 --   LinksTo ZettelID
 --   LinksFrom ZettelID
 data Query r where
+  Query_ZettelByID :: ZettelID -> Query Zettel
   Query_ZettelsByTag :: [TagPattern] -> Query [Zettel]
   Query_Tags :: [TagPattern] -> Query [Tag]
 
@@ -43,6 +47,7 @@ deriving instance Show (Query [Zettel])
 
 deriving instance Eq (Query [Zettel])
 
+
 instance ToHtml (Query [Zettel]) where
   toHtmlRaw = toHtml
   toHtml = \case
@@ -71,6 +76,8 @@ queryFromURI uri =
 -- | Run the given query and return the results.
 runQuery :: ZettelStore -> Query r -> r
 runQuery store = \case
+  Query_ZettelByID zid ->
+    lookupStore zid store
   Query_ZettelsByTag pats ->
     foldMap (queryResults pats) (Map.elems store)
   Query_Tags _pats ->

From 1824618ebf5bc951eba304d7ea463947c958f409 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 20:55:36 -0400
Subject: [PATCH 03/19] Introduce NeuronLink

---
 src/Neuron/Zettelkasten/Graph.hs     |  7 +++---
 src/Neuron/Zettelkasten/Link.hs      | 34 +++++++++++++++++++---------
 src/Neuron/Zettelkasten/Link/View.hs | 20 +++++++++-------
 src/Neuron/Zettelkasten/Query.hs     | 18 ++++++++++++---
 4 files changed, 54 insertions(+), 25 deletions(-)

diff --git a/src/Neuron/Zettelkasten/Graph.hs b/src/Neuron/Zettelkasten/Graph.hs
index e493a00ae..d24669638 100644
--- a/src/Neuron/Zettelkasten/Graph.hs
+++ b/src/Neuron/Zettelkasten/Graph.hs
@@ -32,7 +32,7 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Tree (Forest, Tree (..))
 import Neuron.Zettelkasten.ID
-import Neuron.Zettelkasten.Link (mkZLink, zLinkConnections)
+import Neuron.Zettelkasten.Link (neuronLinkFromMarkdownLink, neuronLinkConnections)
 import Neuron.Zettelkasten.Markdown (extractLinks)
 import Neuron.Zettelkasten.Store (ZettelStore)
 import Neuron.Zettelkasten.Zettel
@@ -64,8 +64,9 @@ mkZettelGraph store =
       fmap (first pure) . outgoingLinks
     outgoingLinks :: Zettel -> [(Connection, ZettelID)]
     outgoingLinks Zettel {..} =
-      (maybe [] (zLinkConnections store) . mkZLink)
-        `concatMap` extractLinks zettelContent
+      flip concatMap (extractLinks zettelContent) $ \mlink ->
+          let nlink = either error id $ neuronLinkFromMarkdownLink mlink
+          in maybe [] (neuronLinkConnections store) nlink
 
 -- | Return the backlinks to the given zettel
 backlinks :: ZettelID -> ZettelGraph -> [ZettelID]
diff --git a/src/Neuron/Zettelkasten/Link.hs b/src/Neuron/Zettelkasten/Link.hs
index a2322c0ca..36d3759f5 100644
--- a/src/Neuron/Zettelkasten/Link.hs
+++ b/src/Neuron/Zettelkasten/Link.hs
@@ -16,7 +16,7 @@ import Data.Some
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Link.Theme
 import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
-import Neuron.Zettelkasten.Query (Query (..), queryFromURI, runQuery)
+import Neuron.Zettelkasten.Query (Query (..), queryFromMarkdownLink, queryFromURI, runQuery)
 import Neuron.Zettelkasten.Store
 import Neuron.Zettelkasten.Zettel
 import Relude
@@ -40,16 +40,28 @@ type instance QueryViewTheme [Tag] = ()
 
 data NeuronLink = forall r. NeuronLink (Query r, QueryConnection r, QueryViewTheme r)
 
-neuronLinkFromURI :: MonadError Text m => URI.URI -> m NeuronLink
-neuronLinkFromURI uri = do
-  someQ <- queryFromURI uri
-  withSome someQ $ \q -> case q of
-    Query_ZettelByID _ ->
-      pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri)
-    Query_ZettelsByTag _ ->
-      pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri)
-    Query_Tags _ ->
-      pure $ NeuronLink (q, (), ())
+neuronLinkFromMarkdownLink :: MonadError Text m => MarkdownLink -> m (Maybe NeuronLink)
+neuronLinkFromMarkdownLink ml@MarkdownLink { markdownLinkUri = uri } = do
+  queryFromMarkdownLink ml >>= \case
+    Nothing -> pure Nothing
+    Just someQ -> Just <$> do
+      withSome someQ $ \q -> case q of
+        Query_ZettelByID _ ->
+          pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri)
+        Query_ZettelsByTag _ ->
+          pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri)
+        Query_Tags _ ->
+          pure $ NeuronLink (q, (), ())
+
+neuronLinkConnections :: ZettelStore -> NeuronLink -> [(Connection, ZettelID)]
+neuronLinkConnections store = \case
+  NeuronLink (Query_ZettelByID zid, conn, _) ->
+    [(conn, zid)]
+  NeuronLink (q@(Query_ZettelsByTag _pats), conn, _) ->
+    (conn,) . zettelID <$> runQuery store q
+  _ ->
+    []
+
 
 -- | A ZLink is a special link supported by Neuron
 --
diff --git a/src/Neuron/Zettelkasten/Link/View.hs b/src/Neuron/Zettelkasten/Link/View.hs
index 305ffd8ca..d14288ef4 100644
--- a/src/Neuron/Zettelkasten/Link/View.hs
+++ b/src/Neuron/Zettelkasten/Link/View.hs
@@ -26,30 +26,34 @@ import qualified Text.MMark.Extension as Ext
 import Text.MMark.Extension (Extension, Inline (..))
 
 -- | MMark extension to transform zlinks to actual links
-zLinkExt :: ZettelStore -> Extension
+zLinkExt :: HasCallStack => ZettelStore -> Extension
 zLinkExt store =
   Ext.inlineRender $ \f -> \case
     inline@(Link inner uri _title) ->
       let mlink = MarkdownLink (Ext.asPlainText inner) uri
-       in case mkZLink mlink of
-            Just lact ->
+       in case neuronLinkFromMarkdownLink mlink of
+            Right (Just lact) ->
               renderZLink store lact
-            Nothing ->
+            Right Nothing ->
               f inline
+            Left e ->
+              error e
     inline ->
       f inline
 
 -- | Expand a zlink into normal links
-renderZLink :: Monad m => ZettelStore -> ZLink -> HtmlT m ()
+renderZLink :: Monad m => ZettelStore -> NeuronLink -> HtmlT m ()
 renderZLink store = \case
-  ZLink_ConnectZettel _conn zid ->
-    renderZettelLink LinkTheme_Default $ lookupStore zid store
-  ZLink_QueryZettels _conn linkTheme q -> do
+  NeuronLink (Query_ZettelByID zid, _conn, linkTheme) ->
+    renderZettelLink linkTheme $ lookupStore zid store
+  NeuronLink (q@(Query_ZettelsByTag _pats), _conn, linkTheme) -> do
     toHtml q
     let zettels = sortOn Down $ zettelID <$> runQuery store q
     ul_ $ do
       forM_ zettels $ \zid ->
         li_ $ renderZettelLink linkTheme $ lookupStore zid store
+  NeuronLink (_q@(Query_Tags _), (), ()) ->
+    pre_ "Not Implemented"
 
 -- | Render a link to an individual zettel.
 renderZettelLink :: forall m. Monad m => LinkTheme -> Zettel -> HtmlT m ()
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index e7f408d1c..9c10737cd 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -24,6 +24,7 @@ import Data.Some
 import Lucid
 import Neuron.Zettelkasten.Store
 import Neuron.Zettelkasten.Tag
+import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
 import Neuron.Zettelkasten.Zettel
 import Neuron.Zettelkasten.ID
 import Relude
@@ -62,16 +63,27 @@ instance ToHtml (Query [Zettel]) where
 type QueryResults = [Zettel]
 
 queryFromURI :: MonadError Text m => URI.URI -> m (Some Query)
-queryFromURI uri =
+queryFromURI uri = do
+  mq <- queryFromMarkdownLink $ MarkdownLink { markdownLinkUri = uri, markdownLinkText = "" }
+  case mq of
+    Just q -> pure q
+    Nothing -> throwError "Unsupported query URI"
+
+-- NOTE: To support legacy links which rely on linkText. New short links shouldn't use this.
+queryFromMarkdownLink :: MonadError Text m => MarkdownLink -> m (Maybe (Some Query))
+queryFromMarkdownLink MarkdownLink { markdownLinkUri = uri, markdownLinkText = linkText } =
   case fmap URI.unRText (URI.uriScheme uri) of
+    Just proto | proto `elem` ["z", "zcf"] -> do
+      zid <- liftEither $ parseZettelID' linkText
+      pure $ Just $ Some $ Query_ZettelByID zid
     Just proto | proto `elem` ["zquery", "zcfquery"] ->
-      pure $ Some $ Query_ZettelsByTag $ flip mapMaybe (URI.uriQuery uri) $ \case
+      pure $ Just $ Some $ Query_ZettelsByTag $ flip mapMaybe (URI.uriQuery uri) $ \case
         URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
           case key of
             "tag" -> Just (TagPattern $ toString val)
             _ -> Nothing
         _ -> Nothing
-    _ -> throwError "Bad URI (expected: zquery: or zcfquery:)"
+    _ -> pure Nothing
 
 -- | Run the given query and return the results.
 runQuery :: ZettelStore -> Query r -> r

From 092ad85d27882d69ef684c3db69f6e7df514d4bf Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:22:22 -0400
Subject: [PATCH 04/19] Fix tests

---
 src/Neuron/Zettelkasten/Link.hs      | 74 +++++++++----------------
 src/Neuron/Zettelkasten/Query.hs     | 10 +++-
 test/Neuron/Zettelkasten/LinkSpec.hs | 81 ++++++++++++----------------
 3 files changed, 67 insertions(+), 98 deletions(-)

diff --git a/src/Neuron/Zettelkasten/Link.hs b/src/Neuron/Zettelkasten/Link.hs
index 36d3759f5..12e5d8576 100644
--- a/src/Neuron/Zettelkasten/Link.hs
+++ b/src/Neuron/Zettelkasten/Link.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -6,27 +7,28 @@
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Special Zettel links in Markdown
 module Neuron.Zettelkasten.Link where
 
+import Control.Monad.Except
 import Data.Some
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Link.Theme
 import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
-import Neuron.Zettelkasten.Query (Query (..), queryFromMarkdownLink, queryFromURI, runQuery)
+import Neuron.Zettelkasten.Query (Query (..), queryFromMarkdownLink, runQuery)
 import Neuron.Zettelkasten.Store
+import Neuron.Zettelkasten.Tag
 import Neuron.Zettelkasten.Zettel
 import Relude
-import Neuron.Zettelkasten.Tag
-import Control.Monad.Except
 import qualified Text.URI as URI
 
 type family QueryConnection q
 
 type instance QueryConnection Zettel = Connection
+
 type instance QueryConnection [Zettel] = Connection
 
 type instance QueryConnection [Tag] = ()
@@ -34,14 +36,30 @@ type instance QueryConnection [Tag] = ()
 type family QueryViewTheme q
 
 type instance QueryViewTheme Zettel = LinkTheme
+
 type instance QueryViewTheme [Zettel] = LinkTheme
 
 type instance QueryViewTheme [Tag] = ()
 
-data NeuronLink = forall r. NeuronLink (Query r, QueryConnection r, QueryViewTheme r)
+data NeuronLink =
+  forall r. (Show (Query r), Show (QueryConnection r), Show (QueryViewTheme r))
+  => NeuronLink (Query r, QueryConnection r, QueryViewTheme r)
+
+deriving instance Show NeuronLink
+
+instance Eq NeuronLink where
+  (==) (NeuronLink (Query_ZettelByID zid1, c1, t1)) (NeuronLink (Query_ZettelByID zid2, c2, t2)) =
+    and [zid1 == zid2, c1 == c2, t1 == t2]
+  (==) (NeuronLink (Query_ZettelsByTag p1, c1, t1)) (NeuronLink (Query_ZettelsByTag p2, c2, t2)) =
+    and [p1 == p2, c1 == c2, t1 == t2]
+  (==) (NeuronLink (Query_Tags p1, c1, t1)) (NeuronLink (Query_Tags p2, c2, t2)) =
+    and [p1 == p2, c1 == c2, t1 == t2]
+  (==) _ _ =
+    False
+
 
 neuronLinkFromMarkdownLink :: MonadError Text m => MarkdownLink -> m (Maybe NeuronLink)
-neuronLinkFromMarkdownLink ml@MarkdownLink { markdownLinkUri = uri } = do
+neuronLinkFromMarkdownLink ml@MarkdownLink {markdownLinkUri = uri} = do
   queryFromMarkdownLink ml >>= \case
     Nothing -> pure Nothing
     Just someQ -> Just <$> do
@@ -62,16 +80,6 @@ neuronLinkConnections store = \case
   _ ->
     []
 
-
--- | A ZLink is a special link supported by Neuron
---
--- z:, zcf:, zquery: and zcfquery:
-data ZLink
-  = ZLink_ConnectZettel Connection ZettelID
-  | -- | Render a list (or should it be tree?) of links to queries zettels
-    ZLink_QueryZettels Connection LinkTheme (Query [Zettel])
-  deriving (Eq, Show)
-
 connectionFromURI :: URI.URI -> Connection
 connectionFromURI uri =
   fromMaybe Folgezettel $
@@ -81,37 +89,3 @@ connectionFromURI uri =
           Just OrdinaryConnection
       _ ->
         Nothing
-
-mkZLink :: HasCallStack => MarkdownLink -> Maybe ZLink
-mkZLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} =
-  -- 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" ->
-      -- The inner link text is supposed to be the zettel ID
-      let zid = parseZettelID linkText
-       in Just $ ZLink_ConnectZettel Folgezettel zid
-    Just "zcf" ->
-      -- The inner link text is supposed to be the zettel ID
-      let zid = parseZettelID linkText
-       in Just $ ZLink_ConnectZettel OrdinaryConnection zid
-    Just scheme | scheme `elem` ["zquery", "zcfquery"] ->
-      case queryFromURI uri of
-        Right (Some q@(Query_ZettelsByTag _)) ->
-          Just $ ZLink_QueryZettels (connectionFromURI uri) (linkThemeFromURI uri) q
-        Right _ ->
-          error "Bad query for zquery"
-        Left err ->
-          error err
-    _ -> do
-      guard $ linkText == URI.render uri
-      zid <- rightToMaybe $ parseZettelID' linkText
-      pure $ ZLink_ConnectZettel Folgezettel zid
-
--- | The connections referenced in a zlink.
-zLinkConnections :: ZettelStore -> ZLink -> [(Connection, ZettelID)]
-zLinkConnections store = \case
-  ZLink_ConnectZettel conn zid ->
-    [(conn, zid)]
-  ZLink_QueryZettels conn _linkTheme q ->
-    (conn,) . zettelID <$> runQuery store q
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 9c10737cd..9716f5ad6 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -44,9 +44,14 @@ deriveGEq ''Query
 
 deriveGShow ''Query
 
+deriving instance Show (Query Zettel)
+
 deriving instance Show (Query [Zettel])
+deriving instance Show (Query [Tag])
 
+deriving instance Eq (Query Zettel)
 deriving instance Eq (Query [Zettel])
+deriving instance Eq (Query [Tag])
 
 
 instance ToHtml (Query [Zettel]) where
@@ -83,7 +88,10 @@ queryFromMarkdownLink MarkdownLink { markdownLinkUri = uri, markdownLinkText = l
             "tag" -> Just (TagPattern $ toString val)
             _ -> Nothing
         _ -> Nothing
-    _ -> pure Nothing
+    _ -> pure $ do
+      guard $ URI.render uri == linkText
+      zid <- rightToMaybe $ parseZettelID' linkText
+      pure $ Some $ Query_ZettelByID zid
 
 -- | Run the given query and return the results.
 runQuery :: ZettelStore -> Query r -> r
diff --git a/test/Neuron/Zettelkasten/LinkSpec.hs b/test/Neuron/Zettelkasten/LinkSpec.hs
index 09940f2fb..632c83e37 100644
--- a/test/Neuron/Zettelkasten/LinkSpec.hs
+++ b/test/Neuron/Zettelkasten/LinkSpec.hs
@@ -17,54 +17,41 @@ import Test.Hspec
 import Text.URI
 
 spec :: Spec
-spec = do
-  describe "Link Action conversion" $ do
-    forM_ zLinkCases $ \(name, link, action) -> do
-      it ("converts " <> name) $ do
-        mkZLink (uncurry mkMarkdownLink $ either (id &&& id) id link) `shouldBe` action
-
-zLinkCases :: [(String, Either Text (Text, Text), Maybe ZLink)]
-zLinkCases =
-  [ ( "alias link",
-      (Left "1234567"),
-      Just $ ZLink_ConnectZettel Folgezettel zid
-    ),
-    ( "not an alias link (different link text)",
-      (Right ("foo", "1234567")),
-      Nothing
-    ),
-    ( "z: link",
-      (Right ("1234567", "z:")),
-      Just $ ZLink_ConnectZettel Folgezettel zid
-    ),
-    ( "z: link, with annotation ignored",
-      (Right ("1234567", "z://foo-bar")),
-      Just $ ZLink_ConnectZettel Folgezettel zid
-    ),
-    ( "zcf: link",
-      (Right ("1234567", "zcf:")),
-      Just $ ZLink_ConnectZettel OrdinaryConnection zid
-    ),
-    ( "zcf: link, with annotation ignored",
-      (Right ("1234567", "zcf://foo-bar")),
-      Just $ ZLink_ConnectZettel OrdinaryConnection zid
-    ),
-    ( "zquery: link",
-      (Right (".", "zquery://search?tag=science")),
-      Just $ ZLink_QueryZettels Folgezettel LinkTheme_Default $ zettelsByTag ["science"]
-    ),
-    ( "zcfquery: link, with link theme",
-      (Right (".", "zcfquery://search?tag=science&linkTheme=withDate")),
-      Just $ ZLink_QueryZettels OrdinaryConnection LinkTheme_WithDate $ zettelsByTag ["science"]
-    ),
-    ( "normal link",
-      (Left "https://www.google.com"),
-      Nothing
-    )
-  ]
+spec =
+  describe "NeuronLink" $ do
+    let zid = parseZettelID "1234567"
+    it "alias link" $
+      mkMarkdownLink "1234567" "1234567"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelByID zid, Folgezettel, LinkTheme_Default))
+    it "not an alias link (different link text)" $
+      mkMarkdownLink "foo" "1234567"
+        `shouldParseAs` Nothing
+    it "z: link" $
+      mkMarkdownLink "1234567" "z:"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelByID zid, Folgezettel, LinkTheme_Default))
+    it "z: link, with annotations" $
+      mkMarkdownLink "1234567" "z://foo-bar"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelByID zid, Folgezettel, LinkTheme_Default))
+    it "zcf: link" $
+      mkMarkdownLink "1234567" "zcf:"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelByID zid, OrdinaryConnection, LinkTheme_Default))
+    it "zcf: link, with annotations" $
+      mkMarkdownLink "1234567" "zcf://foo-bar"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelByID zid, OrdinaryConnection, LinkTheme_Default))
+    it "zquery: link" $
+      mkMarkdownLink "." "zquery://search?tag=science"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelsByTag [TagPattern "science"], Folgezettel, LinkTheme_Default))
+    it "zcfquery: link" $
+      mkMarkdownLink "." "zcfquery://search?tag=science"
+        `shouldParseAs` Just (NeuronLink (Query_ZettelsByTag [TagPattern "science"], OrdinaryConnection, LinkTheme_Default))
+    it "normal link" $ do
+      mkMarkdownLink "foo bar" "https://www.google.com"
+        `shouldParseAs` Nothing
+      mkMarkdownLink "https://www.google.com" "https://www.google.com"
+        `shouldParseAs` Nothing
   where
-    zid = parseZettelID "1234567"
-    zettelsByTag = Query_ZettelsByTag . fmap TagPattern
+    shouldParseAs ml nl =
+      neuronLinkFromMarkdownLink ml `shouldBe` Right nl
 
 mkMarkdownLink :: Text -> Text -> MarkdownLink
 mkMarkdownLink s l =

From 4196206ce640873e4e4f37bfc5427c52ad5627ca Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:23:56 -0400
Subject: [PATCH 05/19] Format

---
 src/Neuron/Zettelkasten/Graph.hs |  6 +++---
 src/Neuron/Zettelkasten/Link.hs  | 10 +++++-----
 src/Neuron/Zettelkasten/Query.hs | 13 ++++++++-----
 3 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/src/Neuron/Zettelkasten/Graph.hs b/src/Neuron/Zettelkasten/Graph.hs
index d24669638..3ce3bbdc5 100644
--- a/src/Neuron/Zettelkasten/Graph.hs
+++ b/src/Neuron/Zettelkasten/Graph.hs
@@ -32,7 +32,7 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Tree (Forest, Tree (..))
 import Neuron.Zettelkasten.ID
-import Neuron.Zettelkasten.Link (neuronLinkFromMarkdownLink, neuronLinkConnections)
+import Neuron.Zettelkasten.Link (neuronLinkConnections, neuronLinkFromMarkdownLink)
 import Neuron.Zettelkasten.Markdown (extractLinks)
 import Neuron.Zettelkasten.Store (ZettelStore)
 import Neuron.Zettelkasten.Zettel
@@ -65,8 +65,8 @@ mkZettelGraph store =
     outgoingLinks :: Zettel -> [(Connection, ZettelID)]
     outgoingLinks Zettel {..} =
       flip concatMap (extractLinks zettelContent) $ \mlink ->
-          let nlink = either error id $ neuronLinkFromMarkdownLink mlink
-          in maybe [] (neuronLinkConnections store) nlink
+        let nlink = either error id $ neuronLinkFromMarkdownLink mlink
+         in maybe [] (neuronLinkConnections store) nlink
 
 -- | Return the backlinks to the given zettel
 backlinks :: ZettelID -> ZettelGraph -> [ZettelID]
diff --git a/src/Neuron/Zettelkasten/Link.hs b/src/Neuron/Zettelkasten/Link.hs
index 12e5d8576..514328a88 100644
--- a/src/Neuron/Zettelkasten/Link.hs
+++ b/src/Neuron/Zettelkasten/Link.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE NoImplicitPrelude #-}
@@ -41,9 +41,10 @@ type instance QueryViewTheme [Zettel] = LinkTheme
 
 type instance QueryViewTheme [Tag] = ()
 
-data NeuronLink =
-  forall r. (Show (Query r), Show (QueryConnection r), Show (QueryViewTheme r))
-  => NeuronLink (Query r, QueryConnection r, QueryViewTheme r)
+data NeuronLink
+  = forall r.
+    (Show (Query r), Show (QueryConnection r), Show (QueryViewTheme r)) =>
+    NeuronLink (Query r, QueryConnection r, QueryViewTheme r)
 
 deriving instance Show NeuronLink
 
@@ -57,7 +58,6 @@ instance Eq NeuronLink where
   (==) _ _ =
     False
 
-
 neuronLinkFromMarkdownLink :: MonadError Text m => MarkdownLink -> m (Maybe NeuronLink)
 neuronLinkFromMarkdownLink ml@MarkdownLink {markdownLinkUri = uri} = do
   queryFromMarkdownLink ml >>= \case
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 9716f5ad6..ad9043222 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -22,11 +22,11 @@ import Data.GADT.Show.TH
 import qualified Data.Map.Strict as Map
 import Data.Some
 import Lucid
+import Neuron.Zettelkasten.ID
+import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
 import Neuron.Zettelkasten.Store
 import Neuron.Zettelkasten.Tag
-import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
 import Neuron.Zettelkasten.Zettel
-import Neuron.Zettelkasten.ID
 import Relude
 import qualified Text.URI as URI
 
@@ -47,12 +47,14 @@ deriveGShow ''Query
 deriving instance Show (Query Zettel)
 
 deriving instance Show (Query [Zettel])
+
 deriving instance Show (Query [Tag])
 
 deriving instance Eq (Query Zettel)
+
 deriving instance Eq (Query [Zettel])
-deriving instance Eq (Query [Tag])
 
+deriving instance Eq (Query [Tag])
 
 instance ToHtml (Query [Zettel]) where
   toHtmlRaw = toHtml
@@ -69,14 +71,14 @@ type QueryResults = [Zettel]
 
 queryFromURI :: MonadError Text m => URI.URI -> m (Some Query)
 queryFromURI uri = do
-  mq <- queryFromMarkdownLink $ MarkdownLink { markdownLinkUri = uri, markdownLinkText = "" }
+  mq <- queryFromMarkdownLink $ MarkdownLink {markdownLinkUri = uri, markdownLinkText = ""}
   case mq of
     Just q -> pure q
     Nothing -> throwError "Unsupported query URI"
 
 -- NOTE: To support legacy links which rely on linkText. New short links shouldn't use this.
 queryFromMarkdownLink :: MonadError Text m => MarkdownLink -> m (Maybe (Some Query))
-queryFromMarkdownLink MarkdownLink { markdownLinkUri = uri, markdownLinkText = linkText } =
+queryFromMarkdownLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} =
   case fmap URI.unRText (URI.uriScheme uri) of
     Just proto | proto `elem` ["z", "zcf"] -> do
       zid <- liftEither $ parseZettelID' linkText
@@ -89,6 +91,7 @@ queryFromMarkdownLink MarkdownLink { markdownLinkUri = uri, markdownLinkText = l
             _ -> Nothing
         _ -> Nothing
     _ -> pure $ do
+      -- Initial support for the upcoming short links.
       guard $ URI.render uri == linkText
       zid <- rightToMaybe $ parseZettelID' linkText
       pure $ Some $ Query_ZettelByID zid

From 47210dd5669ef1b03428c2a8e37aabe738f1297f Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:28:54 -0400
Subject: [PATCH 06/19] Drop reference to zlink

---
 src/Neuron/Web/View.hs               |  6 +++---
 src/Neuron/Zettelkasten/Link/View.hs | 27 +++++++++++++++++----------
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/src/Neuron/Web/View.hs b/src/Neuron/Web/View.hs
index b3eb0353c..9984089d9 100644
--- a/src/Neuron/Web/View.hs
+++ b/src/Neuron/Web/View.hs
@@ -37,7 +37,7 @@ import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Graph
 import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName, zettelIDText)
 import Neuron.Zettelkasten.Link.Theme (LinkTheme (..))
-import Neuron.Zettelkasten.Link.View (renderZettelLink, zLinkExt)
+import Neuron.Zettelkasten.Link.View (neuronLinkExt, renderZettelLink)
 import Neuron.Zettelkasten.Markdown (neuronMMarkExts)
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Store
@@ -112,7 +112,7 @@ renderIndex Config {..} (store, graph) = do
   script_ helloScript
   where
     -- Sort clusters with newer mother zettels appearing first.
-    sortMothers ms = reverse $ sortOn maximum $ fmap (reverse . sort . toList) ms
+    sortMothers ms = sortOn (Down . maximum) $ fmap (sortOn Down . toList) ms
     countNounBe noun nounPlural = \case
       1 -> "is 1 " <> noun
       n -> "are " <> show n <> " " <> nounPlural
@@ -148,7 +148,7 @@ renderZettel config@Config {..} (store, graph) zid = do
       div_ [class_ "ui top attached segment"] $ do
         h1_ [class_ "header"] $ toHtml zettelTitle
         let mmarkExts = neuronMMarkExts config
-        MMark.render $ useExtensions (zLinkExt store : mmarkExts) zettelContent
+        MMark.render $ useExtensions (neuronLinkExt store : mmarkExts) zettelContent
         whenNotNull zettelTags $ \_ ->
           renderTags zettelTags
     div_ [class_ $ "ui inverted " <> Theme.semanticColor neuronTheme <> " top attached connections segment"] $ do
diff --git a/src/Neuron/Zettelkasten/Link/View.hs b/src/Neuron/Zettelkasten/Link/View.hs
index d14288ef4..48cef7316 100644
--- a/src/Neuron/Zettelkasten/Link/View.hs
+++ b/src/Neuron/Zettelkasten/Link/View.hs
@@ -9,7 +9,11 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Special Zettel links in Markdown
-module Neuron.Zettelkasten.Link.View where
+module Neuron.Zettelkasten.Link.View
+  ( neuronLinkExt,
+    renderZettelLink,
+  )
+where
 
 import Lucid
 import Neuron.Web.Route (Route (..))
@@ -25,15 +29,15 @@ import qualified Rib
 import qualified Text.MMark.Extension as Ext
 import Text.MMark.Extension (Extension, Inline (..))
 
--- | MMark extension to transform zlinks to actual links
-zLinkExt :: HasCallStack => ZettelStore -> Extension
-zLinkExt store =
+-- | MMark extension to transform neuron links to custom views
+neuronLinkExt :: HasCallStack => ZettelStore -> Extension
+neuronLinkExt store =
   Ext.inlineRender $ \f -> \case
     inline@(Link inner uri _title) ->
       let mlink = MarkdownLink (Ext.asPlainText inner) uri
        in case neuronLinkFromMarkdownLink mlink of
-            Right (Just lact) ->
-              renderZLink store lact
+            Right (Just nl) ->
+              renderNeuronLink store nl
             Right Nothing ->
               f inline
             Left e ->
@@ -41,19 +45,22 @@ zLinkExt store =
     inline ->
       f inline
 
--- | Expand a zlink into normal links
-renderZLink :: Monad m => ZettelStore -> NeuronLink -> HtmlT m ()
-renderZLink store = \case
+-- | Render the custom view for the given neuron link
+renderNeuronLink :: Monad m => ZettelStore -> NeuronLink -> HtmlT m ()
+renderNeuronLink store = \case
   NeuronLink (Query_ZettelByID zid, _conn, linkTheme) ->
+    -- Render a single link
     renderZettelLink linkTheme $ lookupStore zid store
   NeuronLink (q@(Query_ZettelsByTag _pats), _conn, linkTheme) -> do
+    -- Render a list of links
     toHtml q
     let zettels = sortOn Down $ zettelID <$> runQuery store q
     ul_ $ do
       forM_ zettels $ \zid ->
         li_ $ renderZettelLink linkTheme $ lookupStore zid store
   NeuronLink (_q@(Query_Tags _), (), ()) ->
-    pre_ "Not Implemented"
+    -- Render a list of tags
+    pre_ "TODO: Tags view not Implemented"
 
 -- | Render a link to an individual zettel.
 renderZettelLink :: forall m. Monad m => LinkTheme -> Zettel -> HtmlT m ()

From 988363992c88da5283062c11f0fb44d21989fb60 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:35:14 -0400
Subject: [PATCH 07/19] Enable tags in cli

---
 src/Neuron/CLI.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Neuron/CLI.hs b/src/Neuron/CLI.hs
index df793b9ed..233432131 100644
--- a/src/Neuron/CLI.hs
+++ b/src/Neuron/CLI.hs
@@ -68,8 +68,9 @@ runWith act App {..} = do
           Some (Z.Query_ZettelsByTag pats) -> do
             let res = Z.runQuery store (Z.Query_ZettelsByTag pats)
             putLTextLn $ Aeson.encodeToLazyText $ zettelJsonWith <$> res
-          Some (Z.Query_Tags _pats) -> do
-            putLTextLn "Not Implemented"
+          Some (Z.Query_Tags pats) -> do
+            let res = Z.runQuery store (Z.Query_Tags pats)
+            putLTextLn $ Aeson.encodeToLazyText res
     Search searchCmd ->
       runSearch notesDir searchCmd
   where

From 5f30832202a36ba7d4cf329cf82bf2df01bc6f39 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:35:21 -0400
Subject: [PATCH 08/19] Up version, due to significant refactor

---
 neuron.cabal               | 2 +-
 test/Neuron/VersionSpec.hs | 8 ++++----
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/neuron.cabal b/neuron.cabal
index 2f9e8bdcb..000322ef5 100644
--- a/neuron.cabal
+++ b/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.3.0.1
+version: 0.3.1.0
 license: BSD-3-Clause
 copyright: 2020 Sridhar Ratnakumar
 maintainer: srid@srid.ca
diff --git a/test/Neuron/VersionSpec.hs b/test/Neuron/VersionSpec.hs
index 189b3b6cb..9ba1cabd2 100644
--- a/test/Neuron/VersionSpec.hs
+++ b/test/Neuron/VersionSpec.hs
@@ -31,9 +31,9 @@ spec = do
     it "must compare full versions" $ do
       "0.4.1.2" `isGreater` olderThan
       "0.4.3" `isGreater` olderThan
-      "0.3.0.8" `isGreater` olderThan
-      "0.3.0.1" `isLesserOrEqual` olderThan -- This is current version
+      "0.3.1.8" `isGreater` olderThan
+      "0.3.1.0" `isLesserOrEqual` olderThan -- This is current version
       "0.2.1.0" `isLesserOrEqual` olderThan
     it "must compare within same major version" $ do
-      "0.3.0.8" `isGreater` olderThan
-      "0.3.0.1" `isLesserOrEqual` olderThan -- This is current version
+      "0.3.1.8" `isGreater` olderThan
+      "0.3.1.0" `isLesserOrEqual` olderThan -- This is current version

From bd5bfdda94cd61b7873a4c18aa114f069d7b7caf Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:48:09 -0400
Subject: [PATCH 09/19] Restrict zquery search to zquery://search only

---
 src/Neuron/Zettelkasten/Query.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index ad9043222..841de2e21 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -83,7 +83,9 @@ queryFromMarkdownLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = li
     Just proto | proto `elem` ["z", "zcf"] -> do
       zid <- liftEither $ parseZettelID' linkText
       pure $ Just $ Some $ Query_ZettelByID zid
-    Just proto | proto `elem` ["zquery", "zcfquery"] ->
+    Just proto
+      | proto `elem` ["zquery", "zcfquery"]
+        && fmap (URI.unRText . URI.authHost) (URI.uriAuthority uri) == Right "search" ->
       pure $ Just $ Some $ Query_ZettelsByTag $ flip mapMaybe (URI.uriQuery uri) $ \case
         URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
           case key of

From e590ee7db8f53551e6c1bf17c4baea7a702f2aee Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:48:27 -0400
Subject: [PATCH 10/19] bin/test: allow passing options to ghcid

---
 bin/test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/bin/test b/bin/test
index 9c87b8df9..fb6212574 100755
--- a/bin/test
+++ b/bin/test
@@ -1,3 +1,3 @@
 #!/usr/bin/env bash
 set -xe
-nix-shell --run "ghcid -c 'cabal new-repl test:neuron-test' -T \":main $*\""
+nix-shell --run "ghcid $* -c 'cabal new-repl test:neuron-test' -T \":main $*\""

From 58adda2ecb87e148cb1e9f7eeab1be94a02502ae Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 21:58:47 -0400
Subject: [PATCH 11/19] Refactor to prepare for enabling tags

---
 src/Neuron/CLI/Types.hs               |  2 +-
 src/Neuron/Zettelkasten/Query.hs      | 19 ++++++++++++-------
 src/Neuron/Zettelkasten/Tag.hs        |  6 +++++-
 test/Neuron/Zettelkasten/LinkSpec.hs  |  4 ++--
 test/Neuron/Zettelkasten/QuerySpec.hs |  2 +-
 test/Neuron/Zettelkasten/TagSpec.hs   |  2 +-
 6 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/src/Neuron/CLI/Types.hs b/src/Neuron/CLI/Types.hs
index 400ca7031..84900120d 100644
--- a/src/Neuron/CLI/Types.hs
+++ b/src/Neuron/CLI/Types.hs
@@ -94,7 +94,7 @@ commandParser defaultNotesDir = do
       pure Open
     queryCommand =
       fmap Query $
-        fmap (Some . Z.Query_ZettelsByTag) (many (Z.TagPattern <$> option str (long "tag" <> short 't')))
+        fmap (Some . Z.Query_ZettelsByTag) (many (Z.mkTagPattern <$> option str (long "tag" <> short 't')))
           <|> option uriReader (long "uri" <> short 'u')
     searchCommand = do
       searchBy <-
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 841de2e21..21bcc32a8 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -85,18 +85,23 @@ queryFromMarkdownLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = li
       pure $ Just $ Some $ Query_ZettelByID zid
     Just proto
       | proto `elem` ["zquery", "zcfquery"]
-        && fmap (URI.unRText . URI.authHost) (URI.uriAuthority uri) == Right "search" ->
-      pure $ Just $ Some $ Query_ZettelsByTag $ flip mapMaybe (URI.uriQuery uri) $ \case
-        URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
-          case key of
-            "tag" -> Just (TagPattern $ toString val)
-            _ -> Nothing
-        _ -> Nothing
+          && uriHost uri == Right "search" ->
+        pure $ Just $ Some $ Query_ZettelsByTag $ mkTagPattern <$> getParamValues "tag" uri
     _ -> pure $ do
       -- Initial support for the upcoming short links.
       guard $ URI.render uri == linkText
       zid <- rightToMaybe $ parseZettelID' linkText
       pure $ Some $ Query_ZettelByID zid
+  where
+    getParamValues k u =
+      flip mapMaybe (URI.uriQuery u) $ \case
+        URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) ->
+          if key == k
+            then Just val
+            else Nothing
+        _ -> Nothing
+    uriHost u =
+      fmap (URI.unRText . URI.authHost) (URI.uriAuthority u)
 
 -- | Run the given query and return the results.
 runQuery :: ZettelStore -> Query r -> r
diff --git a/src/Neuron/Zettelkasten/Tag.hs b/src/Neuron/Zettelkasten/Tag.hs
index 4fb4467b7..f23840d55 100644
--- a/src/Neuron/Zettelkasten/Tag.hs
+++ b/src/Neuron/Zettelkasten/Tag.hs
@@ -5,7 +5,8 @@
 
 module Neuron.Zettelkasten.Tag
   ( Tag (..),
-    TagPattern (..),
+    TagPattern (unTagPattern),
+    mkTagPattern,
     tagMatch,
   )
 where
@@ -20,5 +21,8 @@ newtype Tag = Tag {unTag :: Text}
 newtype TagPattern = TagPattern {unTagPattern :: FilePattern}
   deriving (Eq, Show)
 
+mkTagPattern :: Text -> TagPattern
+mkTagPattern = TagPattern . toString
+
 tagMatch :: TagPattern -> Tag -> Bool
 tagMatch (TagPattern pat) (Tag tag) = pat ?== toString tag
diff --git a/test/Neuron/Zettelkasten/LinkSpec.hs b/test/Neuron/Zettelkasten/LinkSpec.hs
index 632c83e37..b4deba883 100644
--- a/test/Neuron/Zettelkasten/LinkSpec.hs
+++ b/test/Neuron/Zettelkasten/LinkSpec.hs
@@ -40,10 +40,10 @@ spec =
         `shouldParseAs` Just (NeuronLink (Query_ZettelByID zid, OrdinaryConnection, LinkTheme_Default))
     it "zquery: link" $
       mkMarkdownLink "." "zquery://search?tag=science"
-        `shouldParseAs` Just (NeuronLink (Query_ZettelsByTag [TagPattern "science"], Folgezettel, LinkTheme_Default))
+        `shouldParseAs` Just (NeuronLink (Query_ZettelsByTag [mkTagPattern "science"], Folgezettel, LinkTheme_Default))
     it "zcfquery: link" $
       mkMarkdownLink "." "zcfquery://search?tag=science"
-        `shouldParseAs` Just (NeuronLink (Query_ZettelsByTag [TagPattern "science"], OrdinaryConnection, LinkTheme_Default))
+        `shouldParseAs` Just (NeuronLink (Query_ZettelsByTag [mkTagPattern "science"], OrdinaryConnection, LinkTheme_Default))
     it "normal link" $ do
       mkMarkdownLink "foo bar" "https://www.google.com"
         `shouldParseAs` Nothing
diff --git a/test/Neuron/Zettelkasten/QuerySpec.hs b/test/Neuron/Zettelkasten/QuerySpec.hs
index 21e876039..76d59d3ae 100644
--- a/test/Neuron/Zettelkasten/QuerySpec.hs
+++ b/test/Neuron/Zettelkasten/QuerySpec.hs
@@ -16,7 +16,7 @@ import Text.URI (mkURI)
 spec :: Spec
 spec =
   describe "Parse query URI" $ do
-    let zettelsByTag = Some . Query_ZettelsByTag . fmap TagPattern
+    let zettelsByTag = Some . Query_ZettelsByTag . fmap mkTagPattern
     it "Parse all zettels URI" $
       parseQueryString "zquery://search" `shouldBe` Right (zettelsByTag [])
     it "Parse single tag" $
diff --git a/test/Neuron/Zettelkasten/TagSpec.hs b/test/Neuron/Zettelkasten/TagSpec.hs
index 3d596c433..2a63f9bc1 100644
--- a/test/Neuron/Zettelkasten/TagSpec.hs
+++ b/test/Neuron/Zettelkasten/TagSpec.hs
@@ -15,7 +15,7 @@ import Test.Hspec
 spec :: Spec
 spec = do
   describe "Tag matching" $ do
-    forM_ tagMatchCases $ \(name, Z.TagPattern -> pat, fmap Z.Tag -> matching, fmap Z.Tag -> failing) -> do
+    forM_ tagMatchCases $ \(name, Z.mkTagPattern . toText -> pat, fmap Z.Tag -> matching, fmap Z.Tag -> failing) -> do
       it name $ do
         forM_ matching $ \tag -> do
           pat `shouldMatch` tag

From 1c7dcc03fa08fc601598dac9c89a756d487cf9df Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 22:17:50 -0400
Subject: [PATCH 12/19] Add tag querying

---
 src/Neuron/Zettelkasten/Query.hs | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 21bcc32a8..0db2f8156 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -20,6 +20,7 @@ import Control.Monad.Except
 import Data.GADT.Compare.TH
 import Data.GADT.Show.TH
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import Data.Some
 import Lucid
 import Neuron.Zettelkasten.ID
@@ -83,10 +84,14 @@ queryFromMarkdownLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = li
     Just proto | proto `elem` ["z", "zcf"] -> do
       zid <- liftEither $ parseZettelID' linkText
       pure $ Just $ Some $ Query_ZettelByID zid
-    Just proto
-      | proto `elem` ["zquery", "zcfquery"]
-          && uriHost uri == Right "search" ->
-        pure $ Just $ Some $ Query_ZettelsByTag $ mkTagPattern <$> getParamValues "tag" uri
+    Just proto | proto `elem` ["zquery", "zcfquery"] ->
+      case uriHost uri of
+        Right "search" ->
+          pure $ Just $ Some $ Query_ZettelsByTag $ mkTagPattern <$> getParamValues "tag" uri
+        Right "tags" ->
+          pure $ Just $ Some $ Query_Tags $ mkTagPattern <$> getParamValues "filter" uri
+        _ ->
+          throwError "Unsupported host in zquery"
     _ -> pure $ do
       -- Initial support for the upcoming short links.
       guard $ URI.render uri == linkText
@@ -110,9 +115,13 @@ runQuery store = \case
     lookupStore zid store
   Query_ZettelsByTag pats ->
     foldMap (queryResults pats) (Map.elems store)
-  Query_Tags _pats ->
-    -- TODO:
-    []
+  Query_Tags pats ->
+    -- TODO: Use step from https://hackage.haskell.org/package/filepattern-0.1.2/docs/System-FilePattern.html#v:step
+    -- for efficient matching.
+    let allTags = Set.toList $ Set.fromList $ flip foldMap (Map.elems store) $ \Zettel {..} -> zettelTags
+     in if null pats
+          then allTags
+          else filter (\t -> any (`tagMatch` t) pats) allTags
 
 matchQuery :: Zettel -> TagPattern -> Bool
 matchQuery Zettel {..} pat =

From 82298e86211de34c9d272c159089a3f6abd14dc1 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 22:17:56 -0400
Subject: [PATCH 13/19] Refactor

---
 src/Neuron/Zettelkasten/Query.hs | 58 ++++++++++++++------------------
 1 file changed, 25 insertions(+), 33 deletions(-)

diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 0db2f8156..2a5c19582 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -41,22 +41,6 @@ data Query r where
   Query_ZettelsByTag :: [TagPattern] -> Query [Zettel]
   Query_Tags :: [TagPattern] -> Query [Tag]
 
-deriveGEq ''Query
-
-deriveGShow ''Query
-
-deriving instance Show (Query Zettel)
-
-deriving instance Show (Query [Zettel])
-
-deriving instance Show (Query [Tag])
-
-deriving instance Eq (Query Zettel)
-
-deriving instance Eq (Query [Zettel])
-
-deriving instance Eq (Query [Tag])
-
 instance ToHtml (Query [Zettel]) where
   toHtmlRaw = toHtml
   toHtml = \case
@@ -114,23 +98,31 @@ runQuery store = \case
   Query_ZettelByID zid ->
     lookupStore zid store
   Query_ZettelsByTag pats ->
-    foldMap (queryResults pats) (Map.elems store)
+    flip filter (Map.elems store) $ \Zettel {..} ->
+      and $ flip fmap pats $ \pat ->
+        any (tagMatch pat) zettelTags
+  Query_Tags [] ->
+    allTags
   Query_Tags pats ->
     -- TODO: Use step from https://hackage.haskell.org/package/filepattern-0.1.2/docs/System-FilePattern.html#v:step
     -- for efficient matching.
-    let allTags = Set.toList $ Set.fromList $ flip foldMap (Map.elems store) $ \Zettel {..} -> zettelTags
-     in if null pats
-          then allTags
-          else filter (\t -> any (`tagMatch` t) pats) allTags
-
-matchQuery :: Zettel -> TagPattern -> Bool
-matchQuery Zettel {..} pat =
-  any (tagMatch pat) zettelTags
-
-matchQueries :: Zettel -> [TagPattern] -> Bool
-matchQueries zettel pats = and $ matchQuery zettel <$> pats
-
-queryResults :: [TagPattern] -> Zettel -> [Zettel]
-queryResults pats zettel
-  | matchQueries zettel pats = [zettel]
-  | otherwise = mempty
+    flip filter allTags $ \t ->
+      any (`tagMatch` t) pats
+  where
+    allTags = Set.toList $ Set.fromList $ foldMap zettelTags (Map.elems store)
+
+deriveGEq ''Query
+
+deriveGShow ''Query
+
+deriving instance Show (Query Zettel)
+
+deriving instance Show (Query [Zettel])
+
+deriving instance Show (Query [Tag])
+
+deriving instance Eq (Query Zettel)
+
+deriving instance Eq (Query [Zettel])
+
+deriving instance Eq (Query [Tag])

From d106fc236be263356a6fcef1e217b23e311f96e8 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 22:34:16 -0400
Subject: [PATCH 14/19] Render zquery tags

---
 src/Neuron/Zettelkasten/Link/View.hs | 18 ++++++++++++++----
 src/Neuron/Zettelkasten/Query.hs     | 27 ++++++++++++++++++---------
 2 files changed, 32 insertions(+), 13 deletions(-)

diff --git a/src/Neuron/Zettelkasten/Link/View.hs b/src/Neuron/Zettelkasten/Link/View.hs
index 48cef7316..29d00358c 100644
--- a/src/Neuron/Zettelkasten/Link/View.hs
+++ b/src/Neuron/Zettelkasten/Link/View.hs
@@ -2,10 +2,12 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Special Zettel links in Markdown
@@ -15,19 +17,22 @@ module Neuron.Zettelkasten.Link.View
   )
 where
 
+import Data.Some
 import Lucid
-import Neuron.Web.Route (Route (..))
+import Neuron.Web.Route (Route (..), routeUrlRelWithQuery)
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Link
 import Neuron.Zettelkasten.Link.Theme (LinkTheme (..))
 import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Store
+import Neuron.Zettelkasten.Tag (Tag (unTag))
 import Neuron.Zettelkasten.Zettel
 import Relude
 import qualified Rib
 import qualified Text.MMark.Extension as Ext
 import Text.MMark.Extension (Extension, Inline (..))
+import Text.URI.QQ (queryKey)
 
 -- | MMark extension to transform neuron links to custom views
 neuronLinkExt :: HasCallStack => ZettelStore -> Extension
@@ -53,14 +58,19 @@ renderNeuronLink store = \case
     renderZettelLink linkTheme $ lookupStore zid store
   NeuronLink (q@(Query_ZettelsByTag _pats), _conn, linkTheme) -> do
     -- Render a list of links
-    toHtml q
+    toHtml $ Some q
     let zettels = sortOn Down $ zettelID <$> runQuery store q
     ul_ $ do
       forM_ zettels $ \zid ->
         li_ $ renderZettelLink linkTheme $ lookupStore zid store
-  NeuronLink (_q@(Query_Tags _), (), ()) ->
+  NeuronLink (q@(Query_Tags _), (), ()) -> do
     -- Render a list of tags
-    pre_ "TODO: Tags view not Implemented"
+    toHtml $ Some q
+    let tags = runQuery store q
+    ul_ $ do
+      forM_ tags $ \(unTag -> tag) -> do
+        let tagUrl = routeUrlRelWithQuery Route_Search [queryKey|tag|] tag
+        li_ $ a_ [href_ tagUrl] $ toHtml tag
 
 -- | Render a link to an individual zettel.
 renderZettelLink :: forall m. Monad m => LinkTheme -> Zettel -> HtmlT m ()
diff --git a/src/Neuron/Zettelkasten/Query.hs b/src/Neuron/Zettelkasten/Query.hs
index 2a5c19582..f2cb07abe 100644
--- a/src/Neuron/Zettelkasten/Query.hs
+++ b/src/Neuron/Zettelkasten/Query.hs
@@ -41,16 +41,25 @@ data Query r where
   Query_ZettelsByTag :: [TagPattern] -> Query [Zettel]
   Query_Tags :: [TagPattern] -> Query [Tag]
 
-instance ToHtml (Query [Zettel]) where
+instance ToHtml (Some Query) where
   toHtmlRaw = toHtml
-  toHtml = \case
-    Query_ZettelsByTag (fmap unTagPattern -> pats) ->
-      div_ [class_ "ui horizontal divider", title_ "Zettel Query"] $ do
-        if null pats
-          then "All zettels"
-          else
-            let desc = "Zettels tagged '" <> show pats <> "'"
-             in span_ [class_ "ui basic pointing below black label", title_ desc] $ toHtml $ show @Text pats
+  toHtml q =
+    div_ [class_ "ui horizontal divider", title_ "Neuron Query"] $ do
+      case q of
+        Some (Query_ZettelByID _) ->
+          mempty
+        Some (Query_ZettelsByTag []) ->
+          "All zettels"
+        Some (Query_ZettelsByTag (fmap unTagPattern -> pats)) -> do
+          let qs = intercalate ", " pats
+              desc = toText $ "Zettels tagged '" <> qs <> "'"
+           in span_ [class_ "ui basic pointing below black label", title_ desc] $ toHtml qs
+        Some (Query_Tags []) ->
+          "All tags"
+        Some (Query_Tags (fmap unTagPattern -> pats)) ->
+          let qs = intercalate ", " pats
+              desc = toText $ "Tags matching '" <> qs <> "'"
+           in span_ [class_ "ui basic pointing below grey label", title_ desc] $ toHtml qs
 
 type QueryResults = [Zettel]
 

From 543c0079464a05edfdc2da6154e9889f4cc7a101 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 22:38:54 -0400
Subject: [PATCH 15/19] Pin nixpkgs

---
 default.nix | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/default.nix b/default.nix
index 079431182..5b66c2d70 100644
--- a/default.nix
+++ b/default.nix
@@ -3,6 +3,7 @@ let
   # revision you would like to upgrade to and set it here. Consult rib's
   # ChangeLog.md to check any notes on API migration.
   ribRevision = "2dcd420";
+  nixpkgsRev = "10100a97c896";
   projectRoot = ./.;
 in {
 # Rib library source to use
@@ -13,7 +14,7 @@ in {
 , name ? "neuron"
 , gitRev ? ""
 , source-overrides ? {}
-, pkgs ? import <nixpkgs> {}
+, pkgs ? import (builtins.fetchTarball "https://github.com/nixos/nixpkgs/archive/${nixpkgsRev}.tar.gz") {}
 , ...
 }:
 

From 4aaafb67e0b8819868b13b400d2fb05b2fd507b7 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 18 Apr 2020 22:54:54 -0400
Subject: [PATCH 16/19] Override dependent-sum

---
 default.nix | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/default.nix b/default.nix
index 5b66c2d70..1251638f6 100644
--- a/default.nix
+++ b/default.nix
@@ -54,6 +54,7 @@ let
     version = "${neuronRev}"
     EOF
     '';
+  dsumSrc = builtins.fetchTarball "https://github.com/obsidiansystems/dependent-sum/archive/73ab6cb.tar.gz";
 
 in import rib { 
     inherit name additional-packages; 
@@ -62,6 +63,8 @@ in import rib {
       neuron = neuronRoot;
       # Until https://github.com/obsidiansystems/which/pull/6 is merged
       which = builtins.fetchTarball "https://github.com/srid/which/archive/5061a97.tar.gz";
+      dependent-sum = dsumSrc + "/dependent-sum";
+      dependent-sum-template = dsumSrc + "/dependent-sum-template";
     } // source-overrides;
     overrides = self: super: with pkgs.haskell.lib; {
       # We must add neuron-search as a runtime dependency to the 'neuron'

From 13eb406daa2c751f161b84354f50f180960b4323 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sun, 19 Apr 2020 00:37:59 -0400
Subject: [PATCH 17/19] CI: advance cachix actions

---
 .github/workflows/ci.yaml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
index ea69d59d0..e7d573f91 100644
--- a/.github/workflows/ci.yaml
+++ b/.github/workflows/ci.yaml
@@ -10,9 +10,9 @@ jobs:
         os: [macos-latest, ubuntu-latest]
     steps:
     - uses: actions/checkout@v2
-    - uses: cachix/install-nix-action@v7
+    - uses: cachix/install-nix-action@v8
     # This also runs nix-build.
-    - uses: cachix/cachix-action@v4
+    - uses: cachix/cachix-action@v5
       with:
         name: srid
         signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'

From 572662dfe6b43995700444fef371a16cd474b918 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sun, 19 Apr 2020 11:33:08 -0400
Subject: [PATCH 18/19] Use pure nix-shell

---
 bin/run  | 2 +-
 bin/test | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/bin/run b/bin/run
index 94f104bc6..69a72c111 100755
--- a/bin/run
+++ b/bin/run
@@ -1,3 +1,3 @@
 #!/usr/bin/env bash
 set -xe
-nix-shell --run "ghcid -c 'cabal new-repl exe:neuron' -T \":main $*\""
+nix-shell --pure --run "ghcid -c 'cabal new-repl exe:neuron' -T \":main $*\""
diff --git a/bin/test b/bin/test
index fb6212574..64090faa4 100755
--- a/bin/test
+++ b/bin/test
@@ -1,3 +1,3 @@
 #!/usr/bin/env bash
 set -xe
-nix-shell --run "ghcid $* -c 'cabal new-repl test:neuron-test' -T \":main $*\""
+nix-shell --pure --run "ghcid $* -c 'cabal new-repl test:neuron-test' -T \":main $*\""

From d2bed0b3a45d779766cb509a5b3f66f87c0b32a4 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sun, 19 Apr 2020 11:43:06 -0400
Subject: [PATCH 19/19] cleanup

---
 src/Neuron/Zettelkasten/Link.hs       | 1 +
 src/Neuron/Zettelkasten/Link/Theme.hs | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Neuron/Zettelkasten/Link.hs b/src/Neuron/Zettelkasten/Link.hs
index 514328a88..9e0c1a74b 100644
--- a/src/Neuron/Zettelkasten/Link.hs
+++ b/src/Neuron/Zettelkasten/Link.hs
@@ -41,6 +41,7 @@ type instance QueryViewTheme [Zettel] = LinkTheme
 
 type instance QueryViewTheme [Tag] = ()
 
+-- TODO: Refactor to be a GADT using Some, and derive GEq, etc. correctly
 data NeuronLink
   = forall r.
     (Show (Query r), Show (QueryConnection r), Show (QueryViewTheme r)) =>
diff --git a/src/Neuron/Zettelkasten/Link/Theme.hs b/src/Neuron/Zettelkasten/Link/Theme.hs
index 332d35c85..80381d738 100644
--- a/src/Neuron/Zettelkasten/Link/Theme.hs
+++ b/src/Neuron/Zettelkasten/Link/Theme.hs
@@ -19,7 +19,7 @@ data LinkTheme
   deriving (Eq, Show, Ord)
 
 -- TODO: MonadError
-linkThemeFromURI :: URI.URI -> LinkTheme
+linkThemeFromURI :: HasCallStack => URI.URI -> LinkTheme
 linkThemeFromURI uri =
   fromMaybe LinkTheme_Default $ listToMaybe $ flip mapMaybe (URI.uriQuery uri) $ \case
     URI.QueryFlag _ -> Nothing