From c8e618610411c1437b01c922f874692664d5250a Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 18:33:07 -0400
Subject: [PATCH 01/21] WIP: Begin using reflex-dom for query view

---
 dep/reflex-dom-pandoc/github.json           |  6 +-
 src/app/Neuron/Web/View.hs                  | 25 +++++++-
 src/lib/Neuron/Markdown.hs                  | 16 +++---
 src/lib/Neuron/Zettelkasten/Query/Eval.hs   | 64 ++++++++++++---------
 src/lib/Neuron/Zettelkasten/Query/Parser.hs |  7 +++
 src/lib/Neuron/Zettelkasten/Zettel/View.hs  | 15 +++--
 6 files changed, 91 insertions(+), 42 deletions(-)

diff --git a/dep/reflex-dom-pandoc/github.json b/dep/reflex-dom-pandoc/github.json
index a87396dd8..bc272eeef 100644
--- a/dep/reflex-dom-pandoc/github.json
+++ b/dep/reflex-dom-pandoc/github.json
@@ -1,8 +1,8 @@
 {
   "owner": "srid",
   "repo": "reflex-dom-pandoc",
-  "branch": "master",
+  "branch": "custom-link-render",
   "private": false,
-  "rev": "2fb4d7c9201d39c4a23e8e7067f36474674c22cd",
-  "sha256": "06l7a2rs7xi14d5nqz873pvl270vdhi863b7axxi6n6ybzzif2rr"
+  "rev": "98306974da52f3d5c122ce6206895c98ca0ed5db",
+  "sha256": "0z2b27r7lrp3ryjcx93qz8w8422zbd0n0nmqgh9p4p9zlbnw5xw4"
 }
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index b1929f408..d7f3af2fe 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -42,10 +42,12 @@ import Neuron.Zettelkasten.Connection
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName, zettelIDText)
+import qualified Neuron.Zettelkasten.Query.Eval as Q
+import qualified Neuron.Zettelkasten.Query.View as Q
 import Neuron.Zettelkasten.Zettel
 import qualified Neuron.Zettelkasten.Zettel.View as ZettelView
 import Reflex.Dom.Core hiding ((&))
-import Reflex.Dom.Pandoc.Document (PandocBuilder)
+import Reflex.Dom.Pandoc (PandocBuilder, elPandocBlocks, elPandocInlines)
 import Relude hiding ((&))
 import qualified Rib
 import Rib.Extra.OpenGraph
@@ -199,7 +201,26 @@ renderZettel config (graph, z@Zettel {..}) = do
     -- cf. https://stackoverflow.com/a/49968820/55246
     elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
     divClass "zettel-view" $ do
-      ZettelView.renderZettelContent z
+      flip ZettelView.renderZettelContent z $ \uriLink -> do
+        case flip runReaderT (G.getZettels graph) (Q.evalQueryLink uriLink) of
+          Left e -> do
+            -- TODO: show the error in terminal, or better report it correctly.
+            -- see github issue.
+            divClass "ui error message" $ text $ show e
+            pure False
+          Right Nothing -> do
+            pure False
+          Right (Just res) -> do
+            case Q.buildQueryView res of
+              Left e -> do
+                divClass "ui error message" $ text $ show e
+                pure False
+              Right (Left w) -> do
+                elPandocInlines [w]
+                pure True
+              Right (Right w) -> do
+                elPandocBlocks [w]
+                pure True
       let cfBacklinks = G.backlinks OrdinaryConnection z graph
       whenNotNull cfBacklinks $ \_ -> divClass "ui attached segment deemphasized" $ do
         elAttr "div" ("class" =: "ui header" <> title =: "Zettels that link here, but without branching") $
diff --git a/src/lib/Neuron/Markdown.hs b/src/lib/Neuron/Markdown.hs
index 99c1093a1..70274a47a 100644
--- a/src/lib/Neuron/Markdown.hs
+++ b/src/lib/Neuron/Markdown.hs
@@ -74,7 +74,12 @@ data MarkdownLink = MarkdownLink
   { markdownLinkText :: Text,
     markdownLinkUri :: URI.URI
   }
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Show)
+
+markdownLinkFrom :: Text -> Text -> Maybe MarkdownLink
+markdownLinkFrom linkText url = do
+  uri <- URI.mkURI url
+  pure $ MarkdownLink linkText uri
 
 extractAutoLinks :: Pandoc -> [MarkdownLink]
 extractAutoLinks = W.query go
@@ -83,16 +88,14 @@ extractAutoLinks = W.query go
     go = \case
       (B.Link _attr [B.Str linkText] (url, _title))
         | linkText == url -> maybeToList $ do
-          uri <- URI.mkURI url
-          pure $ MarkdownLink linkText uri
+          markdownLinkFrom linkText url
       _ -> []
 
 -- | Return the link in the given inline.
 pandocLinkInline :: B.Inline -> Maybe MarkdownLink
 pandocLinkInline = \case
   (B.Link _attr [B.Str linkText] (url, _title)) -> do
-    uri <- URI.mkURI url
-    pure $ MarkdownLink linkText uri
+    markdownLinkFrom linkText url
   _ -> Nothing
 
 -- | Like `pandocLinkInline` but expects the link to be on a paragraph of its
@@ -100,8 +103,7 @@ pandocLinkInline = \case
 pandocLinkBlock :: B.Block -> Maybe MarkdownLink
 pandocLinkBlock = \case
   B.Para [B.Link _attr [B.Str linkText] (url, _title)] -> do
-    uri <- URI.mkURI url
-    pure $ MarkdownLink linkText uri
+    markdownLinkFrom linkText url
   _ -> Nothing
 
 getFirstParagraphText :: Pandoc -> Maybe [B.Inline]
diff --git a/src/lib/Neuron/Zettelkasten/Query/Eval.hs b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
index e71267e91..79a0df1e6 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Eval.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
@@ -9,6 +9,7 @@
 
 module Neuron.Zettelkasten.Query.Eval
   ( expandQueries,
+    evalQueryLink,
   )
 where
 
@@ -20,13 +21,32 @@ import Neuron.Markdown
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Query.Error
-import Neuron.Zettelkasten.Query.Parser (queryFromMarkdownLink)
-import Neuron.Zettelkasten.Query.View (buildQueryView)
+import Neuron.Zettelkasten.Query.Parser (queryFromMarkdownLink, queryFromURILink)
 import Neuron.Zettelkasten.Zettel
+import Reflex.Dom.Pandoc (URILink)
 import Relude
-import qualified Text.Pandoc.Builder as B
 import qualified Text.Pandoc.Walk as W
 
+-- | Evaluate the given query link and return its results.
+--
+-- Return Nothing if the link is not a query.
+--
+-- We need the full list of zettels, for running the query against.
+evalQueryLink ::
+  ( MonadError QueryParseError m,
+    MonadReader [Zettel] m
+  ) =>
+  URILink ->
+  m (Maybe (DSum Query Identity))
+evalQueryLink link = do
+  mq <- queryFromURILink link
+  case mq of
+    Nothing -> pure Nothing
+    Just someQ -> fmap Just $ do
+      withSome someQ $ \q -> do
+        zs <- ask
+        pure $ q :=> Identity (runQuery zs q)
+
 -- | Expand query links in the Pandoc document.
 --
 -- * Report any errors via MonadError
@@ -34,47 +54,39 @@ import qualified Text.Pandoc.Walk as W
 -- * Do a two-stage transform, to handle block links and inline links separately.
 expandQueries ::
   forall m.
-  (MonadError QueryError m, MonadReader [Zettel] m, MonadWriter [(Maybe Connection, Zettel)] m) =>
+  ( MonadError QueryError m,
+    -- Running queries requires the zettels list.
+    MonadReader [Zettel] m,
+    -- Report back connections formed by (running) the queries
+    MonadWriter [(Maybe Connection, Zettel)] m
+  ) =>
   Zettel ->
   m Zettel
 expandQueries z@Zettel {..} = do
-  -- Transform block links (paragraph with one link)
-  -- Only block links can contain multi-zettel queries as they produce Block (not Inline) view.
-  ast1 <- flip W.walkM zettelContent $ \blk ->
-    case pandocLinkBlock blk of
-      Just ml -> do
-        expandAST ml >>= \case
-          Just (Right newBlk) -> pure newBlk
-          _ -> pure blk
-      _ -> pure blk
-  -- Transform the rest (by scanning all inline links)
-  ast2 <- flip W.walkM ast1 $ \inline ->
+  void $ flip W.walkM zettelContent $ \inline -> do
     case pandocLinkInline inline of
       Just ml -> do
-        expandAST ml >>= \case
-          Just (Left newInline) -> pure newInline
-          _ -> pure inline
-      _ -> pure inline
-  pure $ z {zettelContent = ast2}
+        void $ expandAST ml
+      _ ->
+        pure ()
+    pure inline
+  pure z
   where
     -- Replace the link node with the query result AST node.
     --
     -- Depending on the link time, we replace with an inline or a block.
-    expandAST :: MarkdownLink -> m (Maybe (Either B.Inline B.Block))
+    expandAST :: MarkdownLink -> m ()
     expandAST ml = do
       mq <- liftEither $ runExcept $ withExceptT Left (queryFromMarkdownLink ml)
       case mq of
-        Nothing -> pure Nothing
-        Just someQ -> fmap Just $ do
+        Nothing -> pure ()
+        Just someQ -> do
           qres <- withSome someQ $ \q -> do
             zs <- ask
             -- run query using data from MonadReader
             pure $ q :=> Identity (runQuery zs q)
           -- tell connections using MonadWriter
           tell $ getConnections qres
-          -- create Inline for ml here.
-          liftEither $ runExcept $ do
-            withExcept Right (buildQueryView qres)
     getConnections :: DSum Query Identity -> [(Maybe Connection, Zettel)]
     getConnections = \case
       Query_ZettelByID _ mconn :=> Identity mres ->
diff --git a/src/lib/Neuron/Zettelkasten/Query/Parser.hs b/src/lib/Neuron/Zettelkasten/Query/Parser.hs
index 4d5be45f3..09ed2862f 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Parser.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Parser.hs
@@ -2,8 +2,10 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -20,6 +22,7 @@ import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Query.Error
 import Neuron.Zettelkasten.Query.Theme
+import Reflex.Dom.Pandoc (URILink (..))
 import Relude
 import qualified Text.URI as URI
 import Text.URI.QQ (queryKey)
@@ -35,6 +38,10 @@ queryFromURI uri = do
   -- We are setting markdownLinkText to the URI to support the new short links
   queryFromMarkdownLink $ MarkdownLink {markdownLinkUri = uri, markdownLinkText = URI.render uri}
 
+queryFromURILink :: MonadError QueryParseError m => URILink -> m (Maybe (Some Query))
+queryFromURILink URILink {..} =
+  queryFromMarkdownLink $ MarkdownLink _uriLink_linkText _uriLink_uri
+
 queryFromMarkdownLink :: MonadError QueryParseError m => MarkdownLink -> m (Maybe (Some Query))
 queryFromMarkdownLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} =
   case fmap URI.unRText (URI.uriScheme uri) of
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index c28a1abd7..efc29f2c4 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -25,14 +27,19 @@ import Neuron.Zettelkasten.Query.Theme (LinkView (..))
 import Neuron.Zettelkasten.Query.View (tagUrl, zettelUrl)
 import Neuron.Zettelkasten.Zettel
 import Reflex.Dom.Core
-import Reflex.Dom.Pandoc.Document
+import Reflex.Dom.Pandoc
 import Relude
 
-renderZettelContent :: PandocBuilder t m => Zettel -> m ()
-renderZettelContent Zettel {..} = do
+renderZettelContent ::
+  forall t m.
+  (PandocBuilder t m) =>
+  (URILink -> m Bool) ->
+  Zettel ->
+  m ()
+renderZettelContent handleLink Zettel {..} = do
   divClass "ui raised top attached segment zettel-content" $ do
     elClass "h1" "header" $ text zettelTitle
-    elPandoc zettelContent
+    elPandoc (Config $ Just handleLink) zettelContent
     renderTags zettelTags
     whenJust zettelDay $ \day ->
       elAttr "div" ("class" =: "date" <> "title" =: "Zettel creation date") $ text $ show day

From 0d8d54864941641334423e4e3d5a33dfedc9da92 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 19:25:32 -0400
Subject: [PATCH 02/21] Refactor out Query/Eval.hs

---
 dep/reflex-dom-pandoc/github.json         |  4 +-
 src/app/Neuron/Web/Generate.hs            | 11 ++--
 src/lib/Neuron/Zettelkasten/Query/Eval.hs | 64 +++++++----------------
 3 files changed, 28 insertions(+), 51 deletions(-)

diff --git a/dep/reflex-dom-pandoc/github.json b/dep/reflex-dom-pandoc/github.json
index bc272eeef..4e442a909 100644
--- a/dep/reflex-dom-pandoc/github.json
+++ b/dep/reflex-dom-pandoc/github.json
@@ -3,6 +3,6 @@
   "repo": "reflex-dom-pandoc",
   "branch": "custom-link-render",
   "private": false,
-  "rev": "98306974da52f3d5c122ce6206895c98ca0ed5db",
-  "sha256": "0z2b27r7lrp3ryjcx93qz8w8422zbd0n0nmqgh9p4p9zlbnw5xw4"
+  "rev": "70574a511d8122744ce9b96a5e933c1c3bf24b9b",
+  "sha256": "0bz0d6jqpz90py5iap4qriq7b13v5n8ch24b825km3s1zsvwpkxg"
 }
diff --git a/src/app/Neuron/Web/Generate.hs b/src/app/Neuron/Web/Generate.hs
index 2c9708f63..d90e459ae 100644
--- a/src/app/Neuron/Web/Generate.hs
+++ b/src/app/Neuron/Web/Generate.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -14,7 +15,6 @@ module Neuron.Web.Generate
 where
 
 import Control.Monad.Except (MonadError, liftEither, runExceptT, withExceptT)
-import Control.Monad.Writer (runWriterT)
 import qualified Data.Graph.Labelled as G
 import Data.Traversable
 import Development.Shake
