Merge pull request #448 from srid/better404

Simplify 'zettel not found' error message in HTML

CHANGELOG.md

@@ -7,6 +7,8 @@
 - `neuron search`
   - Revert #429 for neuron-search regression
   - Deal with title IDs in search (#445)
+- Web interface
+  - Simplify error message UX for missing wiki-links (#448)
 
 ## 1.0.1.0
 

neuron/neuron.cabal

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

neuron/src/app/Neuron/CLI/Types.hs

@@ -34,7 +34,6 @@ import qualified Neuron.Web.Route as R
 import qualified Neuron.Zettelkasten.Connection as C
 import Neuron.Zettelkasten.ID (ZettelID, parseZettelID)
 import Neuron.Zettelkasten.ID.Scheme (IDScheme (..))
-import qualified Neuron.Zettelkasten.Query.Error as Q
 import Neuron.Zettelkasten.Query.Graph as Q
 import qualified Neuron.Zettelkasten.Query.Parser as Q
 import Neuron.Zettelkasten.Zettel as Q
@@ -219,10 +218,8 @@ commandParser defaultNotesDir now = do
     queryReader =
       eitherReader $ \(toText -> s) -> case URI.mkURI s of
         Right uri ->
-          either
-            (Left . toString . Q.showQueryParseError)
-            (maybe (Left "Unsupported query") Right)
-            $ Q.queryFromURI connDummy uri
+          maybe (Left "Not a valid query") Right $
+            Q.queryFromURI connDummy uri
         Left e ->
           Left $ displayException e
     dateReader :: ReadM DateMayTime

neuron/src/app/Neuron/Web/Generate.hs

@@ -35,7 +35,7 @@ import qualified Neuron.Web.Route as Z
 import qualified Neuron.Zettelkasten.Graph.Build as G
 import Neuron.Zettelkasten.Graph.Type (ZettelGraph)
 import Neuron.Zettelkasten.ID (ZettelID, getZettelID)
-import Neuron.Zettelkasten.Query.Error (showQueryError)
+import Neuron.Zettelkasten.Query.Error (showQueryResultError)
 import Neuron.Zettelkasten.Zettel
 import Options.Applicative
 import Relude
@@ -83,8 +83,8 @@ generateSite config writeHtmlRoute' = do
       case err of
         ZettelError_ParseError (untag -> parseErr) ->
           parseErr :| []
-        ZettelError_QueryErrors queryErrs ->
-          showQueryError <$> queryErrs
+        ZettelError_QueryResultErrors queryErrs ->
+          showQueryResultError <$> queryErrs
         ZettelError_AmbiguousFiles filePaths ->
           ("Multiple zettels have the same ID: " <> T.intercalate ", " (fmap toText $ toList filePaths))
             :| []

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

@@ -12,6 +12,7 @@ module Neuron.Web.Query.View
   ( renderQueryResult,
     renderZettelLink,
     renderZettelLinkIDOnly,
+    renderMissingZettelLink,
     style,
   )
 where
@@ -32,14 +33,15 @@ import Data.TagTree
   )
 import qualified Data.Text as T
 import Data.Tree (Forest, Tree (Node))
+import Neuron.Reader.Type (ZettelFormat (ZettelFormat_Markdown))
 import Neuron.Web.Route
   ( NeuronWebT,
     Route (..),
     neuronRouteLink,
   )
-import Neuron.Web.Widget (elTime, semanticIcon)
+import Neuron.Web.Widget (elNoSnippetSpan, elTime, semanticIcon)
 import Neuron.Zettelkasten.Connection (Connection (Folgezettel))
-import Neuron.Zettelkasten.ID (ZettelID (zettelIDRaw))
+import Neuron.Zettelkasten.ID (ZettelID (zettelIDRaw), zettelIDSourceFileName)
 import Neuron.Zettelkasten.Query.Theme (LinkView (..), ZettelsView (..))
 import Neuron.Zettelkasten.Zettel
   ( Zettel,
@@ -128,7 +130,7 @@ renderZettelLink ::
   NeuronWebT t m ()
 renderZettelLink mInner conn (fromMaybe def -> linkView) Zettel {..} = do
   let connClass = show <$> conn
-      rawClass = either (const $ Just "raw") (const Nothing) zettelError
+      rawClass = maybe Nothing (const $ Just "errors") zettelError
       mextra =
         case linkView of
           LinkView_Default ->
@@ -148,10 +150,7 @@ renderZettelLink mInner conn (fromMaybe def -> linkView) Zettel {..} = do
     elAttr "span" ("class" =: "zettel-link" <> withTooltip linkTooltip) $ do
       let linkInnerHtml = fromMaybe (text zettelTitle) mInner
       neuronRouteLink (Some $ Route_Zettel zettelID) mempty linkInnerHtml
-      case conn of
-        Just Folgezettel -> elNoSnippetSpan mempty $ do
-          elAttr "sup" ("title" =: "Branching link (folgezettel)") $ text "ᛦ"
-        _ -> pure mempty
+      elConnSuffix conn
   where
     linkTooltip =
       -- If there is custom inner text, put zettel title in tooltip.
@@ -162,10 +161,6 @@ renderZettelLink mInner conn (fromMaybe def -> linkView) Zettel {..} = do
           if null zettelTags
             then Nothing
             else Just $ "Tags: " <> T.intercalate "; " (unTag <$> zettelTags)
-    -- Prevent this element from appearing in Google search results
-    -- https://developers.google.com/search/reference/robots_meta_tag#data-nosnippet-attr
-    elNoSnippetSpan :: DomBuilder t m => Map Text Text -> NeuronWebT t m a -> NeuronWebT t m a
-    elNoSnippetSpan attrs = elAttr "span" ("data-nosnippet" =: "" <> attrs)
     withTooltip :: Maybe Text -> Map Text Text
     withTooltip = \case
       Nothing -> mempty
@@ -175,6 +170,24 @@ renderZettelLink mInner conn (fromMaybe def -> linkView) Zettel {..} = do
             <> "data-position" =: "right center"
         )
 
+elConnSuffix :: DomBuilder t m => Maybe Connection -> m ()
+elConnSuffix mconn =
+  case mconn of
+    Just Folgezettel -> elNoSnippetSpan mempty $ do
+      elAttr "sup" ("title" =: "Branching link (folgezettel)") $ text "ᛦ"
+    _ -> pure mempty
+
+-- TODO: Eventually refactor this function to reuse what's in renderZettelLink
+renderMissingZettelLink :: DomBuilder t m => Maybe Connection -> ZettelID -> m ()
+renderMissingZettelLink mconn zid = do
+  let connClass = show <$> mconn
+      classes :: [Text] = catMaybes $ [Just "zettel-link-container", Just "errors"] <> [connClass]
+  elClass "span" (T.intercalate " " classes) $ do
+    let errMsg = "Broken wiki-link (" <> toText (zettelIDSourceFileName zid ZettelFormat_Markdown) <> " does not exist)"
+    elAttr "span" ("class" =: "zettel-link" <> "title" =: errMsg) $ do
+      elAttr "a" mempty $ text $ zettelIDRaw zid
+      elConnSuffix mconn
+
 -- | Like `renderZettelLink` but when we only have ID in hand.
 renderZettelLinkIDOnly :: DomBuilder t m => ZettelID -> NeuronWebT t m ()
 renderZettelLinkIDOnly zid =
@@ -233,7 +246,7 @@ zettelLinkCss = do
     C.textDecoration C.none
   "span.zettel-link-container span.extra" ? do
     C.color C.auto
-  "span.zettel-link-container.raw" ? do
+  "span.zettel-link-container.errors" ? do
     C.border C.solid (C.px 1) C.red
   "[data-tooltip]:after" ? do
     C.fontSize $ em 0.7

neuron/src/lib/Neuron/Web/Widget.hs

@@ -17,6 +17,11 @@ elTime t = do
   elAttr "time" ("datetime" =: formatDateMayTime t) $ do
     text $ formatDay $ getDay t
 
+-- | A pre element with scrollbar
+elPreOverflowing :: DomBuilder t m => m a -> m a
+elPreOverflowing w =
+  elAttr "pre" ("style" =: "overflow: auto") w
+
 semanticIcon :: DomBuilder t m => Text -> m ()
 semanticIcon name = elClass "i" (name <> " icon") blank
 
@@ -25,3 +30,8 @@ elLinkGoogleFonts fs =
   let fsEncoded = T.intercalate "|" $ T.replace " " "+" <$> fs
       fsUrl = "https://fonts.googleapis.com/css?family=" <> fsEncoded <> "&display=swap"
    in elAttr "link" ("rel" =: "stylesheet" <> "href" =: fsUrl) blank
+
+-- Prevent this element from appearing in Google search results
+-- https://developers.google.com/search/reference/robots_meta_tag#data-nosnippet-attr
+elNoSnippetSpan :: DomBuilder t m => Map Text Text -> m a -> m a
+elNoSnippetSpan attrs = elAttr "span" ("data-nosnippet" =: "" <> attrs)

neuron/src/lib/Neuron/Web/ZIndex.hs

@@ -23,13 +23,19 @@ import Data.Tree
 import qualified Neuron.Web.Query.View as QueryView
 import Neuron.Web.Route
 import qualified Neuron.Web.Theme as Theme
+import Neuron.Web.Widget (elPreOverflowing)
+import Neuron.Web.Zettel.View (renderZettelParseError)
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import qualified Neuron.Zettelkasten.Graph as G
 import Neuron.Zettelkasten.ID (ZettelID (..))
 import Neuron.Zettelkasten.Query (zettelsByTag)
-import Neuron.Zettelkasten.Query.Error (showQueryError)
+import Neuron.Zettelkasten.Query.Error (showQueryResultError)
 import Neuron.Zettelkasten.Zettel
+  ( Zettel,
+    ZettelError (..),
+    ZettelT (zettelTitle),
+  )
 import Reflex.Dom.Core hiding (mapMaybe, (&))
 import Relude hiding ((&))
 
@@ -123,17 +129,17 @@ renderErrors :: DomBuilder t m => Map ZettelID ZettelError -> NeuronWebT t m ()
 renderErrors errors = do
   let severity = \case
         ZettelError_ParseError _ -> "negative"
-        ZettelError_QueryErrors _ -> "warning"
+        ZettelError_QueryResultErrors _ -> "warning"
         ZettelError_AmbiguousFiles _ -> "negative"
       errorMessageHeader zid = \case
         ZettelError_ParseError _ -> do
           text "Zettel "
           QueryView.renderZettelLinkIDOnly zid
           text " failed to parse"
-        ZettelError_QueryErrors _ -> do
+        ZettelError_QueryResultErrors _ -> do
           text "Zettel "
           QueryView.renderZettelLinkIDOnly zid
-          text " has malformed queries"
+          text " has broken wiki-links"
         ZettelError_AmbiguousFiles _ -> do
           text $
             "More than one file define the same zettel ID slug ("
@@ -145,11 +151,11 @@ renderErrors errors = do
       el "p" $ do
         case zError of
           ZettelError_ParseError parseError ->
-            el "pre" $ text $ show parseError
-          ZettelError_QueryErrors queryErrors ->
+            renderZettelParseError parseError
+          ZettelError_QueryResultErrors queryErrors ->
             el "ol" $ do
               forM_ queryErrors $ \qe ->
-                el "li" $ el "pre" $ text $ showQueryError qe
+                el "li" $ elPreOverflowing $ text $ showQueryResultError qe
           ZettelError_AmbiguousFiles filePaths ->
             el "ul" $ do
               forM_ filePaths $ \fp ->

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

@@ -5,18 +5,22 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Neuron.Web.Zettel.View
   ( renderZettel,
     renderZettelContentCard,
+    renderZettelParseError,
   )
 where
 
 import Data.Some
 import Data.TagTree
+import Data.Tagged (untag)
+import Neuron.Reader.Type (ZettelParseError)
 import qualified Neuron.Web.Query.View as Q
 import Neuron.Web.Route
 import Neuron.Web.Widget
@@ -25,7 +29,7 @@ import qualified Neuron.Web.Widget.InvertedTree as IT
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.Graph (ZettelGraph)
 import qualified Neuron.Zettelkasten.Graph as G
-import Neuron.Zettelkasten.Query.Error (QueryError, showQueryError)
+import Neuron.Zettelkasten.Query.Error (QueryResultError (..))
 import qualified Neuron.Zettelkasten.Query.Eval as Q
 import Neuron.Zettelkasten.Zettel
 import Reflex.Dom.Core hiding ((&))
@@ -89,24 +93,20 @@ renderZettelBottomPane graph z@Zettel {..} = do
 evalAndRenderZettelQuery ::
   PandocBuilder t m =>
   ZettelGraph ->
-  NeuronWebT t m [QueryError] ->
+  NeuronWebT t m [QueryResultError] ->
   URILink ->
-  NeuronWebT t m [QueryError]
+  NeuronWebT t m [QueryResultError]
 evalAndRenderZettelQuery graph oldRender uriLink@(URILink inner _uri) = do
   case flip runReaderT (G.getZettels graph) (Q.runQueryURILink uriLink) of
-    Left e -> do
-      -- Error parsing or running the query.
-      fmap (e :) oldRender <* elInlineError e
+    Left e@(QueryResultError_NoSuchZettel mconn zid) -> do
+      Q.renderMissingZettelLink mconn zid
+      pure [e]
     Right Nothing -> do
       -- This is not a query link; pass through.
       oldRender
     Right (Just res) -> do
       Q.renderQueryResult inner res
       pure mempty
-  where
-    elInlineError e =
-      elClass "span" "ui left pointing red basic label" $ do
-        text $ showQueryError e
 
 renderZettelContent ::
   forall t m a.
@@ -128,9 +128,13 @@ renderZettelRawContent :: (DomBuilder t m) => ZettelT Text -> m ()
 renderZettelRawContent Zettel {..} = do
   divClass "ui error message" $ do
     elClass "h2" "header" $ text "Zettel failed to parse"
-    el "p" $ el "pre" $ text $ show zettelError
+    maybe blank renderZettelParseError zettelError
   elClass "article" "ui raised attached segment zettel-content raw" $ do
-    el "pre" $ text $ zettelContent
+    elPreOverflowing $ text $ zettelContent
+
+renderZettelParseError :: DomBuilder t m => ZettelParseError -> m ()
+renderZettelParseError err =
+  el "p" $ elPreOverflowing $ text $ untag err
 
 renderTags :: DomBuilder t m => NonEmpty Tag -> NeuronWebT t m ()
 renderTags tags = do

neuron/src/lib/Neuron/Zettelkasten/Graph/Build.hs

@@ -15,7 +15,7 @@ import Neuron.Reader.Type
 import Neuron.Zettelkasten.Connection
 import Neuron.Zettelkasten.Graph.Type
 import Neuron.Zettelkasten.ID
-import Neuron.Zettelkasten.Query.Error (QueryError)
+import Neuron.Zettelkasten.Query.Error (QueryResultError)
 import Neuron.Zettelkasten.Query.Eval (queryConnections)
 import Neuron.Zettelkasten.Zettel
 import Neuron.Zettelkasten.Zettel.Parser
@@ -29,13 +29,16 @@ buildZettelkasten ::
   )
 buildZettelkasten fs =
   let zs = parseZettels fs
