Add folgezettel queries (#476)

docs/guide/query.md

@@ -50,6 +50,23 @@ tag:foo/*/qux
 ```
 ~~~
 
+### List folgezettel children of current note
+
+~~~markdown
+```query
+children:.
+```
+~~~~
+
+
+### List folgezettel parents of current note
+
+~~~markdown
+```query
+parents:.
+```
+~~~
+
 ## Timeline queries
 
 Queries can be rendered as a timeline by using the `timeline` code block attribute.

docs/start/resources.md

@@ -7,5 +7,5 @@ order: 15
 Applications and resources relevant to Emanote.
 
 ```query
-path:./*
+children:.
 ```

docs/tips/sync.md

@@ -15,3 +15,5 @@ Git also acts as backup if you push your repository to a remote location (GitHub
 [^sup]: "superior" ... because when using Dropbox, Android phones (unlike desktop computers) cannot have automatic full-sync of files on disk.
 
 [^ios]: Obsidian can also synchronize notes between iOS and macOS [via iCloud](https://help.obsidian.md/Getting+started/Sync+your+notes+across+devices).
+
+#[[resources]]

emanote/CHANGELOG.md

@@ -5,6 +5,7 @@
 - Features
   - Obsidian-style callouts ([\#466](https://github.com/srid/emanote/pull/466))
   - `emanote run --no-ws` option to disable WebSocket monitoring. This is useful for using Emanote to serve the HTML site directly on the internet, without needing to statically generate it.
+  - Add query syntax for listing folgezetten children & parents ([\#476](https://github.com/srid/emanote/pull/476))
 
 ## 1.2.0.0 (2023-08-24)
 

emanote/emanote.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               emanote
-version:            1.2.1.5
+version:            1.2.2.0
 license:            AGPL-3.0-only
 copyright:          2022 Sridhar Ratnakumar
 maintainer:         [email protected]

emanote/src/Emanote/Model/Graph.hs

@@ -11,30 +11,28 @@ import Emanote.Model.Link.Rel qualified as Rel
 import Emanote.Model.Link.Resolve qualified as Resolve
 import Emanote.Model.Meta (lookupRouteMeta)
 import Emanote.Model.Note qualified as MN
-import Emanote.Model.Type (Model, modelRels, parentLmlRoute)
+import Emanote.Model.Type (Model, modelNotes, modelRels, parentLmlRoute)
 import Emanote.Route qualified as R
-import Emanote.Route.ModelRoute (ModelRoute)
 import Optics.Operators as Lens ((^.))
 import Relude hiding (empty)
 import Text.Pandoc.Definition qualified as B
 
 -- TODO: Do breadth-first instead of depth-first
-modelFolgezettelAncestorTree :: Model -> ModelRoute -> Forest R.LMLRoute
+modelFolgezettelAncestorTree :: Model -> R.LMLRoute -> Forest R.LMLRoute
 modelFolgezettelAncestorTree model =
   fst . usingState mempty . go
   where
-    go :: (MonadState (Set ModelRoute) m) => ModelRoute -> m (Forest R.LMLRoute)
+    go :: (MonadState (Set R.LMLRoute) m) => R.LMLRoute -> m (Forest R.LMLRoute)
     go r =
       fmap catMaybes . forM (folgezettelParentsFor model r) $ \parentR -> do
-        let parentModelR = R.ModelRoute_LML R.LMLView_Html parentR
-        gets (parentModelR `Set.member`) >>= \case
+        gets (parentR `Set.member`) >>= \case
           True -> pure Nothing -- already visited
           False -> do
-            modify $ Set.insert parentModelR
-            sub <- go parentModelR
+            modify $ Set.insert parentR
+            sub <- go parentR
             pure $ Just $ Node parentR sub
 
-folgezettelParentsFor :: Model -> ModelRoute -> [R.LMLRoute]
+folgezettelParentsFor :: Model -> R.LMLRoute -> [R.LMLRoute]
 folgezettelParentsFor model r = do
   let folgezettelBacklinks =
         backlinkRels r model
@@ -47,9 +45,8 @@ folgezettelParentsFor model r = do
       -- Folders are automatically made a folgezettel
       folgezettelFolder =
         maybeToList $ do
-          (_, lmlR) <- leftToMaybe (R.modelRouteCase r)
-          guard $ lookupRouteMeta True ("emanote" :| ["folder-folgezettel"]) lmlR model
-          parentLmlRoute model lmlR
+          guard $ folderFolgezettelEnabledFor model r
+          parentLmlRoute model r
       folgezettelParents =
         mconcat
           [ folgezettelBacklinks
@@ -68,6 +65,44 @@ folgezettelParentsFor model r = do
       Rel.URTWikiLink (WL.WikiLinkTag, wl) -> Just wl
       _ -> Nothing
 
+folgezettelChildrenFor :: Model -> R.LMLRoute -> [R.LMLRoute]
+folgezettelChildrenFor model r = do
+  let folgezettelBacklinks =
+        backlinkRels r model
+          & filter (isReverseFolgezettel . (^. Rel.relTo))
+          <&> (^. Rel.relFrom)
+      folgezettelFrontlinks =
+        frontlinkRels r model
+          & mapMaybe (lookupNoteByWikiLink model <=< selectFolgezettel . (^. Rel.relTo))
+      -- Folders are automatically made a folgezettel
+      folgezettelFolderChildren :: [R.LMLRoute] =
+        maybeToMonoid $ do
+          let folderR :: R.R 'R.Folder = R.withLmlRoute coerce r
+              notes = Ix.toList $ (model ^. modelNotes) @= folderR
+              rs = filter (folderFolgezettelEnabledFor model) $ notes <&> (^. MN.noteRoute)
+          pure rs
+      folgezettelChildren =
+        mconcat
+          [ folgezettelBacklinks
+          , folgezettelFrontlinks
+          , folgezettelFolderChildren
+          ]
+   in folgezettelChildren
+  where
+    isReverseFolgezettel = \case
+      Rel.URTWikiLink (WL.WikiLinkTag, _wl) ->
+        True
+      _ ->
+        False
+    selectFolgezettel :: Rel.UnresolvedRelTarget -> Maybe WL.WikiLink
+    selectFolgezettel = \case
+      Rel.URTWikiLink (WL.WikiLinkBranch, wl) -> Just wl
+      _ -> Nothing
+
+folderFolgezettelEnabledFor :: Model -> R.LMLRoute -> Bool
+folderFolgezettelEnabledFor model r =
+  lookupRouteMeta True ("emanote" :| ["folder-folgezettel"]) r model
+
 lookupNoteByWikiLink :: Model -> WL.WikiLink -> Maybe R.LMLRoute
 lookupNoteByWikiLink model wl = do
   (_, note) <- leftToMaybe <=< getFound $ Resolve.resolveWikiLinkMustExist model wl
@@ -78,7 +113,7 @@ lookupNoteByWikiLink model wl = do
       Rel.RRTFound x -> Just x
       _ -> Nothing
 
-modelLookupBacklinks :: ModelRoute -> Model -> [(R.LMLRoute, NonEmpty [B.Block])]
+modelLookupBacklinks :: R.LMLRoute -> Model -> [(R.LMLRoute, NonEmpty [B.Block])]
 modelLookupBacklinks r model =
   sortOn (Calendar.backlinkSortKey model . fst) $
     groupNE $
@@ -96,14 +131,15 @@ modelLookupBacklinks r model =
             Just ys -> Map.insert x (ys <> one y) m
 
 -- | Rels pointing *to* this route
-backlinkRels :: ModelRoute -> Model -> [Rel.Rel]
+backlinkRels :: R.LMLRoute -> Model -> [Rel.Rel]
 backlinkRels r model =
-  let allPossibleLinks = Rel.unresolvedRelsTo r
+  let allPossibleLinks = Rel.unresolvedRelsTo $ toModelRoute r
    in Ix.toList $ (model ^. modelRels) @+ allPossibleLinks
+  where
+    toModelRoute = R.ModelRoute_LML R.LMLView_Html
 
 -- | Rels pointing *from* this route
-frontlinkRels :: ModelRoute -> Model -> [Rel.Rel]
+frontlinkRels :: R.LMLRoute -> Model -> [Rel.Rel]
 frontlinkRels r model =
   maybeToMonoid $ do
-    (_, lmlR) <- leftToMaybe $ R.modelRouteCase r
-    pure $ Ix.toList $ (model ^. modelRels) @= lmlR
+    pure $ Ix.toList $ (model ^. modelRels) @= r

emanote/src/Emanote/Model/Query.hs

@@ -4,6 +4,7 @@ import Data.IxSet.Typed ((@+), (@=))
 import Data.IxSet.Typed qualified as Ix
 import Data.Text qualified as T
 import Emanote.Model.Calendar qualified as Calendar
+import Emanote.Model.Graph qualified as G
 import Emanote.Model.Note (Note)
 import Emanote.Model.Note qualified as N
 import Emanote.Model.Type (Model, modelNotes, modelTags)
@@ -22,6 +23,8 @@ data Query
   | QueryByTagPattern TagPattern
   | QueryByPath FilePath
   | QueryByPathPattern FilePattern
+  | QueryFolgezettelChildren
+  | QueryFolgezettelParents
   deriving stock (Eq)
 
 instance Show.Show Query where
@@ -34,6 +37,10 @@ instance Show.Show Query where
       "Pages under path '/" <> p <> "'"
     QueryByPathPattern pat ->
       "Pages matching path '" <> pat <> "'"
+    QueryFolgezettelChildren ->
+      "Folgezettel children"
+    QueryFolgezettelParents ->
+      "Folgezettel parents"
 
 parseQuery :: Text -> Maybe Query
 parseQuery = do
@@ -49,6 +56,8 @@ queryParser = do
   (M.string "tag:#" *> fmap (QueryByTag . HT.Tag . T.strip) M.takeRest)
     <|> (M.string "tag:" *> fmap (QueryByTagPattern . HT.mkTagPattern . T.strip) M.takeRest)
     <|> (M.string "path:" *> fmap (fromUserPath . T.strip) M.takeRest)
+    <|> (M.string "children:." $> QueryFolgezettelChildren)
+    <|> (M.string "parents:." $> QueryFolgezettelParents)
   where
     fromUserPath s =
       if
@@ -77,9 +86,15 @@ runQuery currentRoute model =
        in flip mapMaybe notes $ \note -> do
             guard $ pat ?== R.withLmlRoute R.encodeRoute (note ^. N.noteRoute)
             pure note
+    QueryFolgezettelChildren ->
+      let rs = G.folgezettelChildrenFor model currentRoute
+       in Ix.toList $ (model ^. modelNotes) @+ rs
+    QueryFolgezettelParents ->
+      let rs = G.folgezettelParentsFor model currentRoute
+       in Ix.toList $ (model ^. modelNotes) @+ rs
   where
-    -- Resolve the ./ prefix which will for substituting "$PWD" in current
-    -- note's route context.
+    -- Resolve the ./ prefix substituting it with "$PWD" in current note's route
+    -- context.
     resolveDotInFilePattern (toText -> pat) =
       if "./" `T.isPrefixOf` pat
         then

emanote/src/Emanote/View/Template.hs

@@ -161,7 +161,6 @@ renderLmlHtml model note = do
     -- Note stuff
     "ema:note:title" ##
       C.titleSplice ctx (note ^. MN.noteTitle)
-    let modelRoute = R.ModelRoute_LML R.LMLView_Html r
     "ema:note:source-path" ##
       HI.textSplice (toText . R.withLmlRoute R.encodeRoute $ r)
     "ema:note:url" ##
@@ -173,13 +172,13 @@ renderLmlHtml model note = do
         then feedDiscoveryLink model note
         else mempty
     "ema:note:backlinks" ##
-      backlinksSplice (G.modelLookupBacklinks modelRoute model)
-    let (backlinksDaily, backlinksNoDaily) = partition (Calendar.isDailyNote . fst) $ G.modelLookupBacklinks modelRoute model
+      backlinksSplice (G.modelLookupBacklinks r model)
+    let (backlinksDaily, backlinksNoDaily) = partition (Calendar.isDailyNote . fst) $ G.modelLookupBacklinks r model
     "ema:note:backlinks:daily" ##
       backlinksSplice backlinksDaily
     "ema:note:backlinks:nodaily" ##
       backlinksSplice backlinksNoDaily
-    let folgeAnc = G.modelFolgezettelAncestorTree model modelRoute
+    let folgeAnc = G.modelFolgezettelAncestorTree model r
     "ema:note:uptree" ##
       Splices.treeSplice (\_ _ -> ()) folgeAnc $
         \(last -> nodeRoute) children -> do