@@ -27,7 +27,7 @@ import Neuron.Zettelkasten.Error (NeuronError (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph.Type (ZettelGraph)
 import Neuron.Zettelkasten.ID (mkZettelID)
-import Neuron.Zettelkasten.Query.Eval (expandQueries)
+import Neuron.Zettelkasten.Query.Eval (queryConnections)
 import Neuron.Zettelkasten.Zettel (Zettel, ZettelT (..), mkZettelFromMarkdown)
 import Options.Applicative
 import Relude
@@ -92,8 +92,11 @@ mkZettelGraph ::
 mkZettelGraph zettels = do
   res :: [(Zettel, [(Maybe Connection, Zettel)])] <- liftEither =<< do
     flip runReaderT zettels $ runExceptT $ do
-      for zettels $ \z -> withExceptT (NeuronError_BadQuery (zettelID z)) $ do
-        runWriterT $ expandQueries z
+      -- TODO: re: Left; for Right, we must render the query, which only happens
+      -- in Web.View. How do we accumulate the errors?
+      for zettels $ \z -> fmap (z,) $ do
+        withExceptT (NeuronError_BadQuery (zettelID z) . Left) $ do
+          queryConnections (zettelContent z)
   let g :: ZettelGraph = G.mkGraphFrom (fst <$> res) $ flip concatMap res $ \(z1, conns) ->
         conns <&> \(c, z2) -> (connectionMonoid (fromMaybe Folgezettel c), z1, z2)
   pure g
diff --git a/src/lib/Neuron/Zettelkasten/Query/Eval.hs b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
index 79a0df1e6..664dd5d22 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Eval.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
@@ -5,27 +5,23 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Neuron.Zettelkasten.Query.Eval
-  ( expandQueries,
-    evalQueryLink,
-  )
-where
+module Neuron.Zettelkasten.Query.Eval where
 
 import Control.Monad.Except
 import Control.Monad.Writer
 import Data.Dependent.Sum
 import Data.Some
-import Neuron.Markdown
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Query.Error
-import Neuron.Zettelkasten.Query.Parser (queryFromMarkdownLink, queryFromURILink)
+import Neuron.Zettelkasten.Query.Parser (queryFromURILink)
 import Neuron.Zettelkasten.Zettel
-import Reflex.Dom.Pandoc (URILink)
+import Reflex.Dom.Pandoc.URILink (URILink, queryURILinks)
 import Relude
-import qualified Text.Pandoc.Walk as W
+import Text.Pandoc.Definition (Pandoc)
 
 -- | Evaluate the given query link and return its results.
 --
@@ -47,46 +43,24 @@ evalQueryLink link = do
         zs <- ask
         pure $ q :=> Identity (runQuery zs q)
 
--- | Expand query links in the Pandoc document.
---
--- * Report any errors via MonadError
--- * Write connections detected in MonadWriter
--- * Do a two-stage transform, to handle block links and inline links separately.
-expandQueries ::
+queryConnections ::
   forall m.
-  ( MonadError QueryError m,
+  ( MonadError QueryParseError m,
     -- Running queries requires the zettels list.
-    MonadReader [Zettel] m,
-    -- Report back connections formed by (running) the queries
-    MonadWriter [(Maybe Connection, Zettel)] m
+    MonadReader [Zettel] m
   ) =>
-  Zettel ->
-  m Zettel
-expandQueries z@Zettel {..} = do
-  void $ flip W.walkM zettelContent $ \inline -> do
-    case pandocLinkInline inline of
-      Just ml -> do
-        void $ expandAST ml
-      _ ->
-        pure ()
-    pure inline
-  pure z
+  Pandoc ->
+  m [(Maybe Connection, Zettel)]
+queryConnections doc = do
+  let uriLinks = queryURILinks doc
+  fmap concat $ forM uriLinks $ \ul ->
+    evalQueryLink ul >>= \case
+      Nothing -> pure []
+      Just res -> do
+        let cs = getConnections res
+        -- tell cs
+        pure cs
   where
-    -- Replace the link node with the query result AST node.
-    --
-    -- Depending on the link time, we replace with an inline or a block.
-    expandAST :: MarkdownLink -> m ()
-    expandAST ml = do
-      mq <- liftEither $ runExcept $ withExceptT Left (queryFromMarkdownLink ml)
-      case mq of
-        Nothing -> pure ()
-        Just someQ -> do
-          qres <- withSome someQ $ \q -> do
-            zs <- ask
-            -- run query using data from MonadReader
-            pure $ q :=> Identity (runQuery zs q)
-          -- tell connections using MonadWriter
-          tell $ getConnections qres
     getConnections :: DSum Query Identity -> [(Maybe Connection, Zettel)]
     getConnections = \case
       Query_ZettelByID _ mconn :=> Identity mres ->

From ddf9acbf01466685151cc8bfc75c4eadb6e53c6f Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 20:41:14 -0400
Subject: [PATCH 03/21] WIP propagate errors to top

---
 dep/reflex-dom-pandoc/github.json          |  4 +--
 src/app/Main.hs                            | 10 ++++--
 src/app/Neuron/Web/View.hs                 | 39 +++++++++++++---------
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 11 +++---
 4 files changed, 39 insertions(+), 25 deletions(-)

diff --git a/dep/reflex-dom-pandoc/github.json b/dep/reflex-dom-pandoc/github.json
index 4e442a909..78dc760c7 100644
--- a/dep/reflex-dom-pandoc/github.json
+++ b/dep/reflex-dom-pandoc/github.json
@@ -3,6 +3,6 @@
   "repo": "reflex-dom-pandoc",
   "branch": "custom-link-render",
   "private": false,
-  "rev": "70574a511d8122744ce9b96a5e933c1c3bf24b9b",
-  "sha256": "0bz0d6jqpz90py5iap4qriq7b13v5n8ch24b825km3s1zsvwpkxg"
+  "rev": "be882cbfc3747462df8c074fc1e99d36a9dcff58",
+  "sha256": "0csxpmd3f4bh2iiiark8wfvdzb4gwvg84wm079fnwjwrn3jirpgz"
 }
diff --git a/src/app/Main.hs b/src/app/Main.hs
index e99404adc..d5d83b4d2 100644
--- a/src/app/Main.hs
+++ b/src/app/Main.hs
@@ -17,10 +17,12 @@ import qualified Neuron.Config as Config
 import Neuron.Web.Generate (generateSite)
 import Neuron.Web.Route (Route (..))
 import Neuron.Web.View (renderRouteBody, renderRouteHead, style)
+import Neuron.Zettelkasten.Error (NeuronError)
 import Reflex.Dom.Core
 import Reflex.Dom.Pandoc.Document (PandocBuilder)
 import Relude
 import qualified Rib
+import Rib.Route
 
 main :: IO ()
 main = withUtf8 $ run generateMainSite
@@ -31,12 +33,16 @@ generateMainSite = do
   config <- Config.getConfig
   let writeHtmlRoute :: Route g a -> (g, a) -> Action ()
       writeHtmlRoute r x = do
-        html <- liftIO $ fmap snd $ renderStatic $ renderPage config r x
+        (errors, html) <- liftIO $ renderStatic $ renderPage config r x
         -- FIXME: Make rib take bytestrings
         Rib.writeRoute r $ decodeUtf8 @Text html
+        unless (null errors) $ do
+          putStrLn $ "E " <> fromMaybe "Unknown path" (routeFile r)
+          forM_ errors $ \err ->
+            putStrLn $ "  " <> show err
   void $ generateSite config writeHtmlRoute
 
-renderPage :: PandocBuilder t m => Config -> Route g a -> (g, a) -> m ()
+renderPage :: PandocBuilder t m => Config -> Route g a -> (g, a) -> m [NeuronError]
 renderPage config r val = elAttr "html" ("lang" =: "en") $ do
   el "head" $ do
     renderRouteHead config r val
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index d7f3af2fe..9720a0932 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -39,6 +39,7 @@ import Neuron.Version (neuronVersion)
 import Neuron.Web.Route
 import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Connection
+import Neuron.Zettelkasten.Error (NeuronError (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName, zettelIDText)
@@ -124,17 +125,18 @@ renderOpenGraph OpenGraph {..} = do
         then f $ URI.render uri'
         else error $ description <> " must be absolute. this URI is not: " <> URI.render uri'
 
-renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m ()
+renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m [NeuronError]
 renderRouteBody config r (g, x) = do
   case r of
     Route_ZIndex ->
-      renderIndex config g
+      renderIndex config g >> pure mempty
     Route_Search {} ->
-      renderSearch config g
+      renderSearch config g >> pure mempty
     Route_Zettel _ ->
       renderZettel config (g, x)
-    Route_Redirect _ ->
+    Route_Redirect _ -> do
       elAttr "meta" ("http-equiv" =: "Refresh" <> "content" =: ("0; url=" <> (Rib.routeUrlRel $ Route_Zettel x))) blank
+      pure mempty
 
 renderIndex :: DomBuilder t m => Config -> ZettelGraph -> m ()
 renderIndex config@Config {..} graph = divClass "ui text container" $ do
@@ -187,7 +189,7 @@ renderSearch config graph = divClass "ui text container" $ do
   renderFooter config graph Nothing
   renderBrandFooter
 
-renderZettel :: PandocBuilder t m => Config -> (ZettelGraph, Zettel) -> m ()
+renderZettel :: PandocBuilder t m => Config -> (ZettelGraph, Zettel) -> m [NeuronError]
 renderZettel config (graph, z@Zettel {..}) = do
   let upTree = G.backlinkForest Folgezettel z graph
   whenNotNull upTree $ \_ -> do
@@ -196,31 +198,34 @@ renderZettel config (graph, z@Zettel {..}) = do
         el "li" $ do
           el "ul" $ do
             renderUplinkForest (\z2 -> G.getConnection z z2 graph) upTree
-  elAttr "div" ("class" =: "ui text container" <> "id" =: "zettel-container" <> "style" =: "position: relative") $ do
+  errors <- elAttr "div" ("class" =: "ui text container" <> "id" =: "zettel-container" <> "style" =: "position: relative") $ do
     -- zettel-container-anchor is a trick used by the scrollIntoView JS below
     -- cf. https://stackoverflow.com/a/49968820/55246
     elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
     divClass "zettel-view" $ do
-      flip ZettelView.renderZettelContent z $ \uriLink -> do
+      pandocRes <- flip ZettelView.renderZettelContent z $ \oldRender uriLink -> do
         case flip runReaderT (G.getZettels graph) (Q.evalQueryLink uriLink) of
-          Left e -> do
+          Left (NeuronError_BadQuery zettelID . Left -> e) -> do
             -- TODO: show the error in terminal, or better report it correctly.
             -- see github issue.
-            divClass "ui error message" $ text $ show e
-            pure False
+            divClass "ui error message" $ do
+              text $ show e
+            fmap (e :) oldRender
           Right Nothing -> do
-            pure False
+            oldRender
           Right (Just res) -> do
+            -- TODO: This should render in reflex-dom (no via pandoc's builder)
             case Q.buildQueryView res of
-              Left e -> do
-                divClass "ui error message" $ text $ show e
-                pure False
+              Left (NeuronError_BadQuery zettelID . Right -> e) -> do
+                divClass "ui error message" $ do
+                  text $ show e
+                fmap (e :) oldRender
               Right (Left w) -> do
                 elPandocInlines [w]
-                pure True
+                pure mempty
               Right (Right w) -> do
                 elPandocBlocks [w]
-                pure True
+                pure mempty
       let cfBacklinks = G.backlinks OrdinaryConnection z graph
       whenNotNull cfBacklinks $ \_ -> divClass "ui attached segment deemphasized" $ do
         elAttr "div" ("class" =: "ui header" <> title =: "Zettels that link here, but without branching") $
@@ -229,6 +234,7 @@ renderZettel config (graph, z@Zettel {..}) = do
           forM_ cfBacklinks $ \zl ->
             el "li" $ ZettelView.renderZettelLink Nothing def zl
       renderFooter config graph (Just z)
+      pure pandocRes
   renderBrandFooter
   -- Because the tree above can be pretty large, we scroll past it
   -- automatically when the page loads.
@@ -237,6 +243,7 @@ renderZettel config (graph, z@Zettel {..}) = do
   -- loaded (thus the browser doesn't known the final height yet.)
   el "script" $ text $
     "document.getElementById(\"zettel-container-anchor\").scrollIntoView({behavior: \"smooth\", block: \"start\"});"
+  pure errors
 
 renderFooter :: DomBuilder t m => Config -> ZettelGraph -> Maybe Zettel -> m ()
 renderFooter Config {..} graph mzettel = do
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index efc29f2c4..17cb5b72f 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -31,18 +31,19 @@ import Reflex.Dom.Pandoc
 import Relude
 
 renderZettelContent ::
-  forall t m.
-  (PandocBuilder t m) =>
-  (URILink -> m Bool) ->
+  forall t m a.
+  (PandocBuilder t m, Monoid a) =>
+  (m a -> URILink -> m a) ->
   Zettel ->
-  m ()
+  m a
 renderZettelContent handleLink Zettel {..} = do
   divClass "ui raised top attached segment zettel-content" $ do
     elClass "h1" "header" $ text zettelTitle
-    elPandoc (Config $ Just handleLink) zettelContent
+    x <- elPandoc (Config handleLink) zettelContent
     renderTags zettelTags
     whenJust zettelDay $ \day ->
       elAttr "div" ("class" =: "date" <> "title" =: "Zettel creation date") $ text $ show day
+    pure x
 
 renderTags :: DomBuilder t m => [Tag] -> m ()
 renderTags tags = do

From e008260f4e0060aaed76f9cedc52baf687769ab3 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 20:47:24 -0400
Subject: [PATCH 04/21] Cleanup

---
 src/lib/Neuron/Markdown.hs                | 30 -----------------------
 src/lib/Neuron/Zettelkasten/Query/Eval.hs | 21 ++++++----------
 2 files changed, 8 insertions(+), 43 deletions(-)

diff --git a/src/lib/Neuron/Markdown.hs b/src/lib/Neuron/Markdown.hs
index 70274a47a..1488176ec 100644
--- a/src/lib/Neuron/Markdown.hs
+++ b/src/lib/Neuron/Markdown.hs
@@ -76,36 +76,6 @@ data MarkdownLink = MarkdownLink
   }
   deriving (Eq, Ord, Show)
 
-markdownLinkFrom :: Text -> Text -> Maybe MarkdownLink
-markdownLinkFrom linkText url = do
-  uri <- URI.mkURI url
-  pure $ MarkdownLink linkText uri
-
-extractAutoLinks :: Pandoc -> [MarkdownLink]
-extractAutoLinks = W.query go
-  where
-    go :: B.Inline -> [MarkdownLink]
-    go = \case
-      (B.Link _attr [B.Str linkText] (url, _title))
-        | linkText == url -> maybeToList $ do
-          markdownLinkFrom linkText url
-      _ -> []
-
--- | Return the link in the given inline.
-pandocLinkInline :: B.Inline -> Maybe MarkdownLink
-pandocLinkInline = \case
-  (B.Link _attr [B.Str linkText] (url, _title)) -> do
-    markdownLinkFrom linkText url
-  _ -> Nothing
-
--- | Like `pandocLinkInline` but expects the link to be on a paragraph of its
--- own.
-pandocLinkBlock :: B.Block -> Maybe MarkdownLink
-pandocLinkBlock = \case
-  B.Para [B.Link _attr [B.Str linkText] (url, _title)] -> do
-    markdownLinkFrom linkText url
-  _ -> Nothing
-
 getFirstParagraphText :: Pandoc -> Maybe [B.Inline]
 getFirstParagraphText = listToMaybe . W.query go
   where
diff --git a/src/lib/Neuron/Zettelkasten/Query/Eval.hs b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
index 664dd5d22..667949ff6 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Eval.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
@@ -34,14 +34,14 @@ evalQueryLink ::
   ) =>
   URILink ->
   m (Maybe (DSum Query Identity))
-evalQueryLink link = do
-  mq <- queryFromURILink link
-  case mq of
+evalQueryLink link =
+  queryFromURILink link >>= \case
     Nothing -> pure Nothing
     Just someQ -> fmap Just $ do
       withSome someQ $ \q -> do
         zs <- ask
-        pure $ q :=> Identity (runQuery zs q)
+        let res = runQuery zs q
+        pure $ q :=> Identity res
 
 queryConnections ::
   forall m.
@@ -51,15 +51,10 @@ queryConnections ::
   ) =>
   Pandoc ->
   m [(Maybe Connection, Zettel)]
-queryConnections doc = do
-  let uriLinks = queryURILinks doc
-  fmap concat $ forM uriLinks $ \ul ->
-    evalQueryLink ul >>= \case
-      Nothing -> pure []
-      Just res -> do
-        let cs = getConnections res
-        -- tell cs
-        pure cs
+queryConnections doc =
+  fmap concat $ forM (queryURILinks doc) $ \ul -> do
+    mres <- evalQueryLink ul
+    pure $ maybe [] getConnections mres
   where
     getConnections :: DSum Query Identity -> [(Maybe Connection, Zettel)]
     getConnections = \case

From 6e73b8cf994e4f98f38ea499986c69b6c9ce31da Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 20:54:14 -0400
Subject: [PATCH 05/21] Avoid duplication as much as possible in footer code

---
 src/app/Neuron/Web/View.hs | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index 9720a0932..7d22d69ca 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -128,18 +128,28 @@ renderOpenGraph OpenGraph {..} = do
 renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m [NeuronError]
 renderRouteBody config r (g, x) = do
   case r of
-    Route_ZIndex ->
-      renderIndex config g >> pure mempty
-    Route_Search {} ->
-      renderSearch config g >> pure mempty
-    Route_Zettel _ ->
-      renderZettel config (g, x)
+    Route_ZIndex -> do
+      divClass "ui text container" $ do
+        renderIndex config g
+        renderFooter config g Nothing
+        renderBrandFooter
+      pure mempty
+    Route_Search {} -> do
+      divClass "ui text container" $ do
+        renderSearch g
+        renderFooter config g Nothing
+        renderBrandFooter
+      pure mempty
+    Route_Zettel _ -> do
+      errs <- renderZettel config (g, x)
+      renderBrandFooter
+      pure errs
     Route_Redirect _ -> do
       elAttr "meta" ("http-equiv" =: "Refresh" <> "content" =: ("0; url=" <> (Rib.routeUrlRel $ Route_Zettel x))) blank
       pure mempty
 
 renderIndex :: DomBuilder t m => Config -> ZettelGraph -> m ()
-renderIndex config@Config {..} graph = divClass "ui text container" $ do
+renderIndex Config {..} graph = do
   let neuronTheme = Theme.mkTheme theme
   elClass "h1" "header" $ text "Zettel Index"
   divClass "z-index" $ do
@@ -158,15 +168,13 @@ renderIndex config@Config {..} graph = divClass "ui text container" $ do
       divClass ("ui " <> Theme.semanticColor neuronTheme <> " segment") $ do
         -- Forest of zettels, beginning with mother vertices.
         el "ul" $ renderForest True Nothing (Just graph) forest
-    renderFooter config graph Nothing
-    renderBrandFooter
   where
     countNounBe noun nounPlural = \case
       1 -> "is 1 " <> noun
       n -> "are " <> show n <> " " <> nounPlural
 
-renderSearch :: DomBuilder t m => Config -> ZettelGraph -> m ()
-renderSearch config graph = divClass "ui text container" $ do
+renderSearch :: DomBuilder t m => ZettelGraph -> m ()
+renderSearch graph = do
   elClass "h1" "header" $ text "Search"
   divClass "ui fluid icon input search" $ do
     elAttr "input" ("type" =: "text" <> "id" =: "search-input") blank
@@ -186,8 +194,6 @@ renderSearch config graph = divClass "ui text container" $ do
   elAttr "ul" ("id" =: "search-results" <> "class" =: "zettel-list") blank
   el "script" $ text $ "let index = " <> toText (Aeson.encodeToLazyText index) <> ";"
   el "script" $ text searchScript
-  renderFooter config graph Nothing
-  renderBrandFooter
 
 renderZettel :: PandocBuilder t m => Config -> (ZettelGraph, Zettel) -> m [NeuronError]
 renderZettel config (graph, z@Zettel {..}) = do
@@ -198,6 +204,7 @@ renderZettel config (graph, z@Zettel {..}) = do
         el "li" $ do
           el "ul" $ do
             renderUplinkForest (\z2 -> G.getConnection z z2 graph) upTree
+  -- Main content
   errors <- elAttr "div" ("class" =: "ui text container" <> "id" =: "zettel-container" <> "style" =: "position: relative") $ do
     -- zettel-container-anchor is a trick used by the scrollIntoView JS below
     -- cf. https://stackoverflow.com/a/49968820/55246
@@ -235,7 +242,6 @@ renderZettel config (graph, z@Zettel {..}) = do
             el "li" $ ZettelView.renderZettelLink Nothing def zl
       renderFooter config graph (Just z)
       pure pandocRes
-  renderBrandFooter
   -- Because the tree above can be pretty large, we scroll past it
   -- automatically when the page loads.
   -- TODO: Do this only if we have rendered the tree.

From 55dd0ef6a7633abec01ec4da99b36767d12925c3 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 21:08:23 -0400
Subject: [PATCH 06/21] Move whole zettel rendering to Zettel/View.hs

---
 neuron.cabal                                  |   2 +-
 src/app/Neuron/Web/View.hs                    | 101 +---------------
 src/{app => lib}/Neuron/Zettelkasten/Error.hs |   0
 src/lib/Neuron/Zettelkasten/Zettel/View.hs    | 110 ++++++++++++++++++
 4 files changed, 116 insertions(+), 97 deletions(-)
 rename src/{app => lib}/Neuron/Zettelkasten/Error.hs (100%)

diff --git a/neuron.cabal b/neuron.cabal
index cc7daab92..f51d36697 100644
--- a/neuron.cabal
+++ b/neuron.cabal
@@ -85,6 +85,7 @@ library
     Neuron.Zettelkasten.Query.View
     Neuron.Zettelkasten.Graph
     Neuron.Zettelkasten.Graph.Type
+    Neuron.Zettelkasten.Error
     Neuron.Web.Theme
     Text.Megaparsec.Simple
     Text.URI.Util
@@ -156,7 +157,6 @@ common app-common
       Neuron.Web.Route
       Neuron.Web.View
       Neuron.Markdown
-      Neuron.Zettelkasten.Error
       Neuron.Zettelkasten.ID.Scheme
       Paths_neuron
       Text.Megaparsec.Simple
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index 7d22d69ca..f16cceef3 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -42,13 +42,11 @@ import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.Error (NeuronError (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph (ZettelGraph)
-import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName, zettelIDText)
-import qualified Neuron.Zettelkasten.Query.Eval as Q
-import qualified Neuron.Zettelkasten.Query.View as Q
+import Neuron.Zettelkasten.ID (zettelIDText)
 import Neuron.Zettelkasten.Zettel
 import qualified Neuron.Zettelkasten.Zettel.View as ZettelView
 import Reflex.Dom.Core hiding ((&))
-import Reflex.Dom.Pandoc (PandocBuilder, elPandocBlocks, elPandocInlines)
+import Reflex.Dom.Pandoc (PandocBuilder)
 import Relude hiding ((&))
 import qualified Rib
 import Rib.Extra.OpenGraph
@@ -131,17 +129,17 @@ renderRouteBody config r (g, x) = do
     Route_ZIndex -> do
       divClass "ui text container" $ do
         renderIndex config g
-        renderFooter config g Nothing
+        ZettelView.renderFooter (editUrl config) g Nothing
         renderBrandFooter
       pure mempty
     Route_Search {} -> do
       divClass "ui text container" $ do
         renderSearch g
-        renderFooter config g Nothing
+        ZettelView.renderFooter (editUrl config) g Nothing
         renderBrandFooter
       pure mempty
     Route_Zettel _ -> do
-      errs <- renderZettel config (g, x)
+      errs <- ZettelView.renderZettel (editUrl config) (g, x)
       renderBrandFooter
       pure errs
     Route_Redirect _ -> do
@@ -195,79 +193,6 @@ renderSearch graph = do
   el "script" $ text $ "let index = " <> toText (Aeson.encodeToLazyText index) <> ";"
   el "script" $ text searchScript
 
-renderZettel :: PandocBuilder t m => Config -> (ZettelGraph, Zettel) -> m [NeuronError]
-renderZettel config (graph, z@Zettel {..}) = do
-  let upTree = G.backlinkForest Folgezettel z graph
-  whenNotNull upTree $ \_ -> do
-    elAttr "div" ("class" =: "flipped tree deemphasized" <> "id" =: "zettel-uptree" <> "style" =: "transform-origin: 50%") $ do
-      elClass "ul" "root" $ do
-        el "li" $ do
-          el "ul" $ do
-            renderUplinkForest (\z2 -> G.getConnection z z2 graph) upTree
-  -- Main content
-  errors <- elAttr "div" ("class" =: "ui text container" <> "id" =: "zettel-container" <> "style" =: "position: relative") $ do
-    -- zettel-container-anchor is a trick used by the scrollIntoView JS below
-    -- cf. https://stackoverflow.com/a/49968820/55246
-    elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
-    divClass "zettel-view" $ do
-      pandocRes <- flip ZettelView.renderZettelContent z $ \oldRender uriLink -> do
-        case flip runReaderT (G.getZettels graph) (Q.evalQueryLink uriLink) of
-          Left (NeuronError_BadQuery zettelID . Left -> e) -> do
-            -- TODO: show the error in terminal, or better report it correctly.
-            -- see github issue.
-            divClass "ui error message" $ do
-              text $ show e
-            fmap (e :) oldRender
-          Right Nothing -> do
-            oldRender
-          Right (Just res) -> do
-            -- TODO: This should render in reflex-dom (no via pandoc's builder)
-            case Q.buildQueryView res of
-              Left (NeuronError_BadQuery zettelID . Right -> e) -> do
-                divClass "ui error message" $ do
-                  text $ show e
-                fmap (e :) oldRender
-              Right (Left w) -> do
-                elPandocInlines [w]
-                pure mempty
-              Right (Right w) -> do
-                elPandocBlocks [w]
-                pure mempty
-      let cfBacklinks = G.backlinks OrdinaryConnection z graph
-      whenNotNull cfBacklinks $ \_ -> divClass "ui attached segment deemphasized" $ do
-        elAttr "div" ("class" =: "ui header" <> title =: "Zettels that link here, but without branching") $
-          text "More backlinks"
-        el "ul" $ do
-          forM_ cfBacklinks $ \zl ->
-            el "li" $ ZettelView.renderZettelLink Nothing def zl
-      renderFooter config graph (Just z)
-      pure pandocRes
-  -- Because the tree above can be pretty large, we scroll past it
-  -- automatically when the page loads.
-  -- TODO: Do this only if we have rendered the tree.
-  -- FIXME: This may not scroll sufficiently if the images in the zettel haven't
-  -- loaded (thus the browser doesn't known the final height yet.)
-  el "script" $ text $
-    "document.getElementById(\"zettel-container-anchor\").scrollIntoView({behavior: \"smooth\", block: \"start\"});"
-  pure errors
-
-renderFooter :: DomBuilder t m => Config -> ZettelGraph -> Maybe Zettel -> m ()
-renderFooter Config {..} graph mzettel = do
-  let attachClass = maybe "" (const "bottom attached") mzettel
-  divClass ("ui inverted black " <> attachClass <> " footer segment") $ do
-    divClass "ui equal width grid" $ do
-      divClass "center aligned column" $ do
-        let homeUrl = maybe "." (const "index.html") $ G.getZettel (ZettelCustomID "index") graph
-        elAttr "a" ("href" =: homeUrl <> "title" =: "/") $ fa "fas fa-home"
-      whenJust ((,) <$> mzettel <*> editUrl) $ \(Zettel {..}, urlPrefix) ->
-        divClass "center aligned column" $ do
-          elAttr "a" ("href" =: (urlPrefix <> toText (zettelIDSourceFileName zettelID)) <> "title" =: "Edit this Zettel") $ fa "fas fa-edit"
-      divClass "center aligned column" $ do
-        elAttr "a" ("href" =: (Rib.routeUrlRel Route_Search) <> "title" =: "Search Zettels") $ fa "fas fa-search"
-      divClass "center aligned column" $ do
-        elAttr "a" ("href" =: (Rib.routeUrlRel Route_ZIndex) <> "title" =: "All Zettels (z-index)") $
-          fa "fas fa-tree"
-
 renderBrandFooter :: DomBuilder t m => m ()
 renderBrandFooter =
   divClass "ui one column grid footer-version" $ do
@@ -318,22 +243,6 @@ renderForest isRoot maxLevel mg trees =
     -- Sort trees so that trees containing the most recent zettel (by ID) come first.
     sortForest = reverse . sortOn maximum
 
-renderUplinkForest ::
-  DomBuilder t m =>
-  (Zettel -> Maybe Connection) ->
-  [Tree Zettel] ->
-  m ()
-renderUplinkForest getConn trees = do
-  forM_ (sortForest trees) $ \(Node zettel subtrees) ->
-    el "li" $ do
-      divClass "forest-link" $
-        ZettelView.renderZettelLink (getConn zettel) def zettel
-      when (length subtrees > 0) $ do
-        el "ul" $ renderUplinkForest getConn subtrees
-  where
-    -- Sort trees so that trees containing the most recent zettel (by ID) come first.
-    sortForest = reverse . sortOn maximum
-
 style :: Config -> Css
 style Config {..} = do
   let neuronTheme = Theme.mkTheme theme
diff --git a/src/app/Neuron/Zettelkasten/Error.hs b/src/lib/Neuron/Zettelkasten/Error.hs
similarity index 100%
rename from src/app/Neuron/Zettelkasten/Error.hs
rename to src/lib/Neuron/Zettelkasten/Error.hs
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index 17cb5b72f..918b904c8 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -11,6 +11,8 @@
 module Neuron.Zettelkasten.Zettel.View
   ( renderZettelContent,
     renderZettelLink,
+    renderZettel,
+    renderFooter,
     zettelCss,
     zettelLinkCss,
   )
@@ -19,17 +21,125 @@ where
 import Clay ((?), auto, em, pct, pre, px, sym, sym2)
 import Clay (Css)
 import qualified Clay as C
+import Data.Foldable (maximum)
 import Data.TagTree
 import qualified Data.Text as T
+import Data.Tree (Tree (..))
 import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Connection
+import Neuron.Zettelkasten.Error (NeuronError (..))
+import Neuron.Zettelkasten.Graph (ZettelGraph)
+import qualified Neuron.Zettelkasten.Graph as G
+import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName)
+import qualified Neuron.Zettelkasten.Query.Eval as Q
 import Neuron.Zettelkasten.Query.Theme (LinkView (..))
+import qualified Neuron.Zettelkasten.Query.View as Q
 import Neuron.Zettelkasten.Query.View (tagUrl, zettelUrl)
 import Neuron.Zettelkasten.Zettel
 import Reflex.Dom.Core
 import Reflex.Dom.Pandoc
 import Relude
 
+renderZettel :: PandocBuilder t m => Maybe Text -> (ZettelGraph, Zettel) -> m [NeuronError]
+renderZettel editUrl (graph, z@Zettel {..}) = do
+  let upTree = G.backlinkForest Folgezettel z graph
+  whenNotNull upTree $ \_ -> do
+    elAttr "div" ("class" =: "flipped tree deemphasized" <> "id" =: "zettel-uptree" <> "style" =: "transform-origin: 50%") $ do
+      elClass "ul" "root" $ do
+        el "li" $ do
+          el "ul" $ do
+            renderUplinkForest (\z2 -> G.getConnection z z2 graph) upTree
+  -- Main content
+  errors <- elAttr "div" ("class" =: "ui text container" <> "id" =: "zettel-container" <> "style" =: "position: relative") $ do
+    -- zettel-container-anchor is a trick used by the scrollIntoView JS below
+    -- cf. https://stackoverflow.com/a/49968820/55246
+    elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
+    divClass "zettel-view" $ do
+      errors <- renderZettelContent (handleZettelQuery graph zettelID) z
+      let cfBacklinks = G.backlinks OrdinaryConnection z graph
+      whenNotNull cfBacklinks $ \_ -> divClass "ui attached segment deemphasized" $ do
+        elAttr "div" ("class" =: "ui header" <> "title" =: "Zettels that link here, but without branching") $
+          text "More backlinks"
+        el "ul" $ do
+          forM_ cfBacklinks $ \zl ->
+            el "li" $ renderZettelLink Nothing def zl
+      renderFooter editUrl graph (Just z)
+      pure errors
+  -- Because the tree above can be pretty large, we scroll past it
+  -- automatically when the page loads.
+  -- TODO: Do this only if we have rendered the tree.
+  -- FIXME: This may not scroll sufficiently if the images in the zettel haven't
+  -- loaded (thus the browser doesn't known the final height yet.)
+  el "script" $ text $
+    "document.getElementById(\"zettel-container-anchor\").scrollIntoView({behavior: \"smooth\", block: \"start\"});"
+  pure errors
+
+handleZettelQuery ::
+  (PandocRawConstraints m, DomBuilder t m, PandocRaw m) =>
+  ZettelGraph ->
+  ZettelID ->
+  m [NeuronError] ->
+  URILink ->
+  m [NeuronError]
+handleZettelQuery graph zettelID oldRender uriLink = do
+  case flip runReaderT (G.getZettels graph) (Q.evalQueryLink uriLink) of
+    Left (NeuronError_BadQuery zettelID . Left -> e) -> do
+      -- TODO: show the error in terminal, or better report it correctly.
+      -- see github issue.
+      divClass "ui error message" $ do
+        text $ show e
+      fmap (e :) oldRender
+    Right Nothing -> do
+      oldRender
+    Right (Just res) -> do
+      -- TODO: This should render in reflex-dom (no via pandoc's builder)
+      case Q.buildQueryView res of
+        Left (NeuronError_BadQuery zettelID . Right -> e) -> do
+          divClass "ui error message" $ do
+            text $ show e
+          fmap (e :) oldRender
+        Right (Left w) -> do
+          elPandocInlines [w]
+          pure mempty
+        Right (Right w) -> do
+          elPandocBlocks [w]
+          pure mempty
+
+renderUplinkForest ::
+  DomBuilder t m =>
+  (Zettel -> Maybe Connection) ->
+  [Tree Zettel] ->
+  m ()
+renderUplinkForest getConn trees = do
+  forM_ (sortForest trees) $ \(Node zettel subtrees) ->
+    el "li" $ do
+      divClass "forest-link" $
+        renderZettelLink (getConn zettel) def zettel
+      when (length subtrees > 0) $ do
+        el "ul" $ renderUplinkForest getConn subtrees
+  where
+    -- Sort trees so that trees containing the most recent zettel (by ID) come first.
+    sortForest = reverse . sortOn maximum
+
+renderFooter :: DomBuilder t m => Maybe Text -> ZettelGraph -> Maybe Zettel -> m ()
+renderFooter editUrl graph mzettel = do
+  let attachClass = maybe "" (const "bottom attached") mzettel
+  divClass ("ui inverted black " <> attachClass <> " footer segment") $ do
+    divClass "ui equal width grid" $ do
+      divClass "center aligned column" $ do
+        let homeUrl = maybe "." (const "index.html") $ G.getZettel (ZettelCustomID "index") graph
+        elAttr "a" ("href" =: homeUrl <> "title" =: "/") $ fa "fas fa-home"
+      whenJust ((,) <$> mzettel <*> editUrl) $ \(Zettel {..}, urlPrefix) ->
+        divClass "center aligned column" $ do
+          elAttr "a" ("href" =: (urlPrefix <> toText (zettelIDSourceFileName zettelID)) <> "title" =: "Edit this Zettel") $ fa "fas fa-edit"
+      divClass "center aligned column" $ do
+        elAttr "a" ("href" =: "search.html" <> "title" =: "Search Zettels") $ fa "fas fa-search"
+      divClass "center aligned column" $ do
+        elAttr "a" ("href" =: "z-index.html" <> "title" =: "All Zettels (z-index)") $
+          fa "fas fa-tree"
+  where
+    fa k = elClass "i" k blank
+
 renderZettelContent ::
   forall t m a.
   (PandocBuilder t m, Monoid a) =>

From f414fc9a7841fd924c248c6a00be22ea02d75a1f Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 21:24:56 -0400
Subject: [PATCH 07/21] Allow disabling auto scroll

---
 neuron.cabal                               |  1 +
 src/app/Neuron/Web/View.hs                 |  3 +-
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 42 +++++++++++++---------
 3 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/neuron.cabal b/neuron.cabal
index f51d36697..ea6ccf6a8 100644
--- a/neuron.cabal
+++ b/neuron.cabal
@@ -66,6 +66,7 @@ common library-common
     reflex-dom-core,
     reflex-dom-pandoc,
     clay,
+    tagged
 
 library
   import: library-common
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index f16cceef3..0496cdedd 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -32,6 +32,7 @@ import qualified Data.Set as Set
 import Data.Structured.Breadcrumb (Breadcrumb)
 import qualified Data.Structured.Breadcrumb as Breadcrumb
 import Data.TagTree (Tag (..))
+import Data.Tagged
 import Data.Time.ISO8601 (formatISO8601)
 import Data.Tree (Tree (..))
 import Neuron.Config
@@ -139,7 +140,7 @@ renderRouteBody config r (g, x) = do
         renderBrandFooter
       pure mempty
     Route_Zettel _ -> do
-      errs <- ZettelView.renderZettel (editUrl config) (g, x)
+      errs <- ZettelView.renderZettel (editUrl config) (Tagged True) (g, x)
       renderBrandFooter
       pure errs
     Route_Redirect _ -> do
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index 918b904c8..01c5c43ae 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -23,6 +24,7 @@ import Clay (Css)
 import qualified Clay as C
 import Data.Foldable (maximum)
 import Data.TagTree
+import Data.Tagged
 import qualified Data.Text as T
 import Data.Tree (Tree (..))
 import qualified Neuron.Web.Theme as Theme
@@ -40,38 +42,46 @@ import Reflex.Dom.Core
 import Reflex.Dom.Pandoc
 import Relude
 
-renderZettel :: PandocBuilder t m => Maybe Text -> (ZettelGraph, Zettel) -> m [NeuronError]
-renderZettel editUrl (graph, z@Zettel {..}) = do
+type AutoScroll = Tagged "autoScroll" Bool
+
+renderZettel :: PandocBuilder t m => Maybe Text -> AutoScroll -> (ZettelGraph, Zettel) -> m [NeuronError]
+renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
   let upTree = G.backlinkForest Folgezettel z graph
   whenNotNull upTree $ \_ -> do
-    elAttr "div" ("class" =: "flipped tree deemphasized" <> "id" =: "zettel-uptree" <> "style" =: "transform-origin: 50%") $ do
+    let attrs =
+          "class" =: "flipped tree deemphasized"
+            <> "id" =: "zettel-uptree"
+            <> "style" =: "transform-origin: 50%"
+    elAttr "div" attrs $ do
       elClass "ul" "root" $ do
         el "li" $ do
           el "ul" $ do
             renderUplinkForest (\z2 -> G.getConnection z z2 graph) upTree
   -- Main content
   errors <- elAttr "div" ("class" =: "ui text container" <> "id" =: "zettel-container" <> "style" =: "position: relative") $ do
-    -- zettel-container-anchor is a trick used by the scrollIntoView JS below
-    -- cf. https://stackoverflow.com/a/49968820/55246
-    elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
+    when autoScroll $ do
+      -- zettel-container-anchor is a trick used by the scrollIntoView JS below
+      -- cf. https://stackoverflow.com/a/49968820/55246
+      elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
     divClass "zettel-view" $ do
       errors <- renderZettelContent (handleZettelQuery graph zettelID) z
-      let cfBacklinks = G.backlinks OrdinaryConnection z graph
-      whenNotNull cfBacklinks $ \_ -> divClass "ui attached segment deemphasized" $ do
-        elAttr "div" ("class" =: "ui header" <> "title" =: "Zettels that link here, but without branching") $
-          text "More backlinks"
-        el "ul" $ do
-          forM_ cfBacklinks $ \zl ->
-            el "li" $ renderZettelLink Nothing def zl
+      whenNotNull (G.backlinks OrdinaryConnection z graph) $ \cfBacklinks -> do
+        divClass "ui attached segment deemphasized" $ do
+          elAttr "div" ("class" =: "ui header" <> "title" =: "Zettels that link here, but without branching") $
+            text "More backlinks"
+          el "ul" $ do
+            forM_ cfBacklinks $ \zl ->
+              el "li" $ renderZettelLink Nothing def zl
       renderFooter editUrl graph (Just z)
       pure errors
   -- Because the tree above can be pretty large, we scroll past it
   -- automatically when the page loads.
-  -- TODO: Do this only if we have rendered the tree.
   -- FIXME: This may not scroll sufficiently if the images in the zettel haven't
   -- loaded (thus the browser doesn't known the final height yet.)
-  el "script" $ text $
-    "document.getElementById(\"zettel-container-anchor\").scrollIntoView({behavior: \"smooth\", block: \"start\"});"
+  when (autoScroll && not (null upTree)) $ do
+    whenNotNull upTree $ \_ -> do
+      el "script" $ text $
+        "document.getElementById(\"zettel-container-anchor\").scrollIntoView({behavior: \"smooth\", block: \"start\"});"
   pure errors
 
 handleZettelQuery ::

From 096dfd2c8716381702887f4677f4df2064eede3a Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 21:25:15 -0400
Subject: [PATCH 08/21] nix: disable hoogle

---
 project.nix | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/project.nix b/project.nix
index 16584ed9a..269cede44 100644
--- a/project.nix
+++ b/project.nix
@@ -1,4 +1,4 @@
-{ system ? builtins.currentSystem }:
+{ system ? builtins.currentSystem, withHoogle ? false }:
 (import ./dep/reflex-platform { inherit system; }).project ({ pkgs, hackGet, ... }: 
 let 
   gitignoreSrc = pkgs.fetchFromGitHub { 
@@ -22,6 +22,8 @@ let
     '';
 
 in {
+  inherit withHoogle;
+
   shellToolOverrides = ghc: super: {
     inherit neuronSearchScript;
   };

From 1e0ca4e346bb6c4b26ed768089fcd894aa4a291f Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 21:34:43 -0400
Subject: [PATCH 09/21] remove MarkdownLink

---
 src/lib/Neuron/Markdown.hs                  | 7 -------
 src/lib/Neuron/Zettelkasten/Query/Parser.hs | 9 ++-------
 2 files changed, 2 insertions(+), 14 deletions(-)

diff --git a/src/lib/Neuron/Markdown.hs b/src/lib/Neuron/Markdown.hs
index 1488176ec..9eaa2ffb0 100644
--- a/src/lib/Neuron/Markdown.hs
+++ b/src/lib/Neuron/Markdown.hs
@@ -25,7 +25,6 @@ import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Definition (Pandoc (..))
 import qualified Text.Pandoc.Walk as W
 import qualified Text.Parsec as P
-import qualified Text.URI as URI
 
 -- | Parse Markdown document, along with the YAML metadata block in it.
 --
@@ -70,12 +69,6 @@ partitionMarkdown fn =
       b <- M.takeRest
       pure (a, b)
 
-data MarkdownLink = MarkdownLink
-  { markdownLinkText :: Text,
-    markdownLinkUri :: URI.URI
-  }
-  deriving (Eq, Ord, Show)
-
 getFirstParagraphText :: Pandoc -> Maybe [B.Inline]
 getFirstParagraphText = listToMaybe . W.query go
   where
diff --git a/src/lib/Neuron/Zettelkasten/Query/Parser.hs b/src/lib/Neuron/Zettelkasten/Query/Parser.hs
index 09ed2862f..bd6fe028a 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Parser.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Parser.hs
@@ -16,7 +16,6 @@ module Neuron.Zettelkasten.Query.Parser where
 import Control.Monad.Except
 import Data.Some
 import Data.TagTree (mkTagPattern)
-import Neuron.Markdown
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Query
@@ -36,14 +35,10 @@ import Text.URI.Util (getQueryParam, hasQueryFlag)
 queryFromURI :: MonadError QueryParseError m => URI.URI -> m (Maybe (Some Query))
 queryFromURI uri = do
   -- We are setting markdownLinkText to the URI to support the new short links
-  queryFromMarkdownLink $ MarkdownLink {markdownLinkUri = uri, markdownLinkText = URI.render uri}
+  queryFromURILink $ URILink (URI.render uri) uri
 
 queryFromURILink :: MonadError QueryParseError m => URILink -> m (Maybe (Some Query))
-queryFromURILink URILink {..} =
-  queryFromMarkdownLink $ MarkdownLink _uriLink_linkText _uriLink_uri
-
-queryFromMarkdownLink :: MonadError QueryParseError m => MarkdownLink -> m (Maybe (Some Query))
-queryFromMarkdownLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} =
+queryFromURILink (URILink linkText uri) =
   case fmap URI.unRText (URI.uriScheme uri) of
     Just proto | not angleBracketLink && proto `elem` ["z", "zcf"] -> do
       zid <- liftEither $ first (QueryParseError_InvalidID uri) $ parseZettelID' linkText

From edff934ae0888e9f765a41302ef3fc100a4941b7 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 21:45:52 -0400
Subject: [PATCH 10/21] Move zettel related css to where it belongs

---
 src/app/Main.hs                            |   6 +-
 src/app/Neuron/Web/View.hs                 | 111 +----------------
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 133 +++++++++++++++++++--
 3 files changed, 128 insertions(+), 122 deletions(-)

diff --git a/src/app/Main.hs b/src/app/Main.hs
index d5d83b4d2..500db090f 100644
--- a/src/app/Main.hs
+++ b/src/app/Main.hs
@@ -6,7 +6,7 @@
 
 module Main where
 
-import Clay ((?), Css, em, pct)
+import Clay ((?), Css, em)
 import qualified Clay as C
 import qualified Data.Text as T
 import Development.Shake
@@ -87,12 +87,8 @@ mainStyle cfg = do
     C.fontFamily [bodyFont] [C.serif]
     C.paddingTop $ em 1
     C.paddingBottom $ em 1
-    "p" ? do
-      C.lineHeight $ pct 150
     "h1, h2, h3, h4, h5, h6, .ui.header, .headerFont" ? do
       C.fontFamily [headerFont] [C.sansSerif]
-    "img" ? do
-      C.maxWidth $ pct 100 -- Prevents large images from overflowing beyond zettel borders
     "code, pre, tt, .monoFont" ? do
       C.fontFamily [monoFont, "SFMono-Regular", "Menlo", "Monaco", "Consolas", "Liberation Mono", "Courier New"] [C.monospace]
     style cfg
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index 0496cdedd..0614963cb 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -253,124 +253,15 @@ style Config {..} = do
     C.ul ? do
       C.listStyleType C.square
       C.paddingLeft $ em 1.5
-  ZettelView.zettelLinkCss neuronTheme
-  "div.zettel-view" ? do
-    -- This list styling applies both to zettel content, and the rest of the
-    -- view (eg: connections pane)
-    C.ul ? do
-      C.paddingLeft $ em 1.5
-      C.listStyleType C.square
-      C.li ? do
-        mempty -- C.paddingBottom $ em 1
-    ZettelView.zettelCss neuronTheme
+  ZettelView.zettelCss neuronTheme
   "div.tag-tree" ? do
     "div.node" ? do
       C.fontWeight C.bold
       "a.inactive" ? do
         C.color "#555"
-  ".footer" ? do
-    "a" ? do
-      C.color white
   ".footer-version, .footer-version a, .footer-version a:visited" ? do
     C.color gray
   ".footer-version a" ? do
     C.fontWeight C.bold
   ".footer-version" ? do
     C.fontSize $ em 0.7
-  pureCssTreeDiagram
-  ".deemphasized" ? do
-    fontSize $ em 0.85
-  ".deemphasized:hover" ? do
-    opacity 1
-  ".deemphasized:not(:hover)" ? do
-    opacity 0.5
-    "a" ? important (color gray)
-
--- https://codepen.io/philippkuehn/pen/QbrOaN
-pureCssTreeDiagram :: Css
-pureCssTreeDiagram = do
-  let cellBorderWidth = px 2
-      flipTree = False
-      rotateDeg = deg 180
-  ".tree.flipped" ? do
-    C.transform $ C.rotate rotateDeg
-  ".tree" ? do
-    C.overflow auto
-    when flipTree $ do
-      C.transform $ C.rotate rotateDeg
-    -- Clay does not support this; doing it inline in div style.
-    -- C.transformOrigin $ pct 50
-    "ul.root" ? do
-      -- Make the tree attach to zettel segment
-      C.paddingTop $ px 0
-      C.marginTop $ px 0
-    "ul" ? do
-      C.position relative
-      C.padding (em 1) 0 0 0
-      C.whiteSpace nowrap
-      sym2 C.margin (px 0) auto
-      C.textAlign center
-      C.after & do
-        C.content $ stringContent ""
-        C.display C.displayTable
-        C.clear both
-      C.lastChild & do
-        C.paddingBottom $ em 0.1
-    "li" ? do
-      C.display C.inlineBlock
-      C.verticalAlign C.vAlignTop
-      C.textAlign C.center
-      C.listStyleType none
-      C.position relative
-      C.padding (em 1) (em 0.5) (em 0) (em 0.5)
-      forM_ [C.before, C.after] $ \sel -> sel & do
-        C.content $ stringContent ""
-        C.position absolute
-        C.top $ px 0
-        C.right $ pct 50
-        C.borderTop solid cellBorderWidth "#ccc"
-        C.width $ pct 50
-        C.height $ em 1.2
-      C.after & do
-        C.right auto
-        C.left $ pct 50
-        C.borderLeft solid cellBorderWidth "#ccc"
-      C.onlyChild & do
-        C.paddingTop $ em 0
-        forM_ [C.after, C.before] $ \sel -> sel & do
-          C.display none
-      C.firstChild & do
-        C.before & do
-          C.borderStyle none
-          C.borderWidth $ px 0
-        C.after & do
-          C.borderRadius (px 5) 0 0 0
-      C.lastChild & do
-        C.after & do
-          C.borderStyle none
-          C.borderWidth $ px 0
-        C.before & do
-          C.borderRight solid cellBorderWidth "#ccc"
-          C.borderRadius 0 (px 5) 0 0
-    "ul ul::before" ? do
-      C.content $ stringContent ""
-      C.position absolute
-      C.top $ px 0
-      C.left $ pct 50
-      C.borderLeft solid cellBorderWidth "#ccc"
-      C.width $ px 0
-      C.height $ em 1.2
-    "li" ? do
-      "div.forest-link" ? do
-        border solid cellBorderWidth "#ccc"
-        sym2 C.padding (em 0.2) (em 0.3)
-        C.textDecoration none
-        C.display inlineBlock
-        sym C.borderRadius (px 5)
-        C.color "#333"
-        C.position relative
-        C.top cellBorderWidth
-        when flipTree $ do
-          C.transform $ C.rotate rotateDeg
-  ".tree.flipped li div.forest-link" ? do
-    C.transform $ C.rotate rotateDeg
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index 01c5c43ae..c7dbe3db9 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -15,12 +15,10 @@ module Neuron.Zettelkasten.Zettel.View
     renderZettel,
     renderFooter,
     zettelCss,
-    zettelLinkCss,
   )
 where
 
-import Clay ((?), auto, em, pct, pre, px, sym, sym2)
-import Clay (Css)
+import Clay hiding (id, ms, not, object, reverse, s, style, type_)
 import qualified Clay as C
 import Data.Foldable (maximum)
 import Data.TagTree
@@ -38,9 +36,9 @@ import Neuron.Zettelkasten.Query.Theme (LinkView (..))
 import qualified Neuron.Zettelkasten.Query.View as Q
 import Neuron.Zettelkasten.Query.View (tagUrl, zettelUrl)
 import Neuron.Zettelkasten.Zettel
-import Reflex.Dom.Core
+import Reflex.Dom.Core hiding ((&))
 import Reflex.Dom.Pandoc
-import Relude
+import Relude hiding ((&))
 
 type AutoScroll = Tagged "autoScroll" Bool
 
@@ -212,6 +210,24 @@ renderZettelLink conn (fromMaybe def -> LinkView {..}) Zettel {..} = do
             <> "data-position" =: "right center"
         )
 
+zettelCss :: Theme.Theme -> Css
+zettelCss neuronTheme = do
+  zettelCommonCss
+  zettelLinkCss neuronTheme
+  "div.zettel-view" ? do
+    -- This list styling applies both to zettel content, and the rest of the
+    -- view (eg: connections pane)
+    C.ul ? do
+      C.paddingLeft $ em 1.5
+      C.listStyleType C.square
+      C.li ? do
+        mempty -- C.paddingBottom $ em 1
+    zettelContentCss neuronTheme
+  pureCssTreeDiagram
+  ".footer" ? do
+    "a" ? do
+      C.color white
+
 zettelLinkCss :: Theme.Theme -> Css
 zettelLinkCss neuronTheme = do
   let linkColor = Theme.withRgb neuronTheme C.rgb
@@ -231,8 +247,8 @@ zettelLinkCss neuronTheme = do
   "[data-tooltip]:after" ? do
     C.fontSize $ em 0.7
 
-zettelCss :: Theme.Theme -> Css
-zettelCss neuronTheme = do
+zettelContentCss :: Theme.Theme -> Css
+zettelContentCss neuronTheme = do
   let linkColor = Theme.withRgb neuronTheme C.rgb
   "div.zettel-content" ? do
     -- All of these apply to the zettel content card only.
@@ -295,3 +311,106 @@ zettelCss neuronTheme = do
         C.borderLeft C.solid (px 10) "#ccc"
         sym2 C.margin (em 1.5) (px 0)
         sym2 C.padding (em 0.5) (px 10)
+
+-- https://codepen.io/philippkuehn/pen/QbrOaN
+pureCssTreeDiagram :: Css
+pureCssTreeDiagram = do
+  let cellBorderWidth = px 2
+      flipTree = False
+      rotateDeg = deg 180
+  ".tree.flipped" ? do
+    C.transform $ C.rotate rotateDeg
+  ".tree" ? do
+    C.overflow auto
+    when flipTree $ do
+      C.transform $ C.rotate rotateDeg
+    -- Clay does not support this; doing it inline in div style.
+    -- C.transformOrigin $ pct 50
+    "ul.root" ? do
+      -- Make the tree attach to zettel segment
+      C.paddingTop $ px 0
+      C.marginTop $ px 0
+    "ul" ? do
+      C.position relative
+      C.padding (em 1) 0 0 0
+      C.whiteSpace nowrap
+      sym2 C.margin (px 0) auto
+      C.textAlign center
+      C.after & do
+        C.content $ stringContent ""
+        C.display C.displayTable
+        C.clear both
+      C.lastChild & do
+        C.paddingBottom $ em 0.1
+    "li" ? do
+      C.display C.inlineBlock
+      C.verticalAlign C.vAlignTop
+      C.textAlign C.center
+      C.listStyleType none
+      C.position relative
+      C.padding (em 1) (em 0.5) (em 0) (em 0.5)
+      forM_ [C.before, C.after] $ \sel -> sel & do
+        C.content $ stringContent ""
+        C.position absolute
+        C.top $ px 0
+        C.right $ pct 50
+        C.borderTop solid cellBorderWidth "#ccc"
+        C.width $ pct 50
+        C.height $ em 1.2
+      C.after & do
+        C.right auto
+        C.left $ pct 50
+        C.borderLeft solid cellBorderWidth "#ccc"
+      C.onlyChild & do
+        C.paddingTop $ em 0
+        forM_ [C.after, C.before] $ \sel -> sel & do
+          C.display none
+      C.firstChild & do
+        C.before & do
+          C.borderStyle none
+          C.borderWidth $ px 0
+        C.after & do
+          C.borderRadius (px 5) 0 0 0
+      C.lastChild & do
+        C.after & do
+          C.borderStyle none
+          C.borderWidth $ px 0
+        C.before & do
+          C.borderRight solid cellBorderWidth "#ccc"
+          C.borderRadius 0 (px 5) 0 0
+    "ul ul::before" ? do
+      C.content $ stringContent ""
+      C.position absolute
+      C.top $ px 0
+      C.left $ pct 50
+      C.borderLeft solid cellBorderWidth "#ccc"
+      C.width $ px 0
+      C.height $ em 1.2
+    "li" ? do
+      "div.forest-link" ? do
+        border solid cellBorderWidth "#ccc"
+        sym2 C.padding (em 0.2) (em 0.3)
+        C.textDecoration none
+        C.display inlineBlock
+        sym C.borderRadius (px 5)
+        C.color "#333"
+        C.position relative
+        C.top cellBorderWidth
+        when flipTree $ do
+          C.transform $ C.rotate rotateDeg
+  ".tree.flipped li div.forest-link" ? do
+    C.transform $ C.rotate rotateDeg
+
+zettelCommonCss :: Css
+zettelCommonCss = do
+  "p" ? do
+    C.lineHeight $ pct 150
+  "img" ? do
+    C.maxWidth $ pct 100 -- Prevents large images from overflowing beyond zettel borders
+  ".deemphasized" ? do
+    fontSize $ em 0.85
+  ".deemphasized:hover" ? do
+    opacity 1
+  ".deemphasized:not(:hover)" ? do
+    opacity 0.5
+    "a" ? important (color gray)

From 301af9fb433f80dd0a1727deb266bdcd79af98fc Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 22:59:15 -0400
Subject: [PATCH 11/21] Put footer on left side

On mobile it appears below
---
 neuron.cabal                               |  2 +-
 src/app/Neuron/Web/View.hs                 |  2 -
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 64 +++++++++++++---------
 test/Neuron/VersionSpec.hs                 |  4 +-
 4 files changed, 40 insertions(+), 32 deletions(-)

diff --git a/neuron.cabal b/neuron.cabal
index ea6ccf6a8..77fe38813 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.5.1.0
+version: 0.5.2.0
 license: AGPL-3.0-only
 copyright: 2020 Sridhar Ratnakumar
 maintainer: srid@srid.ca
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index 0614963cb..699153340 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -130,13 +130,11 @@ renderRouteBody config r (g, x) = do
     Route_ZIndex -> do
       divClass "ui text container" $ do
         renderIndex config g
-        ZettelView.renderFooter (editUrl config) g Nothing
         renderBrandFooter
       pure mempty
     Route_Search {} -> do
       divClass "ui text container" $ do
         renderSearch g
-        ZettelView.renderFooter (editUrl config) g Nothing
         renderBrandFooter
       pure mempty
     Route_Zettel _ -> do
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index c7dbe3db9..c095fd395 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -13,7 +13,6 @@ module Neuron.Zettelkasten.Zettel.View
   ( renderZettelContent,
     renderZettelLink,
     renderZettel,
-    renderFooter,
     zettelCss,
   )
 where
@@ -62,15 +61,23 @@ renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
       -- cf. https://stackoverflow.com/a/49968820/55246
       elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
     divClass "zettel-view" $ do
-      errors <- renderZettelContent (handleZettelQuery graph zettelID) z
-      whenNotNull (G.backlinks OrdinaryConnection z graph) $ \cfBacklinks -> do
-        divClass "ui attached segment deemphasized" $ do
-          elAttr "div" ("class" =: "ui header" <> "title" =: "Zettels that link here, but without branching") $
-            text "More backlinks"
-          el "ul" $ do
-            forM_ cfBacklinks $ \zl ->
-              el "li" $ renderZettelLink Nothing def zl
-      renderFooter editUrl graph (Just z)
+      errors <- divClass "ui two column grid" $ do
+        divClass "one wide tablet only computer only column" $ do
+          renderActionsMenu VerticalMenu editUrl (Just z)
+        divClass "sixteen wide mobile fifteen wide tablet fifteen wide computer stretched column" $ do
+          errors <- renderZettelContent (handleZettelQuery graph zettelID) z
+          divClass "ui bottom attached segment deemphasized" $ do
+            divClass "ui two column grid" $ do
+              divClass "column" $ do
+                whenNotNull (G.backlinks OrdinaryConnection z graph) $ \cfBacklinks -> do
+                  elAttr "div" ("class" =: "ui header" <> "title" =: "Zettels that link here, but without branching") $
+                    text "More backlinks"
+                  el "ul" $ do
+                    forM_ cfBacklinks $ \zl ->
+                      el "li" $ renderZettelLink Nothing def zl
+          pure errors
+      divClass "ui one column grid" $ divClass "mobile only sixteen wide column" $ do
+        renderActionsMenu HorizontalMenu editUrl (Just z)
       pure errors
   -- Because the tree above can be pretty large, we scroll past it
   -- automatically when the page loads.
@@ -129,22 +136,25 @@ renderUplinkForest getConn trees = do
     -- Sort trees so that trees containing the most recent zettel (by ID) come first.
     sortForest = reverse . sortOn maximum
 
-renderFooter :: DomBuilder t m => Maybe Text -> ZettelGraph -> Maybe Zettel -> m ()
-renderFooter editUrl graph mzettel = do
-  let attachClass = maybe "" (const "bottom attached") mzettel
-  divClass ("ui inverted black " <> attachClass <> " footer segment") $ do
-    divClass "ui equal width grid" $ do
-      divClass "center aligned column" $ do
-        let homeUrl = maybe "." (const "index.html") $ G.getZettel (ZettelCustomID "index") graph
-        elAttr "a" ("href" =: homeUrl <> "title" =: "/") $ fa "fas fa-home"
-      whenJust ((,) <$> mzettel <*> editUrl) $ \(Zettel {..}, urlPrefix) ->
-        divClass "center aligned column" $ do
-          elAttr "a" ("href" =: (urlPrefix <> toText (zettelIDSourceFileName zettelID)) <> "title" =: "Edit this Zettel") $ fa "fas fa-edit"
-      divClass "center aligned column" $ do
-        elAttr "a" ("href" =: "search.html" <> "title" =: "Search Zettels") $ fa "fas fa-search"
-      divClass "center aligned column" $ do
-        elAttr "a" ("href" =: "z-index.html" <> "title" =: "All Zettels (z-index)") $
-          fa "fas fa-tree"
+data MenuOrientation
+  = VerticalMenu
+  | HorizontalMenu
+  deriving (Eq, Show, Ord)
+
+renderActionsMenu :: DomBuilder t m => MenuOrientation -> Maybe Text -> Maybe Zettel -> m ()
+renderActionsMenu orient editUrl mzettel = do
+  let cls = case orient of
+        VerticalMenu -> "ui deemphasized vertical icon menu"
+        HorizontalMenu -> "ui deemphasized icon menu"
+  divClass cls $ do
+    divClass "item" $ do
+      elAttr "a" ("href" =: "z-index.html" <> "title" =: "All Zettels (z-index)") $
+        fa "fas fa-tree"
+    whenJust ((,) <$> mzettel <*> editUrl) $ \(Zettel {..}, urlPrefix) ->
+      divClass "item" $ do
+        elAttr "a" ("href" =: (urlPrefix <> toText (zettelIDSourceFileName zettelID)) <> "title" =: "Edit this Zettel") $ fa "fas fa-edit"
+    divClass "right item" $ do
+      elAttr "a" ("href" =: "search.html" <> "title" =: "Search Zettels") $ fa "fas fa-search"
   where
     fa k = elClass "i" k blank
 
@@ -155,7 +165,7 @@ renderZettelContent ::
   Zettel ->
   m a
 renderZettelContent handleLink Zettel {..} = do
-  divClass "ui raised top attached segment zettel-content" $ do
+  divClass "ui raised attached segment zettel-content" $ do
     elClass "h1" "header" $ text zettelTitle
     x <- elPandoc (Config handleLink) zettelContent
     renderTags zettelTags
diff --git a/test/Neuron/VersionSpec.hs b/test/Neuron/VersionSpec.hs
index ecc8895cc..571d5382e 100644
--- a/test/Neuron/VersionSpec.hs
+++ b/test/Neuron/VersionSpec.hs
@@ -30,8 +30,8 @@ spec = do
       "0.6.1.2" `isGreater` olderThan
       "0.5.3" `isGreater` olderThan
       "0.5.2.8" `isGreater` olderThan
-      "0.5.1.0" `isLesserOrEqual` olderThan -- This is current version
+      "0.5.2.0" `isLesserOrEqual` olderThan -- This is current version
       "0.3.1.0" `isLesserOrEqual` olderThan
     it "within same major version" $ do
       "0.5.2.8" `isGreater` olderThan
-      "0.5.1.0" `isLesserOrEqual` olderThan -- This is current version
+      "0.5.2.0" `isLesserOrEqual` olderThan -- This is current version

From 6f424cdd4395755ab8f7f7b63c4aeaf96ce4f67f Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 23:21:39 -0400
Subject: [PATCH 12/21] More UI tweaks

---
 src/app/Neuron/Web/View.hs                 |  1 +
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 34 +++++++++++++++-------
 2 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index 699153340..ee5c5f6b3 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -165,6 +165,7 @@ renderIndex Config {..} graph = do
       divClass ("ui " <> Theme.semanticColor neuronTheme <> " segment") $ do
         -- Forest of zettels, beginning with mother vertices.
         el "ul" $ renderForest True Nothing (Just graph) forest
+  el "br" blank
   where
     countNounBe noun nounPlural = \case
       1 -> "is 1 " <> noun
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index c095fd395..4a18f65a3 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -75,6 +75,8 @@ renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
                   el "ul" $ do
                     forM_ cfBacklinks $ \zl ->
                       el "li" $ renderZettelLink Nothing def zl
+              divClass "column" $ do
+                renderTags zettelTags
           pure errors
       divClass "ui one column grid" $ divClass "mobile only sixteen wide column" $ do
         renderActionsMenu HorizontalMenu editUrl (Just z)
@@ -168,7 +170,6 @@ renderZettelContent handleLink Zettel {..} = do
   divClass "ui raised attached segment zettel-content" $ do
     elClass "h1" "header" $ text zettelTitle
     x <- elPandoc (Config handleLink) zettelContent
-    renderTags zettelTags
     whenJust zettelDay $ \day ->
       elAttr "div" ("class" =: "date" <> "title" =: "Zettel creation date") $ text $ show day
     pure x
@@ -179,10 +180,11 @@ renderTags tags = do
     -- NOTE(ui): Ideally this should be at the top, not bottom. But putting it at
     -- the top pushes the zettel content down, introducing unnecessary white
     -- space below the title. So we put it at the bottom for now.
-    elAttr "span" ("class" =: "ui black right ribbon label" <> "title" =: "Tag") $ do
+    elAttr "span" ("class" =: "ui right ribbon label zettel-tag" <> "title" =: "Tag") $ do
       elAttr
         "a"
         ( "href" =: (tagUrl t)
+            <> "class" =: "tag-inner"
             <> "title" =: ("See all zettels tagged '" <> unTag t <> "'")
         )
         $ text
@@ -222,7 +224,7 @@ renderZettelLink conn (fromMaybe def -> LinkView {..}) Zettel {..} = do
 
 zettelCss :: Theme.Theme -> Css
 zettelCss neuronTheme = do
-  zettelCommonCss
+  zettelCommonCss neuronTheme
   zettelLinkCss neuronTheme
   "div.zettel-view" ? do
     -- This list styling applies both to zettel content, and the rest of the
@@ -234,9 +236,12 @@ zettelCss neuronTheme = do
         mempty -- C.paddingBottom $ em 1
     zettelContentCss neuronTheme
   pureCssTreeDiagram
-  ".footer" ? do
+  ".ui.label.zettel-tag a.tag-inner" ? do
+    C.color black
     "a" ? do
-      C.color white
+      C.color black
+
+-- C.color white
 
 zettelLinkCss :: Theme.Theme -> Css
 zettelLinkCss neuronTheme = do
@@ -257,6 +262,14 @@ zettelLinkCss neuronTheme = do
   "[data-tooltip]:after" ? do
     C.fontSize $ em 0.7
 
+lightColor :: Theme.Theme -> Color
+lightColor neuronTheme =
+  Theme.withRgb neuronTheme C.rgba 0.1
+
+themeColor :: Theme.Theme -> Color
+themeColor neuronTheme =
+  Theme.withRgb neuronTheme C.rgba 1
+
 zettelContentCss :: Theme.Theme -> Css
 zettelContentCss neuronTheme = do
   let linkColor = Theme.withRgb neuronTheme C.rgb
@@ -269,7 +282,7 @@ zettelContentCss neuronTheme = do
       C.paddingTop $ em 0.2
       C.paddingBottom $ em 0.2
       C.textAlign C.center
-      C.backgroundColor $ Theme.withRgb neuronTheme C.rgba 0.1
+      C.backgroundColor $ lightColor neuronTheme
     C.h2 ? do
       C.borderBottom C.solid (px 1) C.steelblue
       C.marginBottom $ em 0.5
@@ -411,8 +424,8 @@ pureCssTreeDiagram = do
   ".tree.flipped li div.forest-link" ? do
     C.transform $ C.rotate rotateDeg
 
-zettelCommonCss :: Css
-zettelCommonCss = do
+zettelCommonCss :: Theme.Theme -> Css
+zettelCommonCss neuronTheme = do
   "p" ? do
     C.lineHeight $ pct 150
   "img" ? do
@@ -421,6 +434,7 @@ zettelCommonCss = do
     fontSize $ em 0.85
   ".deemphasized:hover" ? do
     opacity 1
+    "div.item a:hover" ? important (color $ themeColor neuronTheme)
   ".deemphasized:not(:hover)" ? do
-    opacity 0.5
-    "a" ? important (color gray)
+    opacity 0.7
+    "span.zettel-link a, div.item a" ? important (color gray)

From 745fd5a1cc4ae0b55a1074c55f4383afdece14ba Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Fri, 22 May 2020 23:27:27 -0400
Subject: [PATCH 13/21] Let some of the tree be visible when auto scrolling

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

diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index 4a18f65a3..fea237f6b 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -59,7 +59,9 @@ renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
     when autoScroll $ do
       -- zettel-container-anchor is a trick used by the scrollIntoView JS below
       -- cf. https://stackoverflow.com/a/49968820/55246
-      elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -14px; left: 0") blank
+      -- We use -24px (instead of -14px) here so as to not scroll all the way to
+      -- title, and as to leave some of the tree visible as "hint" to the user.
+      elAttr "div" ("id" =: "zettel-container-anchor" <> "style" =: "position: absolute; top: -24px; left: 0") blank
     divClass "zettel-view" $ do
       errors <- divClass "ui two column grid" $ do
         divClass "one wide tablet only computer only column" $ do

From 8e207b32e4a76c4b4de2143b9258d2f42ad0f0c4 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 09:35:16 -0400
Subject: [PATCH 14/21] Fix tests

---
 test/Neuron/Zettelkasten/Query/ParserSpec.hs | 50 ++++++++++----------
 1 file changed, 25 insertions(+), 25 deletions(-)

diff --git a/test/Neuron/Zettelkasten/Query/ParserSpec.hs b/test/Neuron/Zettelkasten/Query/ParserSpec.hs
index aa816e588..858f8b5db 100644
--- a/test/Neuron/Zettelkasten/Query/ParserSpec.hs
+++ b/test/Neuron/Zettelkasten/Query/ParserSpec.hs
@@ -10,12 +10,12 @@ where
 import Data.Default (def)
 import Data.Some
 import Data.TagTree
-import Neuron.Markdown
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Query.Parser
 import Neuron.Zettelkasten.Query.Theme
+import Reflex.Dom.Pandoc.URILink
 import Relude
 import Test.Hspec
 import Text.URI
@@ -33,73 +33,73 @@ legacyLinks = do
         let zettelsByTag pat mview =
               Right $ Just $ Some $ Query_ZettelsByTag (fmap mkTagPattern pat) mconn mview
             withScheme s = toText scheme <> s
-            legacyLink l = mkMarkdownLink "." l
+            legacyLink l = mkURILink "." l
         it "Parse all zettels URI" $ do
-          queryFromMarkdownLink (legacyLink $ withScheme "://search")
+          queryFromURILink (legacyLink $ withScheme "://search")
             `shouldBe` zettelsByTag [] def
         it "Parse single tag" $
-          queryFromMarkdownLink (legacyLink $ withScheme "://search?tag=foo")
+          queryFromURILink (legacyLink $ withScheme "://search?tag=foo")
             `shouldBe` zettelsByTag ["foo"] def
         it "Parse hierarchical tag" $ do
-          queryFromMarkdownLink (legacyLink $ withScheme "://search?tag=foo/bar")
+          queryFromURILink (legacyLink $ withScheme "://search?tag=foo/bar")
             `shouldBe` zettelsByTag ["foo/bar"] def
         it "Parse tag pattern" $ do
-          queryFromMarkdownLink (legacyLink $ withScheme "://search?tag=foo/**/bar/*/baz")
+          queryFromURILink (legacyLink $ withScheme "://search?tag=foo/**/bar/*/baz")
             `shouldBe` zettelsByTag ["foo/**/bar/*/baz"] def
         it "Parse multiple tags" $
-          queryFromMarkdownLink (legacyLink $ withScheme "://search?tag=foo&tag=bar")
+          queryFromURILink (legacyLink $ withScheme "://search?tag=foo&tag=bar")
             `shouldBe` zettelsByTag ["foo", "bar"] def
         it "Handles ?grouped" $ do
-          queryFromMarkdownLink (legacyLink $ withScheme "://search?grouped")
+          queryFromURILink (legacyLink $ withScheme "://search?grouped")
             `shouldBe` zettelsByTag [] (ZettelsView def True)
         it "Handles ?linkTheme=withDate" $ do
-          queryFromMarkdownLink (legacyLink $ withScheme "://search?linkTheme=withDate")
+          queryFromURILink (legacyLink $ withScheme "://search?linkTheme=withDate")
             `shouldBe` zettelsByTag [] (ZettelsView (LinkView True) False)
   describe "Parse zettels by ID URI" $ do
     let zid = parseZettelID "1234567"
     it "parses z:/" $
-      queryFromMarkdownLink (mkMarkdownLink "1234567" "z:/")
+      queryFromURILink (mkURILink "1234567" "z:/")
         `shouldBe` Right (Just $ Some $ Query_ZettelByID zid Nothing)
     it "parses z:/ ignoring annotation" $
-      queryFromMarkdownLink (mkMarkdownLink "1234567" "z://foo-bar")
+      queryFromURILink (mkURILink "1234567" "z://foo-bar")
         `shouldBe` Right (Just $ Some $ Query_ZettelByID zid Nothing)
     it "parses zcf:/" $
-      queryFromMarkdownLink (mkMarkdownLink "1234567" "zcf:/")
+      queryFromURILink (mkURILink "1234567" "zcf:/")
         `shouldBe` Right (Just $ Some $ Query_ZettelByID zid (Just OrdinaryConnection))
   describe "Parse tags URI" $ do
     it "parses zquery://tags" $
-      queryFromMarkdownLink (mkMarkdownLink "." "zquery://tags?filter=foo/**")
+      queryFromURILink (mkURILink "." "zquery://tags?filter=foo/**")
         `shouldBe` Right (Just $ Some $ Query_Tags [mkTagPattern "foo/**"])
 
 shortLinks :: Spec
 shortLinks = do
   describe "short links" $ do
-    let shortLink s = mkMarkdownLink s s
+    let shortLink s = mkURILink s s
     it "parses date ID" $ do
-      queryFromMarkdownLink (shortLink "1234567")
+      queryFromURILink (shortLink "1234567")
         `shouldBe` Right (Just $ Some $ Query_ZettelByID (parseZettelID "1234567") Nothing)
     it "parses custom/hash ID" $ do
-      queryFromMarkdownLink (shortLink "foo-bar")
+      queryFromURILink (shortLink "foo-bar")
         `shouldBe` Right (Just $ Some $ Query_ZettelByID (parseZettelID "foo-bar") Nothing)
     it "even with ?cf" $ do
-      queryFromMarkdownLink (shortLink "foo-bar?cf")
+      queryFromURILink (shortLink "foo-bar?cf")
         `shouldBe` Right (Just $ Some $ Query_ZettelByID (parseZettelID "foo-bar") (Just OrdinaryConnection))
     it "z:zettels" $ do
-      queryFromMarkdownLink (shortLink "z:zettels")
+      queryFromURILink (shortLink "z:zettels")
         `shouldBe` Right (Just $ Some $ Query_ZettelsByTag [] Nothing def)
     it "z:zettels?tag=foo" $ do
-      queryFromMarkdownLink (shortLink "z:zettels?tag=foo")
+      queryFromURILink (shortLink "z:zettels?tag=foo")
         `shouldBe` Right (Just $ Some $ Query_ZettelsByTag [mkTagPattern "foo"] Nothing def)
     it "z:zettels?cf" $ do
-      queryFromMarkdownLink (shortLink "z:zettels?cf")
+      queryFromURILink (shortLink "z:zettels?cf")
         `shouldBe` Right (Just $ Some $ Query_ZettelsByTag [] (Just OrdinaryConnection) def)
     it "z:tags" $ do
-      queryFromMarkdownLink (shortLink "z:tags")
+      queryFromURILink (shortLink "z:tags")
         `shouldBe` Right (Just $ Some $ Query_Tags [])
     it "z:tags?filter=foo" $ do
-      queryFromMarkdownLink (shortLink "z:tags?filter=foo")
+      queryFromURILink (shortLink "z:tags?filter=foo")
         `shouldBe` Right (Just $ Some $ Query_Tags [mkTagPattern "foo"])
 
-mkMarkdownLink :: Text -> Text -> MarkdownLink
-mkMarkdownLink s l =
-  MarkdownLink s $ either (error . toText . displayException) id $ mkURI l
+mkURILink :: Text -> Text -> URILink
+mkURILink s l =
+  URILink s $ either (error . toText . displayException) id $ mkURI l

From 9c3fd2bae334b96cb71bd14755d602a30fb8d2f3 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 09:38:09 -0400
Subject: [PATCH 15/21] Reinstate GitHub CI, with -j4

---
 .github/workflows/ci.yaml | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)
 create mode 100644 .github/workflows/ci.yaml

diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
new file mode 100644
index 000000000..f502124e2
--- /dev/null
+++ b/.github/workflows/ci.yaml
@@ -0,0 +1,22 @@
+name: "CI"
+on:
+  pull_request:
+  push:
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ubuntu-latest, macos-latest]
+    steps:
+    - uses: actions/checkout@v2
+    - uses: cachix/install-nix-action@v8
+    # This also runs nix-build.
+    - uses: cachix/cachix-action@v6
+      with:
+        name: srid
+        signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'
+        # Only needed for private caches
+        authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
+    # This builds neuron, as well as run tests
+    - run: nix-build -j4

From f0fa750d92f476ca4fac3f4e92b236b5107d5a3e Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 10:22:36 -0400
Subject: [PATCH 16/21] Better inline error message

---
 src/lib/Neuron/Zettelkasten/Error.hs       | 30 +++++++++++++---------
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 16 +++++-------
 2 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/src/lib/Neuron/Zettelkasten/Error.hs b/src/lib/Neuron/Zettelkasten/Error.hs
index d4071df53..403be0ad6 100644
--- a/src/lib/Neuron/Zettelkasten/Error.hs
+++ b/src/lib/Neuron/Zettelkasten/Error.hs
@@ -5,6 +5,7 @@
 
 module Neuron.Zettelkasten.Error
   ( NeuronError (..),
+    neuronErrorReason,
   )
 where
 
@@ -19,19 +20,24 @@ data NeuronError
     NeuronError_BadQuery ZettelID QueryError
   deriving (Eq)
 
+-- | The reason this particular zettel failed to process fully.
+neuronErrorReason :: NeuronError -> Text
+neuronErrorReason (NeuronError_BadQuery _fromZid e) =
+  case e of
+    Left qe ->
+      "it contains a query URI (" <> URI.render (queryParseErrorUri qe) <> ") " <> case qe of
+        QueryParseError_UnsupportedHost _uri ->
+          "with unsupported host"
+        QueryParseError_InvalidID _uri e'' ->
+          "with invalidID: " <> show e''
+    Right (QueryResultError_NoSuchZettel zid) ->
+      "Zettel with ID \""
+        <> zettelIDText zid
+        <> "\" does not exist"
+
 instance Show NeuronError where
-  show (NeuronError_BadQuery fromZid e) =
-    let msg = case e of
-          Left qe ->
-            "it contains a query URI (" <> URI.render (queryParseErrorUri qe) <> ") " <> case qe of
-              QueryParseError_UnsupportedHost _uri ->
-                "with unsupported host"
-              QueryParseError_InvalidID _uri e'' ->
-                "with invalidID: " <> show e''
-          Right (QueryResultError_NoSuchZettel zid) ->
-            "Zettel "
-              <> zettelIDText zid
-              <> " does not exist"
+  show err@(NeuronError_BadQuery fromZid _e) =
+    let msg = neuronErrorReason err
      in toString $
           unlines
             [ "",
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index fea237f6b..24a646270 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -26,7 +26,7 @@ import qualified Data.Text as T
 import Data.Tree (Tree (..))
 import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Connection
-import Neuron.Zettelkasten.Error (NeuronError (..))
+import Neuron.Zettelkasten.Error (NeuronError (..), neuronErrorReason)
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName)
@@ -103,26 +103,24 @@ handleZettelQuery ::
 handleZettelQuery graph zettelID oldRender uriLink = do
   case flip runReaderT (G.getZettels graph) (Q.evalQueryLink uriLink) of
     Left (NeuronError_BadQuery zettelID . Left -> e) -> do
-      -- TODO: show the error in terminal, or better report it correctly.
-      -- see github issue.
-      divClass "ui error message" $ do
-        text $ show e
-      fmap (e :) oldRender
+      fmap (e :) oldRender <* elError e
     Right Nothing -> do
       oldRender
     Right (Just res) -> do
       -- TODO: This should render in reflex-dom (no via pandoc's builder)
       case Q.buildQueryView res of
         Left (NeuronError_BadQuery zettelID . Right -> e) -> do
-          divClass "ui error message" $ do
-            text $ show e
-          fmap (e :) oldRender
+          fmap (e :) oldRender <* elError e
         Right (Left w) -> do
           elPandocInlines [w]
           pure mempty
         Right (Right w) -> do
           elPandocBlocks [w]
           pure mempty
+  where
+    elError e =
+      elClass "span" "ui left pointing red basic label" $ do
+        text $ neuronErrorReason e
 
 renderUplinkForest ::
   DomBuilder t m =>

From a6d2605b2c7ec1e65c13d1d72bb95cb098c8259c Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 10:42:38 -0400
Subject: [PATCH 17/21] Handle query parse errors as well

---
 src/app/Neuron/CLI.hs                     |  2 +-
 src/app/Neuron/CLI/New.hs                 |  2 +-
 src/app/Neuron/Web/Generate.hs            | 40 ++++++++++++++---------
 src/lib/Neuron/Zettelkasten/Error.hs      |  6 ++--
 src/lib/Neuron/Zettelkasten/Query/Eval.hs | 11 +++++--
 5 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/src/app/Neuron/CLI.hs b/src/app/Neuron/CLI.hs
index f4ac41edc..0db33c69b 100644
--- a/src/app/Neuron/CLI.hs
+++ b/src/app/Neuron/CLI.hs
@@ -62,7 +62,7 @@ runWith act App {..} =
     Query someQ ->
       runRibOnceQuietly notesDir $ do
         withSome someQ $ \q -> do
-          result <- flip Q.runQuery q <$> Gen.loadZettels
+          result <- flip Q.runQuery q <$> Gen.loadZettelsIgnoringErrors
           putLTextLn $ Aeson.encodeToLazyText $ Q.queryResultJson notesDir q result
     Search searchCmd ->
       interactiveSearch notesDir searchCmd
diff --git a/src/app/Neuron/CLI/New.hs b/src/app/Neuron/CLI/New.hs
index 45da73f67..a4221dbc5 100644
--- a/src/app/Neuron/CLI/New.hs
+++ b/src/app/Neuron/CLI/New.hs
@@ -34,7 +34,7 @@ import System.Posix.Process
 -- As well as print the path to the created file.
 newZettelFile :: NewCommand -> Action ()
 newZettelFile NewCommand {..} = do
-  zettels <- Gen.loadZettels
+  zettels <- Gen.loadZettelsIgnoringErrors
   mzid <- withSome idScheme $ \scheme -> do
     val <- liftIO $ IDScheme.genVal scheme
     pure $ IDScheme.nextAvailableZettelID (Set.fromList $ fmap zettelID zettels) val scheme
diff --git a/src/app/Neuron/Web/Generate.hs b/src/app/Neuron/Web/Generate.hs
index d90e459ae..ec4c075ff 100644
--- a/src/app/Neuron/Web/Generate.hs
+++ b/src/app/Neuron/Web/Generate.hs
@@ -10,11 +10,11 @@
 -- | Main module for using neuron as a library, instead of as a CLI tool.
 module Neuron.Web.Generate
   ( generateSite,
-    loadZettels,
+    loadZettelsIgnoringErrors,
   )
 where
 
-import Control.Monad.Except (MonadError, liftEither, runExceptT, withExceptT)
+import Control.Monad.Writer (runWriterT)
 import qualified Data.Graph.Labelled as G
 import Data.Traversable
 import Development.Shake
@@ -27,6 +27,7 @@ import Neuron.Zettelkasten.Error (NeuronError (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph.Type (ZettelGraph)
 import Neuron.Zettelkasten.ID (mkZettelID)
+import Neuron.Zettelkasten.Query.Error (QueryParseError)
 import Neuron.Zettelkasten.Query.Eval (queryConnections)
 import Neuron.Zettelkasten.Zettel (Zettel, ZettelT (..), mkZettelFromMarkdown)
 import Options.Applicative
@@ -44,7 +45,8 @@ generateSite config writeHtmlRoute' = do
     $ fail
     $ toString
     $ "Require neuron mininum version " <> minVersion config <> ", but your neuron version is " <> neuronVersion
-  zettelGraph <- loadZettelkasten
+  -- NOTE: We ignore errors, because they will be displayed during rendering.
+  (zettelGraph, _errors) <- loadZettelkasten
   let writeHtmlRoute v r = writeHtmlRoute' r (zettelGraph, v)
   -- Generate HTML for every zettel
   forM_ (G.getZettels zettelGraph) $ \z ->
@@ -61,16 +63,16 @@ generateSite config writeHtmlRoute' = do
     writeHtmlRoute targetZettel (Z.Route_Redirect aliasZettel)
   pure zettelGraph
 
-loadZettels :: Action [Zettel]
-loadZettels =
-  fmap G.getZettels loadZettelkasten
+loadZettelsIgnoringErrors :: Action [Zettel]
+loadZettelsIgnoringErrors =
+  fmap (G.getZettels . fst) loadZettelkasten
 
-loadZettelkasten :: Action ZettelGraph
+loadZettelkasten :: Action (ZettelGraph, [NeuronError])
 loadZettelkasten =
   loadZettelkastenFrom =<< Rib.forEvery ["*.md"] pure
 
 -- | Load the Zettelkasten from disk, using the given list of zettel files
-loadZettelkastenFrom :: [FilePath] -> Action ZettelGraph
+loadZettelkastenFrom :: HasCallStack => [FilePath] -> Action (ZettelGraph, [NeuronError])
 loadZettelkastenFrom files = do
   notesDir <- Rib.ribInputDir
   zettels <- forM files $ \((notesDir </>) -> path) -> do
@@ -79,26 +81,32 @@ loadZettelkastenFrom files = do
     case mkZettelFromMarkdown zid s snd of
       Left e -> fail $ toString e
       Right zettel -> pure zettel
-  either (fail . show) pure $ mkZettelGraph zettels
+  mkZettelGraph zettels
 
 -- | Build the Zettelkasten graph from a list of zettels
 --
 -- Also return the markdown extension to use for each zettel.
 mkZettelGraph ::
   forall m.
-  MonadError NeuronError m =>
+  Monad m =>
   [Zettel] ->
-  m ZettelGraph
+  m (ZettelGraph, [NeuronError])
 mkZettelGraph zettels = do
-  res :: [(Zettel, [(Maybe Connection, Zettel)])] <- liftEither =<< do
-    flip runReaderT zettels $ runExceptT $ do
+  res :: [(Zettel, ([(Maybe Connection, Zettel)], [QueryParseError]))] <- do
+    flip runReaderT zettels $ do
       -- TODO: re: Left; for Right, we must render the query, which only happens
       -- in Web.View. How do we accumulate the errors?
       for zettels $ \z -> fmap (z,) $ do
-        withExceptT (NeuronError_BadQuery (zettelID z) . Left) $ do
+        (conns, errs) <- runWriterT $ do
           queryConnections (zettelContent z)
-  let g :: ZettelGraph = G.mkGraphFrom (fst <$> res) $ flip concatMap res $ \(z1, conns) ->
+        pure (conns, errs)
+  -- pure (conns, NeuronError_BadQuery (zettelID z) . Left <$> errs)
+  let g :: ZettelGraph = G.mkGraphFrom (fst <$> res) $ flip concatMap res $ \(z1, fst -> conns) ->
         conns <&> \(c, z2) -> (connectionMonoid (fromMaybe Folgezettel c), z1, z2)
-  pure g
+  pure
+    ( g,
+      flip concatMap res $ \(z, (_conns, errs)) ->
+        NeuronError_BadQuery (zettelID z) . Left <$> errs
+    )
   where
     connectionMonoid = Just
diff --git a/src/lib/Neuron/Zettelkasten/Error.hs b/src/lib/Neuron/Zettelkasten/Error.hs
index 403be0ad6..9b72d2cfa 100644
--- a/src/lib/Neuron/Zettelkasten/Error.hs
+++ b/src/lib/Neuron/Zettelkasten/Error.hs
@@ -25,11 +25,11 @@ neuronErrorReason :: NeuronError -> Text
 neuronErrorReason (NeuronError_BadQuery _fromZid e) =
   case e of
     Left qe ->
-      "it contains a query URI (" <> URI.render (queryParseErrorUri qe) <> ") " <> case qe of
+      "The query URI (" <> URI.render (queryParseErrorUri qe) <> ") " <> case qe of
         QueryParseError_UnsupportedHost _uri ->
-          "with unsupported host"
+          "has an unsupported host"
         QueryParseError_InvalidID _uri e'' ->
-          "with invalidID: " <> show e''
+          "has an invalidID: " <> show e''
     Right (QueryResultError_NoSuchZettel zid) ->
       "Zettel with ID \""
         <> zettelIDText zid
diff --git a/src/lib/Neuron/Zettelkasten/Query/Eval.hs b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
index 667949ff6..8292ff00d 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Eval.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
@@ -45,7 +45,7 @@ evalQueryLink link =
 
 queryConnections ::
   forall m.
-  ( MonadError QueryParseError m,
+  ( MonadWriter [QueryParseError] m,
     -- Running queries requires the zettels list.
     MonadReader [Zettel] m
   ) =>
@@ -53,8 +53,13 @@ queryConnections ::
   m [(Maybe Connection, Zettel)]
 queryConnections doc =
   fmap concat $ forM (queryURILinks doc) $ \ul -> do
-    mres <- evalQueryLink ul
-    pure $ maybe [] getConnections mres
+    emres <- runExceptT $ evalQueryLink ul
+    case emres of
+      Left e -> do
+        tell [e]
+        pure []
+      Right mres ->
+        pure $ maybe [] getConnections mres
   where
     getConnections :: DSum Query Identity -> [(Maybe Connection, Zettel)]
     getConnections = \case

From 7ed043fd6f85a41df65082b4534762a2252e1851 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 11:02:45 -0400
Subject: [PATCH 18/21] Use QueryError directly

---
 neuron.cabal                               |  1 -
 src/app/Main.hs                            |  6 +--
 src/app/Neuron/CLI/Types.hs                |  5 ++-
 src/app/Neuron/Web/Generate.hs             | 21 ++++------
 src/app/Neuron/Web/View.hs                 |  4 +-
 src/lib/Neuron/Zettelkasten/Error.hs       | 46 ----------------------
 src/lib/Neuron/Zettelkasten/Query/Error.hs | 26 +++++++++++-
 src/lib/Neuron/Zettelkasten/Query/Eval.hs  |  3 +-
 src/lib/Neuron/Zettelkasten/Zettel/View.hs | 26 ++++++------
 9 files changed, 57 insertions(+), 81 deletions(-)
 delete mode 100644 src/lib/Neuron/Zettelkasten/Error.hs

diff --git a/neuron.cabal b/neuron.cabal
index 77fe38813..79b8a8b78 100644
--- a/neuron.cabal
+++ b/neuron.cabal
@@ -86,7 +86,6 @@ library
     Neuron.Zettelkasten.Query.View
     Neuron.Zettelkasten.Graph
     Neuron.Zettelkasten.Graph.Type
-    Neuron.Zettelkasten.Error
     Neuron.Web.Theme
     Text.Megaparsec.Simple
     Text.URI.Util
diff --git a/src/app/Main.hs b/src/app/Main.hs
index 500db090f..25732fc9c 100644
--- a/src/app/Main.hs
+++ b/src/app/Main.hs
@@ -17,7 +17,7 @@ import qualified Neuron.Config as Config
 import Neuron.Web.Generate (generateSite)
 import Neuron.Web.Route (Route (..))
 import Neuron.Web.View (renderRouteBody, renderRouteHead, style)
-import Neuron.Zettelkasten.Error (NeuronError)
+import Neuron.Zettelkasten.Query.Error (QueryError, showQueryError)
 import Reflex.Dom.Core
 import Reflex.Dom.Pandoc.Document (PandocBuilder)
 import Relude
@@ -39,10 +39,10 @@ generateMainSite = do
         unless (null errors) $ do
           putStrLn $ "E " <> fromMaybe "Unknown path" (routeFile r)
           forM_ errors $ \err ->
-            putStrLn $ "  " <> show err
+            putTextLn $ "  - " <> showQueryError err
   void $ generateSite config writeHtmlRoute
 
-renderPage :: PandocBuilder t m => Config -> Route g a -> (g, a) -> m [NeuronError]
+renderPage :: PandocBuilder t m => Config -> Route g a -> (g, a) -> m [QueryError]
 renderPage config r val = elAttr "html" ("lang" =: "en") $ do
   el "head" $ do
     renderRouteHead config r val
diff --git a/src/app/Neuron/CLI/Types.hs b/src/app/Neuron/CLI/Types.hs
index 996dee162..01bd904ff 100644
--- a/src/app/Neuron/CLI/Types.hs
+++ b/src/app/Neuron/CLI/Types.hs
@@ -25,8 +25,9 @@ import Data.Time
 import Neuron.Zettelkasten.ID (ZettelID, parseZettelID')
 import Neuron.Zettelkasten.ID.Scheme (IDScheme (..))
 import Neuron.Zettelkasten.Query as Q
-import Neuron.Zettelkasten.Zettel.Meta (zettelDateFormat)
+import qualified Neuron.Zettelkasten.Query.Error as Q
 import qualified Neuron.Zettelkasten.Query.Parser as Q
+import Neuron.Zettelkasten.Zettel.Meta (zettelDateFormat)
 import Options.Applicative
 import Relude
 import qualified Rib.Cli
@@ -153,7 +154,7 @@ commandParser defaultNotesDir today = do
     queryReader =
       eitherReader $ \(toText -> s) -> case URI.mkURI s of
         Right uri ->
-          either (Left . show) (maybe (Left "Unsupported query") Right) $ Q.queryFromURI uri
+          either (Left . toString . Q.showQueryParseError) (maybe (Left "Unsupported query") Right) $ Q.queryFromURI uri
         Left e ->
           Left $ displayException e
     nonEmptyTextReader :: ReadM Text
diff --git a/src/app/Neuron/Web/Generate.hs b/src/app/Neuron/Web/Generate.hs
index ec4c075ff..705190d94 100644
--- a/src/app/Neuron/Web/Generate.hs
+++ b/src/app/Neuron/Web/Generate.hs
@@ -16,6 +16,7 @@ where
 
 import Control.Monad.Writer (runWriterT)
 import qualified Data.Graph.Labelled as G
+import qualified Data.Map.Strict as Map
 import Data.Traversable
 import Development.Shake
 import Neuron.Config (Config (..))
@@ -23,10 +24,9 @@ import Neuron.Config.Alias (Alias (..), getAliases)
 import Neuron.Version (neuronVersion, olderThan)
 import qualified Neuron.Web.Route as Z
 import Neuron.Zettelkasten.Connection (Connection (..))
-import Neuron.Zettelkasten.Error (NeuronError (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph.Type (ZettelGraph)
-import Neuron.Zettelkasten.ID (mkZettelID)
+import Neuron.Zettelkasten.ID (ZettelID, mkZettelID)
 import Neuron.Zettelkasten.Query.Error (QueryParseError)
 import Neuron.Zettelkasten.Query.Eval (queryConnections)
 import Neuron.Zettelkasten.Zettel (Zettel, ZettelT (..), mkZettelFromMarkdown)
@@ -67,12 +67,12 @@ loadZettelsIgnoringErrors :: Action [Zettel]
 loadZettelsIgnoringErrors =
   fmap (G.getZettels . fst) loadZettelkasten
 
-loadZettelkasten :: Action (ZettelGraph, [NeuronError])
+loadZettelkasten :: Action (ZettelGraph, Map ZettelID [QueryParseError])
 loadZettelkasten =
   loadZettelkastenFrom =<< Rib.forEvery ["*.md"] pure
 
 -- | Load the Zettelkasten from disk, using the given list of zettel files
-loadZettelkastenFrom :: HasCallStack => [FilePath] -> Action (ZettelGraph, [NeuronError])
+loadZettelkastenFrom :: HasCallStack => [FilePath] -> Action (ZettelGraph, Map ZettelID [QueryParseError])
 loadZettelkastenFrom files = do
   notesDir <- Rib.ribInputDir
   zettels <- forM files $ \((notesDir </>) -> path) -> do
@@ -90,23 +90,18 @@ mkZettelGraph ::
   forall m.
   Monad m =>
   [Zettel] ->
-  m (ZettelGraph, [NeuronError])
+  m (ZettelGraph, Map ZettelID [QueryParseError])
 mkZettelGraph zettels = do
   res :: [(Zettel, ([(Maybe Connection, Zettel)], [QueryParseError]))] <- do
     flip runReaderT zettels $ do
-      -- TODO: re: Left; for Right, we must render the query, which only happens
-      -- in Web.View. How do we accumulate the errors?
       for zettels $ \z -> fmap (z,) $ do
-        (conns, errs) <- runWriterT $ do
-          queryConnections (zettelContent z)
-        pure (conns, errs)
-  -- pure (conns, NeuronError_BadQuery (zettelID z) . Left <$> errs)
+        runWriterT $ queryConnections (zettelContent z)
   let g :: ZettelGraph = G.mkGraphFrom (fst <$> res) $ flip concatMap res $ \(z1, fst -> conns) ->
         conns <&> \(c, z2) -> (connectionMonoid (fromMaybe Folgezettel c), z1, z2)
   pure
     ( g,
-      flip concatMap res $ \(z, (_conns, errs)) ->
-        NeuronError_BadQuery (zettelID z) . Left <$> errs
+      Map.fromListWith (++) $ flip fmap res $ \(z, (_conns, errs)) ->
+        (zettelID z, errs)
     )
   where
     connectionMonoid = Just
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index ee5c5f6b3..e0753cd3e 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -40,10 +40,10 @@ import Neuron.Version (neuronVersion)
 import Neuron.Web.Route
 import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Connection
-import Neuron.Zettelkasten.Error (NeuronError (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import Neuron.Zettelkasten.ID (zettelIDText)
+import Neuron.Zettelkasten.Query.Error (QueryError)
 import Neuron.Zettelkasten.Zettel
 import qualified Neuron.Zettelkasten.Zettel.View as ZettelView
 import Reflex.Dom.Core hiding ((&))
@@ -124,7 +124,7 @@ renderOpenGraph OpenGraph {..} = do
         then f $ URI.render uri'
         else error $ description <> " must be absolute. this URI is not: " <> URI.render uri'
 
-renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m [NeuronError]
+renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m [QueryError]
 renderRouteBody config r (g, x) = do
   case r of
     Route_ZIndex -> do
diff --git a/src/lib/Neuron/Zettelkasten/Error.hs b/src/lib/Neuron/Zettelkasten/Error.hs
deleted file mode 100644
index 9b72d2cfa..000000000
--- a/src/lib/Neuron/Zettelkasten/Error.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Neuron.Zettelkasten.Error
-  ( NeuronError (..),
-    neuronErrorReason,
-  )
-where
-
-import Neuron.Zettelkasten.ID (ZettelID, zettelIDSourceFileName, zettelIDText)
-import Neuron.Zettelkasten.Query.Error
-import Relude
-import qualified Text.Show
-import qualified Text.URI as URI
-
-data NeuronError
-  = -- A zettel file contains invalid link that neuron cannot parse
-    NeuronError_BadQuery ZettelID QueryError
-  deriving (Eq)
-
--- | The reason this particular zettel failed to process fully.
-neuronErrorReason :: NeuronError -> Text
-neuronErrorReason (NeuronError_BadQuery _fromZid e) =
-  case e of
-    Left qe ->
-      "The query URI (" <> URI.render (queryParseErrorUri qe) <> ") " <> case qe of
-        QueryParseError_UnsupportedHost _uri ->
-          "has an unsupported host"
-        QueryParseError_InvalidID _uri e'' ->
-          "has an invalidID: " <> show e''
-    Right (QueryResultError_NoSuchZettel zid) ->
-      "Zettel with ID \""
-        <> zettelIDText zid
-        <> "\" does not exist"
-
-instance Show NeuronError where
-  show err@(NeuronError_BadQuery fromZid _e) =
-    let msg = neuronErrorReason err
-     in toString $
-          unlines
-            [ "",
-              "  Zettel file \"" <> toText (zettelIDSourceFileName fromZid) <> "\" is malformed:",
-              "    " <> msg
-            ]
diff --git a/src/lib/Neuron/Zettelkasten/Query/Error.hs b/src/lib/Neuron/Zettelkasten/Query/Error.hs
index fc341e5f0..561d1cf99 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Error.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Error.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Neuron.Zettelkasten.Query.Error where
 
-import Neuron.Zettelkasten.ID (InvalidID, ZettelID)
+import Neuron.Zettelkasten.ID (InvalidID, ZettelID, zettelIDText)
 import Relude
-import Text.URI
+import Text.URI (URI)
+import qualified Text.URI as URI
 
 type QueryError = Either QueryParseError QueryResultError
 
@@ -22,3 +24,23 @@ queryParseErrorUri :: QueryParseError -> URI
 queryParseErrorUri = \case
   QueryParseError_InvalidID uri _ -> uri
   QueryParseError_UnsupportedHost uri -> uri
+
+showQueryError :: QueryError -> Text
+showQueryError = \case
+  Left qe ->
+    showQueryParseError qe
+  Right re ->
+    showQueryResultError re
+
+showQueryParseError :: QueryParseError -> Text
+showQueryParseError qe =
+  let uri = URI.render (queryParseErrorUri qe)
+   in uri <> ": " <> case qe of
+        QueryParseError_UnsupportedHost _uri ->
+          "unsupported host"
+        QueryParseError_InvalidID _uri e'' ->
+          "invalidID: " <> show e''
+
+showQueryResultError :: QueryResultError -> Text
+showQueryResultError (QueryResultError_NoSuchZettel zid) =
+  "links to non-existant zettel: " <> zettelIDText zid
diff --git a/src/lib/Neuron/Zettelkasten/Query/Eval.hs b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
index 8292ff00d..77f7495e7 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Eval.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Eval.hs
@@ -45,7 +45,8 @@ evalQueryLink link =
 
 queryConnections ::
   forall m.
-  ( MonadWriter [QueryParseError] m,
+  ( -- Errors are written aside, accumulating valid connections.
+    MonadWriter [QueryParseError] m,
     -- Running queries requires the zettels list.
     MonadReader [Zettel] m
   ) =>
diff --git a/src/lib/Neuron/Zettelkasten/Zettel/View.hs b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
index 24a646270..f0d3179c2 100644
--- a/src/lib/Neuron/Zettelkasten/Zettel/View.hs
+++ b/src/lib/Neuron/Zettelkasten/Zettel/View.hs
@@ -26,10 +26,10 @@ import qualified Data.Text as T
 import Data.Tree (Tree (..))
 import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Connection
-import Neuron.Zettelkasten.Error (NeuronError (..), neuronErrorReason)
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import qualified Neuron.Zettelkasten.Graph as G
-import Neuron.Zettelkasten.ID (ZettelID (..), zettelIDSourceFileName)
+import Neuron.Zettelkasten.ID (zettelIDSourceFileName)
+import Neuron.Zettelkasten.Query.Error (QueryError, showQueryError)
 import qualified Neuron.Zettelkasten.Query.Eval as Q
 import Neuron.Zettelkasten.Query.Theme (LinkView (..))
 import qualified Neuron.Zettelkasten.Query.View as Q
@@ -41,7 +41,12 @@ import Relude hiding ((&))
 
 type AutoScroll = Tagged "autoScroll" Bool
 
-renderZettel :: PandocBuilder t m => Maybe Text -> AutoScroll -> (ZettelGraph, Zettel) -> m [NeuronError]
+renderZettel ::
+  PandocBuilder t m =>
+  Maybe Text ->
+  AutoScroll ->
+  (ZettelGraph, Zettel) ->
+  m [QueryError]
 renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
   let upTree = G.backlinkForest Folgezettel z graph
   whenNotNull upTree $ \_ -> do
@@ -67,7 +72,7 @@ renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
         divClass "one wide tablet only computer only column" $ do
           renderActionsMenu VerticalMenu editUrl (Just z)
         divClass "sixteen wide mobile fifteen wide tablet fifteen wide computer stretched column" $ do
-          errors <- renderZettelContent (handleZettelQuery graph zettelID) z
+          errors <- renderZettelContent (handleZettelQuery graph) z
           divClass "ui bottom attached segment deemphasized" $ do
             divClass "ui two column grid" $ do
               divClass "column" $ do
@@ -96,20 +101,19 @@ renderZettel editUrl (Tagged autoScroll) (graph, z@Zettel {..}) = do
 handleZettelQuery ::
   (PandocRawConstraints m, DomBuilder t m, PandocRaw m) =>
   ZettelGraph ->
-  ZettelID ->
-  m [NeuronError] ->
+  m [QueryError] ->
   URILink ->
-  m [NeuronError]
-handleZettelQuery graph zettelID oldRender uriLink = do
+  m [QueryError]
+handleZettelQuery graph oldRender uriLink = do
   case flip runReaderT (G.getZettels graph) (Q.evalQueryLink uriLink) of
-    Left (NeuronError_BadQuery zettelID . Left -> e) -> do
+    Left (Left -> e) -> do
       fmap (e :) oldRender <* elError e
     Right Nothing -> do
       oldRender
     Right (Just res) -> do
       -- TODO: This should render in reflex-dom (no via pandoc's builder)
       case Q.buildQueryView res of
-        Left (NeuronError_BadQuery zettelID . Right -> e) -> do
+        Left (Right -> e) -> do
           fmap (e :) oldRender <* elError e
         Right (Left w) -> do
           elPandocInlines [w]
@@ -120,7 +124,7 @@ handleZettelQuery graph zettelID oldRender uriLink = do
   where
     elError e =
       elClass "span" "ui left pointing red basic label" $ do
-        text $ neuronErrorReason e
+        text $ showQueryError e
 
 renderUplinkForest ::
   DomBuilder t m =>

From 9fa10ee49926f1552b7ab05b9de6ef66f4a7e423 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 11:35:58 -0400
Subject: [PATCH 19/21] Handle errors in 'neuron query'

---
 CHANGELOG.md                                      |  1 +
 neuron.cabal                                      |  1 +
 src/app/Neuron/CLI.hs                             |  6 ++++--
 src/app/Neuron/Web/Generate.hs                    |  7 +++++--
 src/lib/Neuron/Zettelkasten/ID.hs                 |  7 ++++---
 src/lib/Neuron/Zettelkasten/Query.hs              | 15 ++++++++++++---
 src/lib/Neuron/Zettelkasten/Query/Error.hs        |  8 ++++++--
 .../Neuron/Zettelkasten/Query/Error/Internal.hs   | 13 +++++++++++++
 8 files changed, 46 insertions(+), 12 deletions(-)
 create mode 100644 src/lib/Neuron/Zettelkasten/Query/Error/Internal.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c87f55b8c..ebfecd8c9 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,6 +9,7 @@
 - Switch to GHC 8.6 (for reflex-dom)
 - Raw HTML support (#191)
 - Introduce new "uplink tree" view (#195)
+- Resilient error handling (#202)
 - Bug fixes
   - Fix 'neuron new' generating invalid Markdown when title contains special characters (#163)
 
diff --git a/neuron.cabal b/neuron.cabal
index 79b8a8b78..caff99595 100644
--- a/neuron.cabal
+++ b/neuron.cabal
@@ -80,6 +80,7 @@ library
     Neuron.Zettelkasten.Connection
     Neuron.Zettelkasten.Query
     Neuron.Zettelkasten.Query.Error
+    Neuron.Zettelkasten.Query.Error.Internal
     Neuron.Zettelkasten.Query.Eval
     Neuron.Zettelkasten.Query.Parser
     Neuron.Zettelkasten.Query.Theme
diff --git a/src/app/Neuron/CLI.hs b/src/app/Neuron/CLI.hs
index 0db33c69b..c4ffa17e9 100644
--- a/src/app/Neuron/CLI.hs
+++ b/src/app/Neuron/CLI.hs
@@ -19,6 +19,7 @@ import Neuron.CLI.Rib
 import Neuron.CLI.Search (interactiveSearch)
 import qualified Neuron.Version as Version
 import qualified Neuron.Web.Generate as Gen
+import qualified Neuron.Zettelkasten.Graph as G
 import qualified Neuron.Zettelkasten.Query as Q
 import Options.Applicative
 import Relude
@@ -62,7 +63,8 @@ runWith act App {..} =
     Query someQ ->
       runRibOnceQuietly notesDir $ do
         withSome someQ $ \q -> do
-          result <- flip Q.runQuery q <$> Gen.loadZettelsIgnoringErrors
-          putLTextLn $ Aeson.encodeToLazyText $ Q.queryResultJson notesDir q result
+          (graph, errors) <- Gen.loadZettelkasten
+          let result = Q.runQuery (G.getZettels graph) q
+          putLTextLn $ Aeson.encodeToLazyText $ Q.queryResultJson notesDir q result errors
     Search searchCmd ->
       interactiveSearch notesDir searchCmd
diff --git a/src/app/Neuron/Web/Generate.hs b/src/app/Neuron/Web/Generate.hs
index 705190d94..66d0d371e 100644
--- a/src/app/Neuron/Web/Generate.hs
+++ b/src/app/Neuron/Web/Generate.hs
@@ -10,6 +10,7 @@
 -- | Main module for using neuron as a library, instead of as a CLI tool.
 module Neuron.Web.Generate
   ( generateSite,
+    loadZettelkasten,
     loadZettelsIgnoringErrors,
   )
 where
@@ -100,8 +101,10 @@ mkZettelGraph zettels = do
         conns <&> \(c, z2) -> (connectionMonoid (fromMaybe Folgezettel c), z1, z2)
   pure
     ( g,
-      Map.fromListWith (++) $ flip fmap res $ \(z, (_conns, errs)) ->
-        (zettelID z, errs)
+      Map.fromList $ flip mapMaybe res $ \(z, (_conns, errs)) ->
+        if null errs
+          then Nothing
+          else Just (zettelID z, errs)
     )
   where
     connectionMonoid = Just
diff --git a/src/lib/Neuron/Zettelkasten/ID.hs b/src/lib/Neuron/Zettelkasten/ID.hs
index 312e0675e..87abd331b 100644
--- a/src/lib/Neuron/Zettelkasten/ID.hs
+++ b/src/lib/Neuron/Zettelkasten/ID.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -19,7 +20,7 @@ module Neuron.Zettelkasten.ID
   )
 where
 
-import Data.Aeson (FromJSON (..), ToJSON (toJSON))
+import Data.Aeson (FromJSON (..), ToJSON (toJSON), ToJSONKey)
 import qualified Data.Text as T
 import Data.Time
 import Relude
@@ -35,7 +36,7 @@ data ZettelID
     ZettelDateID Day Int
   | -- | Arbitrary alphanumeric ID.
     ZettelCustomID Text
-  deriving (Eq, Show, Ord, Generic)
+  deriving (Eq, Show, Ord, Generic, ToJSONKey)
 
 instance Show InvalidID where
   show (InvalidIDParseError s) =
@@ -78,7 +79,7 @@ zettelIDSourceFileName zid = toString $ zettelIDText zid <> ".md"
 ---------
 
 data InvalidID = InvalidIDParseError Text
-  deriving (Eq)
+  deriving (Eq, Generic, ToJSON)
 
 parseZettelID :: HasCallStack => Text -> ZettelID
 parseZettelID =
diff --git a/src/lib/Neuron/Zettelkasten/Query.hs b/src/lib/Neuron/Zettelkasten/Query.hs
index 4252061e2..6a8cff3db 100644
--- a/src/lib/Neuron/Zettelkasten/Query.hs
+++ b/src/lib/Neuron/Zettelkasten/Query.hs
@@ -25,6 +25,7 @@ import Data.TagTree (Tag, TagPattern (..), tagMatch, tagMatchAny, tagTree)
 import Data.Tree (Tree (..))
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.ID
+import Neuron.Zettelkasten.Query.Error
 import Neuron.Zettelkasten.Query.Theme
 import Neuron.Zettelkasten.Zettel
 import Relude
@@ -55,12 +56,20 @@ runQuery zs = \case
       Map.fromListWith (+) $
         concatMap (\Zettel {..} -> (,1) <$> zettelTags) zs
 
-queryResultJson :: forall r. (ToJSON (Query r)) => FilePath -> Query r -> r -> Value
-queryResultJson notesDir q r =
+queryResultJson ::
+  forall r.
+  (ToJSON (Query r)) =>
+  FilePath ->
+  Query r ->
+  r ->
+  Map ZettelID [QueryParseError] ->
+  Value
+queryResultJson notesDir q r errors =
   toJSON $
     object
       [ "query" .= toJSON q,
-        "result" .= resultJson
+        "result" .= resultJson,
+        "errors" .= errors
       ]
   where
     resultJson :: Value
diff --git a/src/lib/Neuron/Zettelkasten/Query/Error.hs b/src/lib/Neuron/Zettelkasten/Query/Error.hs
index 561d1cf99..97925c45a 100644
--- a/src/lib/Neuron/Zettelkasten/Query/Error.hs
+++ b/src/lib/Neuron/Zettelkasten/Query/Error.hs
@@ -1,10 +1,14 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Neuron.Zettelkasten.Query.Error where
 
+import Data.Aeson
 import Neuron.Zettelkasten.ID (InvalidID, ZettelID, zettelIDText)
+import Neuron.Zettelkasten.Query.Error.Internal ()
 import Relude
 import Text.URI (URI)
 import qualified Text.URI as URI
@@ -14,11 +18,11 @@ type QueryError = Either QueryParseError QueryResultError
 data QueryParseError
   = QueryParseError_InvalidID URI InvalidID
   | QueryParseError_UnsupportedHost URI
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, ToJSON)
 
 -- | This error is only thrown when *using* (eg: in HTML) the query results.
 data QueryResultError = QueryResultError_NoSuchZettel ZettelID
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, ToJSON)
 
 queryParseErrorUri :: QueryParseError -> URI
 queryParseErrorUri = \case
diff --git a/src/lib/Neuron/Zettelkasten/Query/Error/Internal.hs b/src/lib/Neuron/Zettelkasten/Query/Error/Internal.hs
new file mode 100644
index 000000000..66b283212
--- /dev/null
+++ b/src/lib/Neuron/Zettelkasten/Query/Error/Internal.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Neuron.Zettelkasten.Query.Error.Internal where
+
+import Data.Aeson
+import Relude
+import Text.URI (URI, render)
+
+instance ToJSON URI where
+  toJSON = toJSON @Text . render

From b5ef0ec54e4b2022753f70a79a29cea7dd1a67c5 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 13:16:59 -0400
Subject: [PATCH 20/21] Display all errors in the z-index

---
 src/app/Main.hs                      | 13 ++-----
 src/app/Neuron/Web/Generate.hs       | 56 +++++++++++++++++++---------
 src/app/Neuron/Web/Route.hs          | 16 +++++++-
 src/app/Neuron/Web/View.hs           | 46 ++++++++++++++++++++---
 src/lib/Neuron/Zettelkasten/Query.hs |  3 +-
 5 files changed, 100 insertions(+), 34 deletions(-)

diff --git a/src/app/Main.hs b/src/app/Main.hs
index 25732fc9c..1d1c9b75b 100644
--- a/src/app/Main.hs
+++ b/src/app/Main.hs
@@ -15,14 +15,12 @@ import Neuron.CLI (run)
 import Neuron.Config (Config)
 import qualified Neuron.Config as Config
 import Neuron.Web.Generate (generateSite)
-import Neuron.Web.Route (Route (..))
+import Neuron.Web.Route (Route (..), RouteError)
 import Neuron.Web.View (renderRouteBody, renderRouteHead, style)
-import Neuron.Zettelkasten.Query.Error (QueryError, showQueryError)
 import Reflex.Dom.Core
 import Reflex.Dom.Pandoc.Document (PandocBuilder)
 import Relude
 import qualified Rib
-import Rib.Route
 
 main :: IO ()
 main = withUtf8 $ run generateMainSite
@@ -31,18 +29,15 @@ generateMainSite :: Action ()
 generateMainSite = do
   Rib.buildStaticFiles ["static/**"]
   config <- Config.getConfig
-  let writeHtmlRoute :: Route g a -> (g, a) -> Action ()
+  let writeHtmlRoute :: Route g a -> (g, a) -> Action (RouteError a)
       writeHtmlRoute r x = do
         (errors, html) <- liftIO $ renderStatic $ renderPage config r x
         -- FIXME: Make rib take bytestrings
         Rib.writeRoute r $ decodeUtf8 @Text html
-        unless (null errors) $ do
-          putStrLn $ "E " <> fromMaybe "Unknown path" (routeFile r)
-          forM_ errors $ \err ->
-            putTextLn $ "  - " <> showQueryError err
+        pure errors
   void $ generateSite config writeHtmlRoute
 
-renderPage :: PandocBuilder t m => Config -> Route g a -> (g, a) -> m [QueryError]
+renderPage :: PandocBuilder t m => Config -> Route g a -> (g, a) -> m (RouteError a)
 renderPage config r val = elAttr "html" ("lang" =: "en") $ do
   el "head" $ do
     renderRouteHead config r val
diff --git a/src/app/Neuron/Web/Generate.hs b/src/app/Neuron/Web/Generate.hs
index 66d0d371e..52aebb134 100644
--- a/src/app/Neuron/Web/Generate.hs
+++ b/src/app/Neuron/Web/Generate.hs
@@ -28,61 +28,83 @@ import Neuron.Zettelkasten.Connection (Connection (..))
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph.Type (ZettelGraph)
 import Neuron.Zettelkasten.ID (ZettelID, mkZettelID)
-import Neuron.Zettelkasten.Query.Error (QueryParseError)
+import Neuron.Zettelkasten.Query.Error (QueryParseError, showQueryError)
 import Neuron.Zettelkasten.Query.Eval (queryConnections)
 import Neuron.Zettelkasten.Zettel (Zettel, ZettelT (..), mkZettelFromMarkdown)
 import Options.Applicative
+import Reflex.Class (filterLeft, filterRight)
 import Relude
 import qualified Rib
+import Rib.Route
 import System.FilePath
 
 -- | Generate the Zettelkasten site
 generateSite ::
   Config ->
-  (forall a. Z.Route ZettelGraph a -> (ZettelGraph, a) -> Action ()) ->
+  (forall a. Z.Route ZettelGraph a -> (ZettelGraph, a) -> Action (Z.RouteError a)) ->
   Action ZettelGraph
 generateSite config writeHtmlRoute' = do
   when (olderThan $ minVersion config)
     $ fail
     $ toString
     $ "Require neuron mininum version " <> minVersion config <> ", but your neuron version is " <> neuronVersion
-  -- NOTE: We ignore errors, because they will be displayed during rendering.
-  (zettelGraph, _errors) <- loadZettelkasten
-  let writeHtmlRoute v r = writeHtmlRoute' r (zettelGraph, v)
+  (zettelGraph, errors) <- loadZettelkasten
+  -- NOTE: Right errors are handled further below in individual zettel generation.
+  let skippedErrors = Map.mapMaybe leftToMaybe errors
+      writeHtmlRoute :: forall a. a -> Z.Route ZettelGraph a -> Action (Z.RouteError a)
+      writeHtmlRoute v r = writeHtmlRoute' r (zettelGraph, v)
   -- Generate HTML for every zettel
-  forM_ (G.getZettels zettelGraph) $ \z ->
-    -- TODO: Should `Zettel` not contain ZettelID?
-    -- See duplication in `renderZettel`
-    writeHtmlRoute z $ Z.Route_Zettel (zettelID z)
+  forM_ (G.getZettels zettelGraph) $ \z -> do
+    let r = Z.Route_Zettel $ zettelID z
+    zerrors <- writeHtmlRoute z r
+    unless (null zerrors) $ do
+      reportError r Nothing $ showQueryError <$> zerrors
   -- Generate the z-index
-  writeHtmlRoute () Z.Route_ZIndex
+  writeHtmlRoute errors Z.Route_ZIndex
   -- Generate search page
   writeHtmlRoute () Z.Route_Search
   -- Write alias redirects, unless a zettel with that name exists.
   aliases <- getAliases config zettelGraph
   forM_ aliases $ \Alias {..} ->
     writeHtmlRoute targetZettel (Z.Route_Redirect aliasZettel)
+  forM_ (Map.toList skippedErrors) $ \(zid, err) -> do
+    reportError (Z.Route_Zettel zid) (Just "SKIPPED") [err]
   pure zettelGraph
 
+-- | Report an error in the terminal
+reportError :: (MonadIO m, IsRoute r) => r a -> Maybe Text -> [Text] -> m ()
+reportError route mErrorKind errors = do
+  putTextLn $ "E " <> fromMaybe "Unknown route" (fmap toText $ routeFile route) <> maybe "" (\x -> " (" <> x <> ")") mErrorKind
+  forM_ errors $ \err ->
+    putText $ "  - " <> indentAllButFirstLine 4 err
+
+indentAllButFirstLine :: Int -> Text -> Text
+indentAllButFirstLine n = unlines . go . lines
+  where
+    go [] = []
+    go [x] = [x]
+    go (x : xs) =
+      x : fmap (toText . (take n (repeat ' ') <>) . toString) xs
+
 loadZettelsIgnoringErrors :: Action [Zettel]
 loadZettelsIgnoringErrors =
   fmap (G.getZettels . fst) loadZettelkasten
 
-loadZettelkasten :: Action (ZettelGraph, Map ZettelID [QueryParseError])
+loadZettelkasten :: Action (ZettelGraph, Map ZettelID (Either Text [QueryParseError]))
 loadZettelkasten =
   loadZettelkastenFrom =<< Rib.forEvery ["*.md"] pure
 
 -- | Load the Zettelkasten from disk, using the given list of zettel files
-loadZettelkastenFrom :: HasCallStack => [FilePath] -> Action (ZettelGraph, Map ZettelID [QueryParseError])
+loadZettelkastenFrom :: [FilePath] -> Action (ZettelGraph, Map ZettelID (Either Text [QueryParseError]))
 loadZettelkastenFrom files = do
   notesDir <- Rib.ribInputDir
-  zettels <- forM files $ \((notesDir </>) -> path) -> do
+  parseRes <- forM files $ \((notesDir </>) -> path) -> do
     s <- toText <$> readFile' path
     let zid = mkZettelID path
-    case mkZettelFromMarkdown zid s snd of
-      Left e -> fail $ toString e
-      Right zettel -> pure zettel
-  mkZettelGraph zettels
+    pure $ first (zid,) $ mkZettelFromMarkdown zid s snd
+  let skippedZettelErrors :: [(ZettelID, Text)] = filterLeft parseRes
+  (g, errors) <- mkZettelGraph $ filterRight parseRes
+  pure (g, fmap Left (Map.fromList skippedZettelErrors) `Map.union` fmap Right errors)
 
 -- | Build the Zettelkasten graph from a list of zettels
 --
diff --git a/src/app/Neuron/Web/Route.hs b/src/app/Neuron/Web/Route.hs
index 0e740f837..5c94953ab 100644
--- a/src/app/Neuron/Web/Route.hs
+++ b/src/app/Neuron/Web/Route.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -18,6 +19,7 @@ import Neuron.Config
 import Neuron.Markdown (getFirstParagraphText)
 import Neuron.Zettelkasten.Graph.Type
 import Neuron.Zettelkasten.ID
+import Neuron.Zettelkasten.Query.Error
 import Neuron.Zettelkasten.Zettel
 import Relude
 import Rib (IsRoute (..), routeUrl, routeUrlRel)
@@ -29,10 +31,22 @@ import qualified Text.URI as URI
 
 data Route graph a where
   Route_Redirect :: ZettelID -> Route ZettelGraph ZettelID
-  Route_ZIndex :: Route ZettelGraph ()
+  -- ZIndex takes a report of all errors in the zettelkasten.
+  -- `Left` is skipped zettels; and Right is valid zettels with invalid query links.
+  Route_ZIndex :: Route ZettelGraph (Map ZettelID (Either Text [QueryParseError]))
   Route_Search :: Route ZettelGraph ()
   Route_Zettel :: ZettelID -> Route ZettelGraph Zettel
 
+type family RouteError r
+
+type instance RouteError (Map ZettelID (Either Text [QueryParseError])) = ()
+
+type instance RouteError ZettelID = ()
+
+type instance RouteError () = ()
+
+type instance RouteError Zettel = [QueryError]
+
 instance IsRoute (Route graph) where
   routeFile = \case
     Route_Redirect zid ->
diff --git a/src/app/Neuron/Web/View.hs b/src/app/Neuron/Web/View.hs
index e0753cd3e..3f5d74b0f 100644
--- a/src/app/Neuron/Web/View.hs
+++ b/src/app/Neuron/Web/View.hs
@@ -28,6 +28,7 @@ import qualified Data.Aeson.Text as Aeson
 import Data.Default (def)
 import Data.FileEmbed (embedStringFile)
 import Data.Foldable (maximum)
+import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Structured.Breadcrumb (Breadcrumb)
 import qualified Data.Structured.Breadcrumb as Breadcrumb
@@ -42,8 +43,9 @@ import qualified Neuron.Web.Theme as Theme
 import Neuron.Zettelkasten.Connection
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.Graph (ZettelGraph)
-import Neuron.Zettelkasten.ID (zettelIDText)
-import Neuron.Zettelkasten.Query.Error (QueryError)
+import Neuron.Zettelkasten.ID (ZettelID, zettelIDSourceFileName, zettelIDText)
+import Neuron.Zettelkasten.Query.Error (QueryParseError, showQueryParseError)
+import Neuron.Zettelkasten.Query.View (zettelUrl)
 import Neuron.Zettelkasten.Zettel
 import qualified Neuron.Zettelkasten.Zettel.View as ZettelView
 import Reflex.Dom.Core hiding ((&))
@@ -124,12 +126,12 @@ renderOpenGraph OpenGraph {..} = do
         then f $ URI.render uri'
         else error $ description <> " must be absolute. this URI is not: " <> URI.render uri'
 
-renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m [QueryError]
+renderRouteBody :: PandocBuilder t m => Config -> Route graph a -> (graph, a) -> m (RouteError a)
 renderRouteBody config r (g, x) = do
   case r of
     Route_ZIndex -> do
       divClass "ui text container" $ do
-        renderIndex config g
+        renderIndex config g x
         renderBrandFooter
       pure mempty
     Route_Search {} -> do
@@ -145,10 +147,42 @@ renderRouteBody config r (g, x) = do
       elAttr "meta" ("http-equiv" =: "Refresh" <> "content" =: ("0; url=" <> (Rib.routeUrlRel $ Route_Zettel x))) blank
       pure mempty
 
-renderIndex :: DomBuilder t m => Config -> ZettelGraph -> m ()
-renderIndex Config {..} graph = do
+renderErrors :: DomBuilder t m => Map ZettelID (Either Text [QueryParseError]) -> m ()
+renderErrors errors = do
+  let skippedZettels = Map.mapMaybe leftToMaybe errors
+      zettelsWithErrors = Map.mapMaybe rightToMaybe errors
+  unless (null skippedZettels) $ do
+    divClass "ui small negative message" $ do
+      divClass "header" $ do
+        text "These files are excluded from the zettelkasten due to parse errors"
+      el "p" $ do
+        el "ol" $ do
+          forM_ (Map.toList skippedZettels) $ \(zid, err) ->
+            el "li" $ do
+              el "b" $ el "tt" $ text $ toText $ zettelIDSourceFileName zid
+              text ": "
+              el "pre" $ text err
+  forM_ (Map.toList zettelsWithErrors) $ \(zid, qerrors) ->
+    divClass "ui tiny warning message" $ do
+      divClass "header" $ do
+        text $ "Zettel "
+        elClass "span" "zettel-link-container" $ do
+          elClass "span" "zettel-link" $ do
+            elAttr "a" ("href" =: zettelUrl zid) $ text $ zettelIDText zid
+        text " has errors"
+      el "p" $ do
+        el "ol" $ do
+          forM_ qerrors $ \qe ->
+            -- NOTE: This doesn't show query result errors, such as linking to
+            -- non-existant IDs. Because results are evaluated only during
+            -- rendering stage.
+            el "li" $ el "pre" $ text $ showQueryParseError qe
+
+renderIndex :: DomBuilder t m => Config -> ZettelGraph -> Map ZettelID (Either Text [QueryParseError]) -> m ()
+renderIndex Config {..} graph errors = do
   let neuronTheme = Theme.mkTheme theme
   elClass "h1" "header" $ text "Zettel Index"
+  renderErrors errors
   divClass "z-index" $ do
     -- Cycle detection.
     case G.topSort graph of
diff --git a/src/lib/Neuron/Zettelkasten/Query.hs b/src/lib/Neuron/Zettelkasten/Query.hs
index 6a8cff3db..55c073f32 100644
--- a/src/lib/Neuron/Zettelkasten/Query.hs
+++ b/src/lib/Neuron/Zettelkasten/Query.hs
@@ -62,7 +62,8 @@ queryResultJson ::
   FilePath ->
   Query r ->
   r ->
-  Map ZettelID [QueryParseError] ->
+  -- All errors in the zettelkasten
+  Map ZettelID (Either Text [QueryParseError]) ->
   Value
 queryResultJson notesDir q r errors =
   toJSON $

From 8e542dbda49341a6f2de8646b5b3630cb4327101 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Sat, 23 May 2020 13:36:58 -0400
Subject: [PATCH 21/21] Advance reflex-dom-pandoc

---
 dep/reflex-dom-pandoc/github.json | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/dep/reflex-dom-pandoc/github.json b/dep/reflex-dom-pandoc/github.json
index 78dc760c7..7ba6f4806 100644
--- a/dep/reflex-dom-pandoc/github.json
+++ b/dep/reflex-dom-pandoc/github.json
@@ -1,8 +1,8 @@
 {
   "owner": "srid",
   "repo": "reflex-dom-pandoc",
-  "branch": "custom-link-render",
+  "branch": "master",
   "private": false,
-  "rev": "be882cbfc3747462df8c074fc1e99d36a9dcff58",
+  "rev": "9d577e78112f286795e5888e43f2b24ea4aa282a",
   "sha256": "0csxpmd3f4bh2iiiark8wfvdzb4gwvg84wm079fnwjwrn3jirpgz"
 }