Change Tag internal representation to FilePath

felko · Apr 19, 2020 · 8cc0f64 · 8cc0f64
1 parent 13eb406
commit 8cc0f64
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 8 deletions.
diff --git a/src/Neuron/Web/View.hs b/src/Neuron/Web/View.hs
@@ -41,7 +41,7 @@ import Neuron.Zettelkasten.Link.View (neuronLinkExt, renderZettelLink)
 import Neuron.Zettelkasten.Markdown (neuronMMarkExts)
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Store
-import Neuron.Zettelkasten.Tag (Tag (..))
+import Neuron.Zettelkasten.Tag
 import Neuron.Zettelkasten.Zettel
 import Relude
 import qualified Rib
@@ -189,16 +189,16 @@ renderBrandFooter withVersion =
 
 renderTags :: Monad m => [Tag] -> HtmlT m ()
 renderTags tags = do
-  forM_ tags $ \tag -> do
+  forM_ tags $ \(tagToText -> tag) -> do
     -- TODO: Ideally this should be at the top, not bottom. But putting it at
     -- the top pushes the zettel content down, introducing unnecessary white
     -- space below the title. So we put it at the bottom for now.
     span_ [class_ "ui black right ribbon label", title_ "Tag"] $ do
       a_
-        [ href_ $ routeUrlRelWithQuery Route_Search [queryKey|tag|] (unTag tag),
-          title_ ("See all zettels tagged '" <> unTag tag <> "'")
+        [ href_ $ routeUrlRelWithQuery Route_Search [queryKey|tag|] tag,
+          title_ ("See all zettels tagged '" <> tag <> "'")
         ]
-        $ toHtml (unTag tag)
+        $ toHtml tag
     p_ mempty
 
 -- | Font awesome element

diff --git a/src/Neuron/Zettelkasten/Link/View.hs b/src/Neuron/Zettelkasten/Link/View.hs
@@ -26,7 +26,7 @@ import Neuron.Zettelkasten.Link.Theme (LinkTheme (..))
 import Neuron.Zettelkasten.Markdown (MarkdownLink (..))
 import Neuron.Zettelkasten.Query
 import Neuron.Zettelkasten.Store
-import Neuron.Zettelkasten.Tag (Tag (unTag))
+import Neuron.Zettelkasten.Tag (tagToText)
 import Neuron.Zettelkasten.Zettel
 import Relude
 import qualified Rib
@@ -68,7 +68,7 @@ renderNeuronLink store = \case
     toHtml $ Some q
     let tags = runQuery store q
     ul_ $ do
-      forM_ tags $ \(unTag -> tag) -> do
+      forM_ tags $ \(tagToText -> tag) -> do
         let tagUrl = routeUrlRelWithQuery Route_Search [queryKey|tag|] tag
         li_ $ a_ [href_ tagUrl] $ toHtml tag
 

diff --git a/src/Neuron/Zettelkasten/Tag.hs b/src/Neuron/Zettelkasten/Tag.hs
@@ -5,6 +5,8 @@
 
 module Neuron.Zettelkasten.Tag
   ( Tag (..),
+    mkTag,
+    tagToText,
     TagPattern (unTagPattern),
     mkTagPattern,
     tagMatch,
@@ -15,9 +17,15 @@ import Data.Aeson
 import Relude
 import System.FilePattern
 
-newtype Tag = Tag {unTag :: Text}
+newtype Tag = Tag {unTag :: FilePath}
   deriving (Eq, Ord, Show, ToJSON, FromJSON)
 
+mkTag :: Text -> Tag
+mkTag = Tag . toString
+
+tagToText :: Tag -> Text
+tagToText = toText . unTag
+
 newtype TagPattern = TagPattern {unTagPattern :: FilePattern}
   deriving (Eq, Show)