-      (g, queryErrors) = mkZettelGraph $ filter (not . zettelUnlisted) $ sansContent <$> zs
+      (g, qErrs) = mkZettelGraph $ filter (not . zettelUnlisted) $ sansContent <$> zs
       errors =
         Map.unions
           [ fmap ZettelError_ParseError $
               Map.fromList $
-                lefts zs <&> (zettelID &&& zettelError),
-            fmap ZettelError_QueryErrors queryErrors
+                flip mapMaybe (lefts zs) $ \z ->
+                  case zettelError z of
+                    Just zerr -> Just (zettelID z, zerr)
+                    _ -> Nothing,
+            fmap ZettelError_QueryResultErrors qErrs
           ]
    in (g, zs, errors)
 
@@ -46,10 +49,10 @@ buildZettelkasten fs =
 mkZettelGraph ::
   [Zettel] ->
   ( ZettelGraph,
-    Map ZettelID (NonEmpty QueryError)
+    Map ZettelID (NonEmpty QueryResultError)
   )
 mkZettelGraph zettels =
-  let res :: [(Zettel, ([(Connection, Zettel)], [QueryError]))] =
+  let res :: [(Zettel, ([(Connection, Zettel)], [QueryResultError]))] =
         flip fmap zettels $ \z ->
           (z, runQueryConnections zettels z)
       g :: ZettelGraph = G.mkGraphFrom zettels $
