Add full path to the zettel in neuron query JSON

Resolves #107

CHANGELOG.md

@@ -11,6 +11,7 @@
   - Custom themes for web interface
   - Custom alias redirects
   - #90: Client-side web search
+  - #107: Add full path to the zettel in `neuron query` JSON
 - CLI revamp
   - Zettelkasten directory is now provided via the `-d` argument.
     - Its default, `~/zettelkasten`, is used when not specified.

src/Neuron/CLI.hs

@@ -9,14 +9,17 @@ module Neuron.CLI
   )
 where
 
+import Data.Aeson
 import qualified Data.Aeson.Text as Aeson
 import Development.Shake (Action)
 import Neuron.CLI.New (newZettelFile)
 import Neuron.CLI.Rib
 import Neuron.CLI.Search (runSearch)
 import qualified Neuron.Version as Version
+import Neuron.Zettelkasten.ID (zettelIDSourceFileName)
 import qualified Neuron.Zettelkasten.Query as Z
 import qualified Neuron.Zettelkasten.Store as Z
+import Neuron.Zettelkasten.Zettel (Zettel (..), zettelJson)
 import Options.Applicative
 import Relude
 import qualified Rib
@@ -53,10 +56,15 @@ runWith act App {..} = do
         putStrLn indexHtmlPath
         let opener = if os == "darwin" then "open" else "xdg-open"
         liftIO $ executeFile opener True [indexHtmlPath] Nothing
-    Query queries -> do
+    Query queries ->
       runRibOnceQuietly notesDir $ do
         store <- Z.mkZettelStore =<< Rib.forEvery ["*.md"] pure
-        let matches = Z.runQuery store queries
-        putLTextLn $ Aeson.encodeToLazyText matches
+        putLTextLn $ Aeson.encodeToLazyText $ zettelJsonWith <$> Z.runQuery store queries
     Search searchCmd ->
       runSearch notesDir searchCmd
+  where
+    zettelJsonWith z@Zettel {..} =
+      object $
+        [ "path" .= (notesDir </> zettelIDSourceFileName zettelID)
+        ]
+          <> zettelJson z

src/Neuron/Web/View.hs

@@ -147,7 +147,7 @@ renderSearch store = do
   div_ [class_ "ui hidden divider"] mempty
   let allZettels = runQuery store []
       allTags = Set.fromList $ concatMap zettelTags allZettels
-      index = object ["zettels" .= allZettels, "tags" .= allTags]
+      index = object ["zettels" .= fmap (object . zettelJson) allZettels, "tags" .= allTags]
   div_ [class_ "ui fluid multiple search selection dropdown", id_ "search-tags"] $ do
     with (input_ mempty) [name_ "tags", type_ "hidden"]
     with (i_ mempty) [class_ "dropdown icon"]

src/Neuron/Zettelkasten/Zettel.hs

@@ -32,14 +32,12 @@ instance Ord Zettel where
 instance Show Zettel where
   show Zettel {..} = "Zettel:" <> show zettelID
 
--- TODO: Use generic deriving use field label modifier.
-instance ToJSON Zettel where
-  toJSON Zettel {..} =
-    object
-      [ "id" .= toJSON zettelID,
-        "title" .= zettelTitle,
-        "tags" .= zettelTags
-      ]
+zettelJson :: KeyValue a => Zettel -> [a]
+zettelJson Zettel {..} =
+  [ "id" .= toJSON zettelID,
+    "title" .= zettelTitle,
+    "tags" .= zettelTags
+  ]
 
 -- | Load a zettel from a file.
 mkZettelFromPath :: FilePath -> Action Zettel

test/Neuron/Zettelkasten/ZettelSpec.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Neuron.Zettelkasten.ZettelSpec
@@ -23,4 +23,10 @@ spec = do
         dummyContent = either error id $ parsePure "<spec>" "Dummy"
         zettel = Zettel zid "Some title" ["science"] dummyContent
     it "Produces expected json" $ do
-      encode zettel `shouldBe` "{\"id\":\"2011401\",\"title\":\"Some title\",\"tags\":[\"science\"]}"
+      -- "{\"id\":\"2011401\",\"title\":\"Some title\",\"tags\":[\"science\"]}"
+      object (zettelJson zettel)
+        `shouldBe` object
+          [ "id" .= ("2011401" :: Text),
+            "title" .= ("Some title" :: Text),
+            "tags" .= ["science" :: Text]
+          ]