Human-readable "no such vertex"-error

function-graph.cabal

@@ -76,6 +76,7 @@ library function-graph-server
                     , streaming
                     , time
                     , file-embed
+                    , these
     hs-source-dirs:   src/server
     default-language: Haskell2010
 

src/server/Server.hs

@@ -68,20 +68,20 @@ mkHandlers searchConfig appendToHead graph = do
   (typeaheadHandler, initalSuggestions) <-
     Server.Pages.Typeahead.mkHandler (Just typeaheadCountLimit) graph
   let mkRootHandler = Server.Pages.Root.page (fixSvgWidth <> appendToHead <> bodyMargin) htmxScript initalSuggestions
-  searchEnv <- Server.Pages.Search.createSearchEnv graph
+  searchEnv <- Server.Pages.Search.createSearchEnv mkRootHandler graph
   pure $ Handlers
-        (mkRootHandler (mempty, Nothing))
-        (\mHxBoosted mSrc mDst mMaxCount mNoGraph -> do
-            let runSearchHandler = Server.Pages.Search.handler searchConfig searchEnv mHxBoosted mSrc mDst mMaxCount mNoGraph
-            case mHxBoosted of
-              Just HxBoosted -> do
-                (searchResult, _) <- runSearchHandler
-                pure searchResult
-              Nothing -> do
-                (searchResult, (src, dst)) <- runSearchHandler
-                pure $ mkRootHandler (searchResult, Just (src, dst))
+        (mkRootHandler (mempty, (Nothing, Nothing))) -- root handler
+        (\mHxBoosted mSrc mDst mMaxCount mNoGraph -> do -- search handler
+            Server.Pages.Search.handler
+              searchConfig
+              searchEnv
+              mHxBoosted
+              mSrc
+              mDst
+              mMaxCount
+              mNoGraph
         )
-        typeaheadHandler
+        typeaheadHandler -- typeahead handler
   where
     typeaheadCountLimit = 25
 

src/server/Server/Pages/Root.hs

@@ -13,9 +13,8 @@ import Lucid
 import Lucid.Base
 import Lucid.Htmx
 import qualified Data.Text as T
-import qualified FunGraph
-import qualified Server.Pages.Typeahead
 import Server.HtmlStream
+import Data.Maybe (fromMaybe)
 
 type HandlerType = HtmlStream IO ()
 
@@ -27,8 +26,9 @@ page
   -- ^ Append to 'body' content
   -> Html ()
   -- ^ Initial typeahead suggestions (sequence of 'option' elements)
-  -> (HtmlStream m (), Maybe (FunGraph.FullyQualifiedType, FunGraph.FullyQualifiedType))
-  -- ^ Search result HTML and maybe the entered (src, dst).
+  -> (HtmlStream m (), (Maybe T.Text, Maybe T.Text))
+  -- ^ 1. Search result HTML
+  --   2. Maybe the entered (src, dst). NOTE: 'T.Text' instead of 'FunGraph.FullyQualifiedType' because we want to support filling the input fields with arbitrary text (not just valid types).
   --
   --   If the user pastes a "/search?..." link into the browser then we want to display
   --   the root page with the search results included, as well as "src" and "dst" filled in.
@@ -53,7 +53,7 @@ page appendToHead appendToBody initialSuggestions (searchResult, mSrcDst) = do
 form
   :: T.Text -- ^ targetId
   -> Html ()  -- ^ Initial suggestions
-  -> Maybe (FunGraph.FullyQualifiedType, FunGraph.FullyQualifiedType) -- ^ Initial values for (src, dst)
+  -> (Maybe T.Text, Maybe T.Text) -- ^ Initial values for (src, dst)
   -> Html ()
 form targetId initialSuggestions mSrcDst = do
   h2_ "Search"
@@ -100,13 +100,13 @@ form targetId initialSuggestions mSrcDst = do
 
 mkTypeaheadInputs
   :: Html ()
-  -> Maybe (FunGraph.FullyQualifiedType, FunGraph.FullyQualifiedType) -- ^ Initial values for (src, dst)
+  -> (Maybe T.Text, Maybe T.Text) -- ^ Initial values for (src, dst)
   -> Html (Html (), Html ())
-mkTypeaheadInputs initialSuggestions mSrcDst = do
+mkTypeaheadInputs initialSuggestions (mSrc, mDst) = do
   script_ $ "function " <> jsTriggerFunctionName <> "(event) { return event instanceof KeyboardEvent }"
   pure
-    ( mkInput' "src" (fst <$> mSrcDst)
-    , mkInput' "dst" (snd <$> mSrcDst)
+    ( mkInput' "src" mSrc
+    , mkInput' "dst" mDst
     )
   where
     mkInput' = mkInput jsTriggerFunctionName attrs initialSuggestions
@@ -122,22 +122,24 @@ mkInput
   -> [Attribute] -- ^ Attributes
   -> Html () -- ^ Initial suggestions
   -> T.Text -- ^ input ID
-  -> Maybe FunGraph.FullyQualifiedType -- ^ initial value (optional)
+  -> Maybe T.Text -- ^ initial value (optional)
   -> Html ()
 mkInput jsTriggerFunctionName attrs initialSuggestions id' mInitialValue = do
   suggestions
   input_ $ attrs ++
     [ name_ id'
     , id_ id'
     , type_ "search"
-    , value_ $ maybe mempty Server.Pages.Typeahead.renderSearchValue mInitialValue
+    , value_ $ fromMaybe mempty mInitialValue
     , list_ suggestionsId
     , hxGet_ "/typeahead" -- get suggestions from here (TODO: use something type-safe)
     , hxTarget_ $ "#" <> suggestionsId -- put suggestions here
     , hxTrigger_ $ "keyup[" <> jsTriggerFunctionName <> ".call(this, event)] changed delay:25ms"
     , hxPushUrl_ "false"
     , autocomplete_ "off"
     , spellcheck_ "off"
+    , required_ ""
+    , autofocus_
     ]
   where
     suggestionsId = "list_" <> id'