@@ -60,7 +63,7 @@ mkZettelGraph zettels =
           (zettelID z,) <$> merrs
    in (g, errors)
 
-runQueryConnections :: [Zettel] -> Zettel -> ([(Connection, Zettel)], [QueryError])
+runQueryConnections :: [Zettel] -> Zettel -> ([(Connection, Zettel)], [QueryResultError])
 runQueryConnections zettels z =
   flip runReader zettels $ do
     runWriterT $ queryConnections z

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

@@ -98,6 +98,7 @@ allowedSpecialChars =
     '-',
     '.',
     -- Whitespace is essential for title IDs
+    -- This gets replaced with underscope in ID slug (see unsafeMkZettelID).
     ' ',
     -- Allow some puctuation letters that are common in note titles
     ',',

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

@@ -33,10 +33,10 @@ import Relude
 
 runZettelQuery :: [Zettel] -> ZettelQuery r -> Either QueryResultError r
 runZettelQuery zs = \case
-  ZettelQuery_ZettelByID zid _ ->
+  ZettelQuery_ZettelByID zid conn ->
     case find ((== zid) . zettelID) zs of
       Nothing ->
-        Left $ QueryResultError_NoSuchZettel zid
+        Left $ QueryResultError_NoSuchZettel (Just conn) zid
       Just z ->
         Right z
   ZettelQuery_ZettelsByTag pats _mconn _mview ->
@@ -67,7 +67,7 @@ runGraphQuery g = \case
   GraphQuery_BacklinksOf conn zid ->
     case getZettel zid g of
       Nothing ->
-        Left $ QueryResultError_NoSuchZettel zid
+        Left $ QueryResultError_NoSuchZettel conn zid
       Just z ->
         Right $ backlinks (maybe isJust (const (== conn)) conn) z g