refactor and tests

srid · Feb 10, 2024 · cf35764 · cf35764
1 parent 66b5eed
commit cf35764
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 3 deletions.
diff --git a/emanote/src/Emanote/Route/R.hs b/emanote/src/Emanote/Route/R.hs
@@ -31,6 +31,10 @@ instance (HasExt ext) => Show (R ext) where
 mkRouteFromFilePath :: forall a (ext :: FileType a). (HasExt ext) => FilePath -> Maybe (R ext)
 mkRouteFromFilePath = mkRouteFromFilePath' False
 
+{- | Like `mkRouteFromFilePath` but drops the last slug if it's "index"
+
+Behaves like `mkRouteFromFilePath` for top-level files.
+-}
 mkRouteFromFilePath' :: forall a (ext :: FileType a). (HasExt ext) => Bool -> FilePath -> Maybe (R ext)
 mkRouteFromFilePath' dropIndex fp = do
   base <- withoutKnownExt @_ @ext fp

diff --git a/emanote/src/Emanote/View/Template.hs b/emanote/src/Emanote/View/Template.hs
@@ -148,6 +148,8 @@ renderLmlHtml :: Model -> MN.Note -> LByteString
 renderLmlHtml model note = do
   let r = note ^. MN.noteRoute
       meta = patchMeta $ Meta.getEffectiveRouteMetaWith (note ^. MN.noteMeta) r model
+      sourcePath = fromMaybe (R.withLmlRoute R.encodeRoute r) $ do
+        fmap snd $ note ^. MN.noteSource
       -- Force a doctype into the generated HTML as a workaround for Heist
       -- discarding it. See: https://github.com/srid/emanote/issues/216
       withDoctype = ("<!DOCTYPE html>\n" <>)
@@ -169,9 +171,8 @@ renderLmlHtml model note = do
     "ema:note:title" ##
       C.titleSplice ctx (note ^. MN.noteTitle)
     "ema:note:source-path" ##
-      HI.textSplice $ fromMaybe (toText $ R.withLmlRoute R.encodeRoute r) $ do
-        (_, fp) <- note ^. MN.noteSource
-        pure $ toText fp
+      HI.textSplice
+        $ toText sourcePath
     "ema:note:url" ##
       HI.textSplice (SR.siteRouteUrl model . SR.lmlSiteRoute $ (R.LMLView_Html, r))
     "emaNoteFeedUrl" ##

diff --git a/emanote/test/Emanote/Route/RSpec.hs b/emanote/test/Emanote/Route/RSpec.hs
@@ -25,6 +25,15 @@ mkRouteFromFilePathSpec = describe "mkRouteFromFilePath" $ do
       mkRouteFromFilePath "foo/bar.md" === Just r2
     it "three slugs" . hedgehog $ do
       mkRouteFromFilePath "foo/bar/qux.md" === Just r3
+  describe "dropIndex" $ do
+    it "index route" . hedgehog $ do
+      mkRouteFromFilePath' True "index.md" === Just rIndex
+    it "single slug" . hedgehog $ do
+      mkRouteFromFilePath' True "foo.md" === Just r1
+    it "two slugs" . hedgehog $ do
+      mkRouteFromFilePath' True "foo/index.md" === Just r1
+    it "three slugs" . hedgehog $ do
+      mkRouteFromFilePath' True "foo/bar/index.md" === Just r2
 
 routeInitsSpec :: Spec
 routeInitsSpec = describe "routeInits" $ do