From 9ebfe92b93a69c4ad19a9309dfe2b307ebc31798 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 19:15:01 -0400 Subject: [PATCH 1/9] WIP but working prototype --- neuron/src/app/Neuron/Config/Alias.hs | 8 ++-- neuron/src/app/Neuron/Reader/Org.hs | 2 +- neuron/src/app/Neuron/Web/Generate/Route.hs | 2 +- neuron/src/app/Neuron/Web/View.hs | 4 +- .../src/app/Neuron/Zettelkasten/ID/Scheme.hs | 2 +- neuron/src/lib/Neuron/Reader/Markdown.hs | 23 ++++++----- neuron/src/lib/Neuron/Web/Query/View.hs | 4 +- neuron/src/lib/Neuron/Web/ZIndex.hs | 2 +- neuron/src/lib/Neuron/Zettelkasten/ID.hs | 41 +++++++++++-------- .../lib/Neuron/Zettelkasten/Query/Error.hs | 2 +- 10 files changed, 51 insertions(+), 39 deletions(-) diff --git a/neuron/src/app/Neuron/Config/Alias.hs b/neuron/src/app/Neuron/Config/Alias.hs index 49dfd6f24..57bffa2e4 100644 --- a/neuron/src/app/Neuron/Config/Alias.hs +++ b/neuron/src/app/Neuron/Config/Alias.hs @@ -32,7 +32,7 @@ getAliases Config {..} graph = do pure v where hasIndexZettel = - isJust . G.getZettel (ZettelID "index") + isJust . G.getZettel (mkZettelID "index") mkAliases :: [Text] -> ZettelGraph -> Either Text [Alias] mkAliases aliasSpecs graph = @@ -41,10 +41,10 @@ mkAliases aliasSpecs graph = alias@Alias {..} <- liftEither $ parse aliasParser configFile aliasSpec when (isJust $ G.getZettel aliasZettel graph) $ do throwError $ - "Cannot create redirect from '" <> unZettelID aliasZettel <> "', because a zettel with that ID already exists" - when (unZettelID targetZettel /= "z-index" && isNothing (G.getZettel targetZettel graph)) $ do + "Cannot create redirect from '" <> show aliasZettel <> "', because a zettel with that ID already exists" + when (zettelIDID targetZettel /= "z-index" && isNothing (G.getZettel targetZettel graph)) $ do throwError $ - "Target zettel '" <> unZettelID targetZettel <> "' does not exist" + "Target zettel '" <> show targetZettel <> "' does not exist" pure alias aliasParser :: Parser Alias diff --git a/neuron/src/app/Neuron/Reader/Org.hs b/neuron/src/app/Neuron/Reader/Org.hs index 24e495ac5..9f0f81073 100644 --- a/neuron/src/app/Neuron/Reader/Org.hs +++ b/neuron/src/app/Neuron/Reader/Org.hs @@ -22,7 +22,7 @@ import Neuron.Zettelkasten.Zettel.Meta (Meta (..)) import Relude import Relude.Extra.Map (lookup) import Text.Pandoc (def, runPure) -import Text.Pandoc.Definition hiding (Meta (..)) +import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Readers.Org (readOrg) import Text.Pandoc.Util (getH1) diff --git a/neuron/src/app/Neuron/Web/Generate/Route.hs b/neuron/src/app/Neuron/Web/Generate/Route.hs index 7d9b45696..73e512d60 100644 --- a/neuron/src/app/Neuron/Web/Generate/Route.hs +++ b/neuron/src/app/Neuron/Web/Generate/Route.hs @@ -31,7 +31,7 @@ instance IsRoute Route where pure "z-index.html" Route_Search _mtag -> pure "search.html" - Route_Zettel (unZettelID -> s) -> + Route_Zettel (zettelIDID -> s) -> pure $ toString s <> ".html" staticRouteConfig :: RouteConfig t m diff --git a/neuron/src/app/Neuron/Web/View.hs b/neuron/src/app/Neuron/Web/View.hs index 75c094bd9..4fb285338 100644 --- a/neuron/src/app/Neuron/Web/View.hs +++ b/neuron/src/app/Neuron/Web/View.hs @@ -41,7 +41,7 @@ import qualified Neuron.Web.Zettel.CSS as ZettelCSS import qualified Neuron.Web.Zettel.View as ZettelView import Neuron.Zettelkasten.Graph (ZettelGraph) import qualified Neuron.Zettelkasten.Graph as G -import Neuron.Zettelkasten.ID (ZettelID (..)) +import Neuron.Zettelkasten.ID (mkZettelID) import Neuron.Zettelkasten.Zettel import Reflex.Dom.Core hiding ((&)) import Reflex.Dom.Pandoc (PandocBuilder) @@ -102,7 +102,7 @@ renderRouteBody :: PandocBuilder t m => Text -> Config -> Route a -> (ZettelGrap renderRouteBody neuronVersion Config {..} r (g, x) = do let neuronTheme = Theme.mkTheme theme themeSelector = toText $ Theme.themeIdentifier neuronTheme - indexZettel = G.getZettel (ZettelID "index") g + indexZettel = G.getZettel (mkZettelID "index") g elAttr "div" ("class" =: "ui fluid container" <> "id" =: themeSelector) $ do case r of Route_ZIndex -> do diff --git a/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs b/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs index 378893d2a..d467c8087 100644 --- a/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs +++ b/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs @@ -74,7 +74,7 @@ nextAvailableZettelID :: nextAvailableZettelID zs val = \case IDSchemeHash -> do let s = T.take 8 $ UUID.toText val - if s `Set.member` (unZettelID `Set.map` zs) + if s `Set.member` (zettelIDID `Set.map` zs) then throwError $ IDConflict_HashConflict s else either (error . toText) pure $ diff --git a/neuron/src/lib/Neuron/Reader/Markdown.hs b/neuron/src/lib/Neuron/Reader/Markdown.hs index d140d0e72..a0b676bed 100644 --- a/neuron/src/lib/Neuron/Reader/Markdown.hs +++ b/neuron/src/lib/Neuron/Reader/Markdown.hs @@ -19,7 +19,6 @@ import Commonmark.TokParsers (noneOfToks, symbol) import Commonmark.Tokens (TokType (..)) import Control.Monad.Combinators (manyTill) import Data.Tagged (Tagged (..)) -import qualified Data.Text as T import qualified Data.YAML as YAML import Neuron.Orphans () import Neuron.Reader.Type (ZettelParseError, ZettelReader) @@ -32,6 +31,7 @@ import qualified Text.Pandoc.Builder as B import Text.Pandoc.Definition (Pandoc (..)) import qualified Text.Parsec as P import Text.Show (Show (show)) +import Text.URI -- | Parse Markdown document, along with the YAML metadata block in it. -- @@ -182,28 +182,31 @@ wikiLinkSpec = [ -- Folgezettel link: [[[...]]] P.try (CM.untokenize <$> wikiLinkP 3), -- Cf link: [[...]] - addCfToURI . CM.untokenize <$> wikiLinkP 2 + render . mkIdURI (Just "cf") . CM.untokenize <$> wikiLinkP 2 ] let title = "" pure $! CM.link url title $ CM.str url - -- Add "cf" flag to the URI, without parsing and re-rendering it. - addCfToURI :: Text -> Text - addCfToURI s = - -- This is kind of a HACK, but it works. - if isJust (T.find (== '?') s) - then s <> "&cf" - else s <> "?cf" wikiLinkP :: Monad m => Int -> P.ParsecT [CM.Tok] s m [CM.Tok] wikiLinkP n = do void $ M.count n $ symbol '[' x <- idP void $ M.count n $ symbol ']' pure x + mkIdURI :: Maybe Text -> Text -> URI + mkIdURI queryFlag s = do + let qk = either (error . toText . show) id . mkQueryKey <$> maybeToList queryFlag + case toString s of + ('z' : ':' : _) -> + either (error . toText . show) id $ mkURI s + _ -> do + let path = either (error . toText . show) id $ mkPathPiece s + scheme = either (error . toText . show) id $ mkScheme "z" + URI (Just scheme) (Left True) (Just (False, path :| [])) (QueryFlag <$> qk) Nothing -- TODO: Unify this with the megaparsec parser from ID.hs idP :: Monad m => P.ParsecT [CM.Tok] s m [CM.Tok] idP = - some (noneOfToks [Symbol ']', Spaces, UnicodeSpace, LineEnd]) + some (noneOfToks [Symbol ']', LineEnd]) inlineTagP :: Monad m => P.ParsecT [CM.Tok] s m [CM.Tok] inlineTagP = diff --git a/neuron/src/lib/Neuron/Web/Query/View.hs b/neuron/src/lib/Neuron/Web/Query/View.hs index f5cd35d1d..e381fada1 100644 --- a/neuron/src/lib/Neuron/Web/Query/View.hs +++ b/neuron/src/lib/Neuron/Web/Query/View.hs @@ -121,7 +121,7 @@ renderZettelLink mInner conn (fromMaybe def -> linkView) Zettel {..} = do LinkView_ShowDate -> elTime <$> zettelDate LinkView_ShowID -> - Just $ el "tt" $ text $ unZettelID zettelID + Just $ el "tt" $ text $ zettelIDRaw zettelID classes :: [Text] = catMaybes $ [Just "zettel-link-container"] <> [connClass, rawClass] elClass "span" (T.intercalate " " classes) $ do forM_ mextra $ \extra -> @@ -165,7 +165,7 @@ renderZettelLinkIDOnly :: DomBuilder t m => ZettelID -> NeuronWebT t m () renderZettelLinkIDOnly zid = elClass "span" "zettel-link-container" $ do elClass "span" "zettel-link" $ do - neuronRouteLink (Some $ Route_Zettel zid) mempty $ text $ unZettelID zid + neuronRouteLink (Some $ Route_Zettel zid) mempty $ text $ zettelIDRaw zid renderTagTree :: forall t m. DomBuilder t m => Forest (NonEmpty TagNode, Natural) -> NeuronWebT t m () renderTagTree t = diff --git a/neuron/src/lib/Neuron/Web/ZIndex.hs b/neuron/src/lib/Neuron/Web/ZIndex.hs index b2f2b4e25..d92a4583a 100644 --- a/neuron/src/lib/Neuron/Web/ZIndex.hs +++ b/neuron/src/lib/Neuron/Web/ZIndex.hs @@ -137,7 +137,7 @@ renderErrors errors = do ZettelError_AmbiguousFiles _ -> do text $ "More than one file define the same zettel ID (" - <> unZettelID zid + <> show zid <> "):" forM_ (Map.toList errors) $ \(zid, zError) -> divClass ("ui tiny message " <> severity zError) $ do diff --git a/neuron/src/lib/Neuron/Zettelkasten/ID.hs b/neuron/src/lib/Neuron/Zettelkasten/ID.hs index 7748fd5a0..57b7b2e7b 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/ID.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/ID.hs @@ -10,6 +10,7 @@ module Neuron.Zettelkasten.ID ( ZettelID (..), InvalidID (..), + mkZettelID, parseZettelID, idParser, getZettelID, @@ -19,6 +20,7 @@ where import Data.Aeson import Data.Aeson.Types (toJSONKeyText) +import qualified Data.Text as T import Neuron.Reader.Type (ZettelFormat, zettelFormatToExtension) import Relude import System.FilePath @@ -27,22 +29,26 @@ import qualified Text.Megaparsec.Char as M import Text.Megaparsec.Simple import qualified Text.Show -newtype ZettelID = ZettelID {unZettelID :: Text} - deriving (Eq, Show, Ord, Generic) +data ZettelID = ZettelID + { zettelIDID :: Text, + zettelIDRaw :: Text + } + deriving (Show, Ord, Generic, ToJSON, FromJSON) + +mkZettelID :: Text -> ZettelID +mkZettelID s = + let slug = T.intercalate "_" $ T.splitOn " " s + in ZettelID slug s + +instance Eq ZettelID where + (==) (ZettelID a _) (ZettelID b _) = a == b instance Show InvalidID where show (InvalidIDParseError s) = "Invalid Zettel ID: " <> toString s -instance FromJSON ZettelID where - parseJSON x = do - s <- parseJSON x - case parseZettelID s of - Left e -> fail $ show e - Right zid -> pure zid - instance ToJSONKey ZettelID where - toJSONKey = toJSONKeyText unZettelID + toJSONKey = toJSONKeyText zettelIDID instance FromJSONKey ZettelID where fromJSONKey = FromJSONKeyTextParser $ \s -> @@ -50,11 +56,8 @@ instance FromJSONKey ZettelID where Right v -> pure v Left e -> fail $ show e -instance ToJSON ZettelID where - toJSON = toJSON . unZettelID - zettelIDSourceFileName :: ZettelID -> ZettelFormat -> FilePath -zettelIDSourceFileName zid fmt = toString $ unZettelID zid <> zettelFormatToExtension fmt +zettelIDSourceFileName zid fmt = toString $ zettelIDRaw zid <> zettelFormatToExtension fmt --------- -- Parser @@ -69,8 +72,14 @@ parseZettelID = idParser :: Parser ZettelID idParser = do - s <- M.some $ M.alphaNumChar <|> M.char '_' <|> M.char '-' <|> M.char '.' - pure $ ZettelID (toText s) + s <- + M.some $ + M.alphaNumChar + <|> M.char '_' + <|> M.char '-' + <|> M.char '.' + <|> M.char ' ' + pure $ mkZettelID (toText s) -- | Parse the ZettelID if the given filepath is a zettel. getZettelID :: ZettelFormat -> FilePath -> Maybe ZettelID diff --git a/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs b/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs index 754d34243..caae61591 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs @@ -50,4 +50,4 @@ showQueryParseError qe = showQueryResultError :: QueryResultError -> Text showQueryResultError (QueryResultError_NoSuchZettel zid) = - "links to non-existant zettel: " <> unZettelID zid + "links to non-existant zettel: " <> show zid From 304c73d871bc8ce8bb37963773060e2ed0caa894 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 19:39:40 -0400 Subject: [PATCH 2/9] refactor md parsing --- neuron/neuron.cabal | 2 +- neuron/src/lib/Neuron/Reader/Markdown.hs | 53 ++++++++++++++---------- 2 files changed, 33 insertions(+), 22 deletions(-) diff --git a/neuron/neuron.cabal b/neuron/neuron.cabal index 8c9ffe528..0dba14d5d 100644 --- a/neuron/neuron.cabal +++ b/neuron/neuron.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: neuron -- This version must be in sync with what's in Default.dhall -version: 0.6.11.4 +version: 0.6.12.0 license: AGPL-3.0-only copyright: 2020 Sridhar Ratnakumar maintainer: srid@srid.ca diff --git a/neuron/src/lib/Neuron/Reader/Markdown.hs b/neuron/src/lib/Neuron/Reader/Markdown.hs index a0b676bed..b6cebcefe 100644 --- a/neuron/src/lib/Neuron/Reader/Markdown.hs +++ b/neuron/src/lib/Neuron/Reader/Markdown.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -32,6 +33,13 @@ import Text.Pandoc.Definition (Pandoc (..)) import qualified Text.Parsec as P import Text.Show (Show (show)) import Text.URI + ( QueryParam (QueryFlag), + URI (URI, uriQuery), + mkPathPiece, + mkURI, + render, + ) +import Text.URI.QQ (queryKey, scheme) -- | Parse Markdown document, along with the YAML metadata block in it. -- @@ -177,36 +185,39 @@ wikiLinkSpec = (Monad m, CM.IsInline il) => CM.InlineParser m il pLink = P.try $ do - url <- + fmap cmAutoLink $ P.choice [ -- Folgezettel link: [[[...]]] - P.try (CM.untokenize <$> wikiLinkP 3), + P.try (wikiLinkP 3), -- Cf link: [[...]] - render . mkIdURI (Just "cf") . CM.untokenize <$> wikiLinkP 2 + P.try (wikiLinkP 2) ] - let title = "" - pure $! CM.link url title $ CM.str url - wikiLinkP :: Monad m => Int -> P.ParsecT [CM.Tok] s m [CM.Tok] + wikiLinkP :: Monad m => Int -> P.ParsecT [CM.Tok] s m Text wikiLinkP n = do void $ M.count n $ symbol '[' - x <- idP - void $ M.count n $ symbol ']' - pure x - mkIdURI :: Maybe Text -> Text -> URI - mkIdURI queryFlag s = do - let qk = either (error . toText . show) id . mkQueryKey <$> maybeToList queryFlag + s <- fmap CM.untokenize $ some $ noneOfToks [Symbol ']', LineEnd] + -- Parse as URI, add cf flag, and then render back. If parse fails, we + -- just ignore this inline. + case parseNeuronUri s of + Just uri -> do + void $ M.count n $ symbol ']' + pure $ + render $ case n of + 2 -> + -- [[..]] adds "cf" flag in URI + uri {uriQuery = [QueryFlag [queryKey|cf|]]} + _ -> uri + Nothing -> + fail "Not a neuron URI; ignoring" + parseNeuronUri :: Text -> Maybe URI + parseNeuronUri s = case toString s of ('z' : ':' : _) -> - either (error . toText . show) id $ mkURI s + mkURI s _ -> do - let path = either (error . toText . show) id $ mkPathPiece s - scheme = either (error . toText . show) id $ mkScheme "z" - URI (Just scheme) (Left True) (Just (False, path :| [])) (QueryFlag <$> qk) Nothing - --- TODO: Unify this with the megaparsec parser from ID.hs -idP :: Monad m => P.ParsecT [CM.Tok] s m [CM.Tok] -idP = - some (noneOfToks [Symbol ']', LineEnd]) + -- Treat it as plain ID + path <- mkPathPiece s + pure $ URI (Just [scheme|z|]) (Left True) (Just (False, path :| [])) [] Nothing inlineTagP :: Monad m => P.ParsecT [CM.Tok] s m [CM.Tok] inlineTagP = From 30fd2b7585707c4da0f261a844a661871d03891e Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 19:43:06 -0400 Subject: [PATCH 3/9] rename --- neuron/src/app/Neuron/Config/Alias.hs | 2 +- neuron/src/app/Neuron/Web/Generate/Route.hs | 2 +- neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs | 2 +- neuron/src/lib/Neuron/Zettelkasten/ID.hs | 6 ++++-- 4 files changed, 7 insertions(+), 5 deletions(-) diff --git a/neuron/src/app/Neuron/Config/Alias.hs b/neuron/src/app/Neuron/Config/Alias.hs index 57bffa2e4..7735c327b 100644 --- a/neuron/src/app/Neuron/Config/Alias.hs +++ b/neuron/src/app/Neuron/Config/Alias.hs @@ -42,7 +42,7 @@ mkAliases aliasSpecs graph = when (isJust $ G.getZettel aliasZettel graph) $ do throwError $ "Cannot create redirect from '" <> show aliasZettel <> "', because a zettel with that ID already exists" - when (zettelIDID targetZettel /= "z-index" && isNothing (G.getZettel targetZettel graph)) $ do + when (zettelIDSlug targetZettel /= "z-index" && isNothing (G.getZettel targetZettel graph)) $ do throwError $ "Target zettel '" <> show targetZettel <> "' does not exist" pure alias diff --git a/neuron/src/app/Neuron/Web/Generate/Route.hs b/neuron/src/app/Neuron/Web/Generate/Route.hs index 73e512d60..34301f471 100644 --- a/neuron/src/app/Neuron/Web/Generate/Route.hs +++ b/neuron/src/app/Neuron/Web/Generate/Route.hs @@ -31,7 +31,7 @@ instance IsRoute Route where pure "z-index.html" Route_Search _mtag -> pure "search.html" - Route_Zettel (zettelIDID -> s) -> + Route_Zettel (zettelIDSlug -> s) -> pure $ toString s <> ".html" staticRouteConfig :: RouteConfig t m diff --git a/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs b/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs index d467c8087..79669ed5a 100644 --- a/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs +++ b/neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs @@ -74,7 +74,7 @@ nextAvailableZettelID :: nextAvailableZettelID zs val = \case IDSchemeHash -> do let s = T.take 8 $ UUID.toText val - if s `Set.member` (zettelIDID `Set.map` zs) + if s `Set.member` (zettelIDSlug `Set.map` zs) then throwError $ IDConflict_HashConflict s else either (error . toText) pure $ diff --git a/neuron/src/lib/Neuron/Zettelkasten/ID.hs b/neuron/src/lib/Neuron/Zettelkasten/ID.hs index 57b7b2e7b..743016b5b 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/ID.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/ID.hs @@ -30,7 +30,9 @@ import Text.Megaparsec.Simple import qualified Text.Show data ZettelID = ZettelID - { zettelIDID :: Text, + { -- | Slug must be unique + zettelIDSlug :: Text, + -- | Actual ID used by the user, inside `[[..]]` zettelIDRaw :: Text } deriving (Show, Ord, Generic, ToJSON, FromJSON) @@ -48,7 +50,7 @@ instance Show InvalidID where "Invalid Zettel ID: " <> toString s instance ToJSONKey ZettelID where - toJSONKey = toJSONKeyText zettelIDID + toJSONKey = toJSONKeyText zettelIDSlug instance FromJSONKey ZettelID where fromJSONKey = FromJSONKeyTextParser $ \s -> From 9a35ad4894e35346cd3ba440572a2b17243ebe66 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 20:00:35 -0400 Subject: [PATCH 4/9] Fix tests --- neuron/src/lib/Neuron/Web/Query/View.hs | 33 ++++++++++++++----- neuron/src/lib/Neuron/Zettelkasten/ID.hs | 8 ++++- neuron/test/Neuron/Config/AliasSpec.hs | 2 +- neuron/test/Neuron/VersionSpec.hs | 8 ++--- .../test/Neuron/Zettelkasten/ID/SchemeSpec.hs | 2 +- neuron/test/Neuron/Zettelkasten/IDSpec.hs | 13 ++++---- .../Neuron/Zettelkasten/Query/ParserSpec.hs | 12 +++---- .../Neuron/Zettelkasten/Zettel/ParserSpec.hs | 8 +++-- neuron/test/Neuron/Zettelkasten/ZettelSpec.hs | 2 +- 9 files changed, 57 insertions(+), 31 deletions(-) diff --git a/neuron/src/lib/Neuron/Web/Query/View.hs b/neuron/src/lib/Neuron/Web/Query/View.hs index e381fada1..ef01e50f9 100644 --- a/neuron/src/lib/Neuron/Web/Query/View.hs +++ b/neuron/src/lib/Neuron/Web/Query/View.hs @@ -18,20 +18,35 @@ where import Clay (Css, em, (?)) import qualified Clay as C -import Control.Monad.Except -import Data.Default -import Data.Dependent.Sum +import Data.Dependent.Sum (DSum (..)) import qualified Data.Map.Strict as Map -import Data.Some -import Data.TagTree (Tag (..), TagNode (..), TagPattern (..), constructTag, foldTagTree, tagMatchAny, tagTree) +import Data.Some (Some (..)) +import Data.TagTree + ( Tag (..), + TagNode (..), + TagPattern (..), + constructTag, + foldTagTree, + tagMatchAny, + tagTree, + ) import qualified Data.Text as T -import Data.Tree +import Data.Tree (Forest, Tree (Node)) import Neuron.Web.Route -import Neuron.Web.Widget -import Neuron.Zettelkasten.Connection -import Neuron.Zettelkasten.ID + ( NeuronWebT, + Route (..), + neuronRouteLink, + ) +import Neuron.Web.Widget (elTime, semanticIcon) +import Neuron.Zettelkasten.Connection (Connection (Folgezettel)) +import Neuron.Zettelkasten.ID (ZettelID (zettelIDRaw)) import Neuron.Zettelkasten.Query.Theme (LinkView (..), ZettelsView (..)) import Neuron.Zettelkasten.Zettel + ( Zettel, + ZettelQuery (..), + ZettelT (..), + sortZettelsReverseChronological, + ) import Reflex.Dom.Core hiding (count, tag) import Reflex.Dom.Pandoc (PandocBuilder, elPandocInlines) import Relude diff --git a/neuron/src/lib/Neuron/Zettelkasten/ID.hs b/neuron/src/lib/Neuron/Zettelkasten/ID.hs index 743016b5b..6e50452f2 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/ID.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/ID.hs @@ -35,7 +35,7 @@ data ZettelID = ZettelID -- | Actual ID used by the user, inside `[[..]]` zettelIDRaw :: Text } - deriving (Show, Ord, Generic, ToJSON, FromJSON) + deriving (Show, Ord, Generic) mkZettelID :: Text -> ZettelID mkZettelID s = @@ -49,6 +49,12 @@ instance Show InvalidID where show (InvalidIDParseError s) = "Invalid Zettel ID: " <> toString s +instance ToJSON ZettelID where + toJSON = toJSON . zettelIDRaw + +instance FromJSON ZettelID where + parseJSON = fmap mkZettelID . parseJSON + instance ToJSONKey ZettelID where toJSONKey = toJSONKeyText zettelIDSlug diff --git a/neuron/test/Neuron/Config/AliasSpec.hs b/neuron/test/Neuron/Config/AliasSpec.hs index e879ece9b..e53d368f8 100644 --- a/neuron/test/Neuron/Config/AliasSpec.hs +++ b/neuron/test/Neuron/Config/AliasSpec.hs @@ -26,4 +26,4 @@ itParsesAlias name s = fmap renderAlias (parse aliasParser "" s) `shouldBe` Right s where renderAlias Alias {..} = - unZettelID aliasZettel <> ":" <> unZettelID targetZettel + zettelIDSlug aliasZettel <> ":" <> zettelIDSlug targetZettel diff --git a/neuron/test/Neuron/VersionSpec.hs b/neuron/test/Neuron/VersionSpec.hs index 4d3fd412e..c58574c3d 100644 --- a/neuron/test/Neuron/VersionSpec.hs +++ b/neuron/test/Neuron/VersionSpec.hs @@ -28,10 +28,10 @@ spec = do "0.4" `isLesserOrEqual` olderThan it "full versions" $ do "0.7.1.2" `isGreater` olderThan - "0.6.12" `isGreater` olderThan - "0.6.11.8" `isGreater` olderThan - "0.6.0.0" `isLesserOrEqual` olderThan -- This is current version + "0.6.15" `isGreater` olderThan + "0.6.12.8" `isGreater` olderThan + "0.6.12.0" `isLesserOrEqual` olderThan -- This is current version "0.3.1.0" `isLesserOrEqual` olderThan it "within same major version" $ do - "0.6.11.8" `isGreater` olderThan + "0.6.12.8" `isGreater` olderThan "0.6.0.0" `isLesserOrEqual` olderThan -- This is current version diff --git a/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs b/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs index 60331d362..dc7277420 100644 --- a/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs @@ -31,7 +31,7 @@ spec = do `shouldReturn` Left IDConflict_AlreadyExists it "succeeds" $ do nextAvail (IDSchemeCustom "sunny-side-eggs") - `shouldReturn` Right (ZettelID "sunny-side-eggs") + `shouldReturn` Right (mkZettelID "sunny-side-eggs") context "hash ID" $ do it "should succeed" $ nextAvail IDSchemeHash diff --git a/neuron/test/Neuron/Zettelkasten/IDSpec.hs b/neuron/test/Neuron/Zettelkasten/IDSpec.hs index 93923a03c..1bd10f009 100644 --- a/neuron/test/Neuron/Zettelkasten/IDSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/IDSpec.hs @@ -16,25 +16,26 @@ spec :: Spec spec = do describe "ID parsing" $ do context "custom id parsing" $ do - let zid = Z.ZettelID "20abcde" + let zid = Z.mkZettelID "20abcde" it "parses a custom zettel ID" $ do Z.parseZettelID "20abcde" `shouldBe` Right zid it "parses a custom zettel ID from zettel filename" $ do Z.getZettelID Z.ZettelFormat_Markdown "20abcde.md" `shouldBe` Just zid Z.zettelIDSourceFileName zid Z.ZettelFormat_Markdown `shouldBe` "20abcde.md" - let deceptiveZid = Z.ZettelID "2136537e" + let deceptiveZid = Z.mkZettelID "2136537e" it "parses a custom zettel ID that looks like date ID" $ do Z.parseZettelID "2136537e" `shouldBe` Right deceptiveZid it "parses a custom zettel ID with dot" $ do - Z.parseZettelID "foo.bar" `shouldBe` Right (Z.ZettelID "foo.bar") + Z.parseZettelID "foo.bar" `shouldBe` Right (Z.ZettelID "foo.bar" "foo.bar") -- Even if there is a ".md" (not a file extension) - Z.parseZettelID "foo.md" `shouldBe` Right (Z.ZettelID "foo.md") + Z.parseZettelID "foo.md" `shouldBe` Right (Z.ZettelID "foo.md" "foo.bar") + it "parses full-phrase IDs" $ do + Z.parseZettelID "foo bar" `shouldBe` Right (Z.ZettelID "foo_bar" "foo bar") context "failures" $ do it "fails to parse ID with disallowed characters" $ do Z.parseZettelID "/foo" `shouldSatisfy` isLeft Z.parseZettelID "foo$" `shouldSatisfy` isLeft - Z.parseZettelID "foo bar" `shouldSatisfy` isLeft describe "ID converstion" $ do context "JSON encoding" $ do it "Converts ID to text when encoding to JSON" $ do - Aeson.toJSON (Z.ZettelID "20abcde") `shouldBe` Aeson.String "20abcde" + Aeson.toJSON (Z.mkZettelID "20abcde") `shouldBe` Aeson.String "20abcde" diff --git a/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs b/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs index 5a99140dc..84ea31f93 100644 --- a/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs @@ -26,16 +26,16 @@ spec = do let shortLink s = mkURILink s s it "parses custom/hash ID" $ do queryFromURILink (shortLink "foo-bar") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (ZettelID "foo-bar") Folgezettel) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") Folgezettel) it "even with ?cf" $ do queryFromURILink (shortLink "foo-bar?cf") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (ZettelID "foo-bar") OrdinaryConnection) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") OrdinaryConnection) it "parses prefixed short link" $ do queryFromURILink (shortLink "z:/foo-bar") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (ZettelID "foo-bar") Folgezettel) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") Folgezettel) it "resolves ambiguity using absolute URI" $ do queryFromURILink (shortLink "z:/tags") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (ZettelID "tags") Folgezettel) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "tags") Folgezettel) it "z:zettels" $ do queryFromURILink (shortLink "z:zettels") `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelsByTag [] Folgezettel def) @@ -61,10 +61,10 @@ spec = do describe "flexible links (regular markdown)" $ do it "Default connection type should be cf" $ do queryFromURILink (normalLink "foo-bar") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (ZettelID "foo-bar") OrdinaryConnection) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") OrdinaryConnection) it "Supports full filename instead of zettel ID" $ do queryFromURILink (normalLink "foo-bar.md") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (ZettelID "foo-bar") OrdinaryConnection) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") OrdinaryConnection) describe "non-connection links" $ do it "pass through normal links" $ do queryFromURILink (normalLink "https://www.srid.ca") diff --git a/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs b/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs index 5a7a558ef..ff7ceca15 100644 --- a/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs @@ -10,8 +10,12 @@ where import Data.TagTree (Tag (Tag)) import Neuron.Reader.Markdown (parseMarkdown) import Neuron.Reader.Type (ZettelFormat (ZettelFormat_Markdown)) -import Neuron.Zettelkasten.ID (ZettelID (ZettelID)) +import Neuron.Zettelkasten.ID (mkZettelID) import Neuron.Zettelkasten.Zettel + ( Zettel, + ZettelT (zettelTags), + sansContent, + ) import Neuron.Zettelkasten.Zettel.Parser (parseZettel) import Relude import Test.Hspec @@ -20,7 +24,7 @@ spec :: Spec spec = do describe "inline tags" $ do let parseSomeZettel = - sansContent . parseZettel ZettelFormat_Markdown parseMarkdown "" (ZettelID "note.md") + sansContent . parseZettel ZettelFormat_Markdown parseMarkdown "" (mkZettelID "note.md") it "simple" $ do let z :: Zettel = parseSomeZettel "An #inline tag" zettelTags z `shouldBe` [Tag "inline"] diff --git a/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs b/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs index 1cd9a461f..b96d839c8 100644 --- a/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs @@ -35,7 +35,7 @@ spec = do mkZettel zid datetime = Zettel - (ZettelID zid) + (mkZettelID zid) ZettelFormat_Markdown ".md" "Some title" From 1934d6c35c8dd0ba1015583aa9fa6a659cc3c645 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 20:06:51 -0400 Subject: [PATCH 5/9] Fix improper parsing of query args --- neuron/src/lib/Neuron/Reader/Markdown.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/neuron/src/lib/Neuron/Reader/Markdown.hs b/neuron/src/lib/Neuron/Reader/Markdown.hs index b6cebcefe..da948127c 100644 --- a/neuron/src/lib/Neuron/Reader/Markdown.hs +++ b/neuron/src/lib/Neuron/Reader/Markdown.hs @@ -205,7 +205,7 @@ wikiLinkSpec = render $ case n of 2 -> -- [[..]] adds "cf" flag in URI - uri {uriQuery = [QueryFlag [queryKey|cf|]]} + uri {uriQuery = uriQuery uri <> [QueryFlag [queryKey|cf|]]} _ -> uri Nothing -> fail "Not a neuron URI; ignoring" From 3d87065833237d4d0ba01a7eb9e233f612a118d1 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 20:10:43 -0400 Subject: [PATCH 6/9] make this function unsafe --- neuron/src/app/Neuron/Config/Alias.hs | 2 +- neuron/src/app/Neuron/Web/View.hs | 4 ++-- neuron/src/lib/Neuron/Zettelkasten/ID.hs | 17 ++++++++++++----- .../test/Neuron/Zettelkasten/ID/SchemeSpec.hs | 2 +- neuron/test/Neuron/Zettelkasten/IDSpec.hs | 6 +++--- .../Neuron/Zettelkasten/Query/ParserSpec.hs | 12 ++++++------ .../Neuron/Zettelkasten/Zettel/ParserSpec.hs | 4 ++-- neuron/test/Neuron/Zettelkasten/ZettelSpec.hs | 2 +- 8 files changed, 28 insertions(+), 21 deletions(-) diff --git a/neuron/src/app/Neuron/Config/Alias.hs b/neuron/src/app/Neuron/Config/Alias.hs index 7735c327b..ba77cb30c 100644 --- a/neuron/src/app/Neuron/Config/Alias.hs +++ b/neuron/src/app/Neuron/Config/Alias.hs @@ -32,7 +32,7 @@ getAliases Config {..} graph = do pure v where hasIndexZettel = - isJust . G.getZettel (mkZettelID "index") + isJust . G.getZettel indexZid mkAliases :: [Text] -> ZettelGraph -> Either Text [Alias] mkAliases aliasSpecs graph = diff --git a/neuron/src/app/Neuron/Web/View.hs b/neuron/src/app/Neuron/Web/View.hs index 4fb285338..ddb852556 100644 --- a/neuron/src/app/Neuron/Web/View.hs +++ b/neuron/src/app/Neuron/Web/View.hs @@ -41,7 +41,7 @@ import qualified Neuron.Web.Zettel.CSS as ZettelCSS import qualified Neuron.Web.Zettel.View as ZettelView import Neuron.Zettelkasten.Graph (ZettelGraph) import qualified Neuron.Zettelkasten.Graph as G -import Neuron.Zettelkasten.ID (mkZettelID) +import Neuron.Zettelkasten.ID (indexZid) import Neuron.Zettelkasten.Zettel import Reflex.Dom.Core hiding ((&)) import Reflex.Dom.Pandoc (PandocBuilder) @@ -102,7 +102,7 @@ renderRouteBody :: PandocBuilder t m => Text -> Config -> Route a -> (ZettelGrap renderRouteBody neuronVersion Config {..} r (g, x) = do let neuronTheme = Theme.mkTheme theme themeSelector = toText $ Theme.themeIdentifier neuronTheme - indexZettel = G.getZettel (mkZettelID "index") g + indexZettel = G.getZettel indexZid g elAttr "div" ("class" =: "ui fluid container" <> "id" =: themeSelector) $ do case r of Route_ZIndex -> do diff --git a/neuron/src/lib/Neuron/Zettelkasten/ID.hs b/neuron/src/lib/Neuron/Zettelkasten/ID.hs index 6e50452f2..48f76f97b 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/ID.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/ID.hs @@ -10,7 +10,8 @@ module Neuron.Zettelkasten.ID ( ZettelID (..), InvalidID (..), - mkZettelID, + unsafeMkZettelID, + indexZid, parseZettelID, idParser, getZettelID, @@ -37,11 +38,17 @@ data ZettelID = ZettelID } deriving (Show, Ord, Generic) -mkZettelID :: Text -> ZettelID -mkZettelID s = +-- | Make ZettelID from raw text. +-- +-- Assumes that input text is already validated for allowed characters. +unsafeMkZettelID :: Text -> ZettelID +unsafeMkZettelID s = let slug = T.intercalate "_" $ T.splitOn " " s in ZettelID slug s +indexZid :: ZettelID +indexZid = unsafeMkZettelID "index" + instance Eq ZettelID where (==) (ZettelID a _) (ZettelID b _) = a == b @@ -53,7 +60,7 @@ instance ToJSON ZettelID where toJSON = toJSON . zettelIDRaw instance FromJSON ZettelID where - parseJSON = fmap mkZettelID . parseJSON + parseJSON = fmap unsafeMkZettelID . parseJSON instance ToJSONKey ZettelID where toJSONKey = toJSONKeyText zettelIDSlug @@ -87,7 +94,7 @@ idParser = do <|> M.char '-' <|> M.char '.' <|> M.char ' ' - pure $ mkZettelID (toText s) + pure $ unsafeMkZettelID (toText s) -- | Parse the ZettelID if the given filepath is a zettel. getZettelID :: ZettelFormat -> FilePath -> Maybe ZettelID diff --git a/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs b/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs index dc7277420..a769e5dfc 100644 --- a/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs @@ -31,7 +31,7 @@ spec = do `shouldReturn` Left IDConflict_AlreadyExists it "succeeds" $ do nextAvail (IDSchemeCustom "sunny-side-eggs") - `shouldReturn` Right (mkZettelID "sunny-side-eggs") + `shouldReturn` Right (unsafeMkZettelID "sunny-side-eggs") context "hash ID" $ do it "should succeed" $ nextAvail IDSchemeHash diff --git a/neuron/test/Neuron/Zettelkasten/IDSpec.hs b/neuron/test/Neuron/Zettelkasten/IDSpec.hs index 1bd10f009..30f5e2d93 100644 --- a/neuron/test/Neuron/Zettelkasten/IDSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/IDSpec.hs @@ -16,13 +16,13 @@ spec :: Spec spec = do describe "ID parsing" $ do context "custom id parsing" $ do - let zid = Z.mkZettelID "20abcde" + let zid = Z.unsafeMkZettelID "20abcde" it "parses a custom zettel ID" $ do Z.parseZettelID "20abcde" `shouldBe` Right zid it "parses a custom zettel ID from zettel filename" $ do Z.getZettelID Z.ZettelFormat_Markdown "20abcde.md" `shouldBe` Just zid Z.zettelIDSourceFileName zid Z.ZettelFormat_Markdown `shouldBe` "20abcde.md" - let deceptiveZid = Z.mkZettelID "2136537e" + let deceptiveZid = Z.unsafeMkZettelID "2136537e" it "parses a custom zettel ID that looks like date ID" $ do Z.parseZettelID "2136537e" `shouldBe` Right deceptiveZid it "parses a custom zettel ID with dot" $ do @@ -38,4 +38,4 @@ spec = do describe "ID converstion" $ do context "JSON encoding" $ do it "Converts ID to text when encoding to JSON" $ do - Aeson.toJSON (Z.mkZettelID "20abcde") `shouldBe` Aeson.String "20abcde" + Aeson.toJSON (Z.unsafeMkZettelID "20abcde") `shouldBe` Aeson.String "20abcde" diff --git a/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs b/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs index 84ea31f93..6d6e03ea9 100644 --- a/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/Query/ParserSpec.hs @@ -26,16 +26,16 @@ spec = do let shortLink s = mkURILink s s it "parses custom/hash ID" $ do queryFromURILink (shortLink "foo-bar") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") Folgezettel) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (unsafeMkZettelID "foo-bar") Folgezettel) it "even with ?cf" $ do queryFromURILink (shortLink "foo-bar?cf") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") OrdinaryConnection) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (unsafeMkZettelID "foo-bar") OrdinaryConnection) it "parses prefixed short link" $ do queryFromURILink (shortLink "z:/foo-bar") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") Folgezettel) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (unsafeMkZettelID "foo-bar") Folgezettel) it "resolves ambiguity using absolute URI" $ do queryFromURILink (shortLink "z:/tags") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "tags") Folgezettel) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (unsafeMkZettelID "tags") Folgezettel) it "z:zettels" $ do queryFromURILink (shortLink "z:zettels") `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelsByTag [] Folgezettel def) @@ -61,10 +61,10 @@ spec = do describe "flexible links (regular markdown)" $ do it "Default connection type should be cf" $ do queryFromURILink (normalLink "foo-bar") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") OrdinaryConnection) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (unsafeMkZettelID "foo-bar") OrdinaryConnection) it "Supports full filename instead of zettel ID" $ do queryFromURILink (normalLink "foo-bar.md") - `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (mkZettelID "foo-bar") OrdinaryConnection) + `shouldBe` Right (Just $ Some $ ZettelQuery_ZettelByID (unsafeMkZettelID "foo-bar") OrdinaryConnection) describe "non-connection links" $ do it "pass through normal links" $ do queryFromURILink (normalLink "https://www.srid.ca") diff --git a/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs b/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs index ff7ceca15..8bb5c5472 100644 --- a/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/Zettel/ParserSpec.hs @@ -10,7 +10,7 @@ where import Data.TagTree (Tag (Tag)) import Neuron.Reader.Markdown (parseMarkdown) import Neuron.Reader.Type (ZettelFormat (ZettelFormat_Markdown)) -import Neuron.Zettelkasten.ID (mkZettelID) +import Neuron.Zettelkasten.ID (unsafeMkZettelID) import Neuron.Zettelkasten.Zettel ( Zettel, ZettelT (zettelTags), @@ -24,7 +24,7 @@ spec :: Spec spec = do describe "inline tags" $ do let parseSomeZettel = - sansContent . parseZettel ZettelFormat_Markdown parseMarkdown "" (mkZettelID "note.md") + sansContent . parseZettel ZettelFormat_Markdown parseMarkdown "" (unsafeMkZettelID "note.md") it "simple" $ do let z :: Zettel = parseSomeZettel "An #inline tag" zettelTags z `shouldBe` [Tag "inline"] diff --git a/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs b/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs index b96d839c8..a95fb417b 100644 --- a/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs +++ b/neuron/test/Neuron/Zettelkasten/ZettelSpec.hs @@ -35,7 +35,7 @@ spec = do mkZettel zid datetime = Zettel - (mkZettelID zid) + (unsafeMkZettelID zid) ZettelFormat_Markdown ".md" "Some title" From 8504822549e731972f0024b1f798b80814e663ff Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 20:15:16 -0400 Subject: [PATCH 7/9] avoid show on zid --- neuron/src/app/Neuron/Config/Alias.hs | 4 ++-- neuron/src/lib/Neuron/Web/ZIndex.hs | 4 ++-- neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/neuron/src/app/Neuron/Config/Alias.hs b/neuron/src/app/Neuron/Config/Alias.hs index ba77cb30c..205826d00 100644 --- a/neuron/src/app/Neuron/Config/Alias.hs +++ b/neuron/src/app/Neuron/Config/Alias.hs @@ -41,10 +41,10 @@ mkAliases aliasSpecs graph = alias@Alias {..} <- liftEither $ parse aliasParser configFile aliasSpec when (isJust $ G.getZettel aliasZettel graph) $ do throwError $ - "Cannot create redirect from '" <> show aliasZettel <> "', because a zettel with that ID already exists" + "Cannot create redirect from '" <> zettelIDRaw aliasZettel <> "', because a zettel with that ID already exists" when (zettelIDSlug targetZettel /= "z-index" && isNothing (G.getZettel targetZettel graph)) $ do throwError $ - "Target zettel '" <> show targetZettel <> "' does not exist" + "Target zettel '" <> zettelIDRaw targetZettel <> "' does not exist" pure alias aliasParser :: Parser Alias diff --git a/neuron/src/lib/Neuron/Web/ZIndex.hs b/neuron/src/lib/Neuron/Web/ZIndex.hs index d92a4583a..937afe04d 100644 --- a/neuron/src/lib/Neuron/Web/ZIndex.hs +++ b/neuron/src/lib/Neuron/Web/ZIndex.hs @@ -136,8 +136,8 @@ renderErrors errors = do text " has malformed queries" ZettelError_AmbiguousFiles _ -> do text $ - "More than one file define the same zettel ID (" - <> show zid + "More than one file define the same zettel ID slug (" + <> zettelIDSlug zid <> "):" forM_ (Map.toList errors) $ \(zid, zError) -> divClass ("ui tiny message " <> severity zError) $ do diff --git a/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs b/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs index caae61591..6bc018a1e 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs @@ -50,4 +50,4 @@ showQueryParseError qe = showQueryResultError :: QueryResultError -> Text showQueryResultError (QueryResultError_NoSuchZettel zid) = - "links to non-existant zettel: " <> show zid + "links to non-existant zettel: " <> zettelIDRaw zid From 0e100d000ce6248b866adb1366a59fd90be71fca Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 20:30:32 -0400 Subject: [PATCH 8/9] docs --- guide/2011403.md | 11 +++++++++-- neuron/src/app/Neuron/CLI/Types.hs | 4 ++-- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/guide/2011403.md b/guide/2011403.md index 7779b2728..bc3f1ee08 100644 --- a/guide/2011403.md +++ b/guide/2011403.md @@ -9,7 +9,14 @@ specify your own as well, as long as it contains only the following characters: * hyphen (`-`) * underscore (`_`) * dot (`.`) +* whitespace -## Why prefer random IDs? +## When to use title IDs -Why does neuron use random alphameric IDs *by default*? Because then you are not forced to think of a suitable slug when writing a new note. A note's title may change in future, so could a slug. Generally, text editors make it easier to work with this, by automatically showing the title of the linked note next to the link (see [[4a6b25f1]]). +A title ID is one that uses arbitrary phrases (with whitespace characters). For example, in the link `[[Some note title]]` (see [[2011504]]), "Some note title" is the title ID, which is generated in the [[2011405]] as the HTML file named "Some_note_title.html". + +Use title IDs when you want truly future-proof link IDs that work on any text editor. However, note that this comes at the cost that you are willing to rename them (manually or using a script) across your Zettelkasten if the title ID of any of your notes changes. + +## When to prefer random IDs + +The advantage to using random IDs (which neuron uses by default) is that you do not have to rename links across your Zettelkasten when changing the title IDs. This makes the links less future-proof, because you will want to use an editor (see [[4a6b25f1]]) that supports expanding them with the title from the note text. \ No newline at end of file diff --git a/neuron/src/app/Neuron/CLI/Types.hs b/neuron/src/app/Neuron/CLI/Types.hs index a535757b7..8768b4ac6 100644 --- a/neuron/src/app/Neuron/CLI/Types.hs +++ b/neuron/src/app/Neuron/CLI/Types.hs @@ -144,10 +144,10 @@ commandParser defaultNotesDir now = do idSchemeF <- fmap (const $ const $ Some IDSchemeHash) - (switch (long "id-hash" <> help "Use random hash ID (default)")) + (switch (long "--random-id" <> help "Generate a random ID (default)")) <|> fmap (const . Some . IDSchemeCustom) - (option str (long "id" <> help "Use a custom ID" <> metavar "IDNAME")) + (option str (long "id" <> help "Use an arbitrary title ID" <> metavar "IDNAME")) pure $ New $ NewCommand title format dateParam (idSchemeF $ getDay dateParam) edit openCommand = do fmap Open $ From 4974cda3a573d69c3100c932bd96b5b94b2e1e17 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 17 Sep 2020 21:00:33 -0400 Subject: [PATCH 9/9] fix a json bug --- neuron/src/lib/Neuron/Zettelkasten/ID.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/neuron/src/lib/Neuron/Zettelkasten/ID.hs b/neuron/src/lib/Neuron/Zettelkasten/ID.hs index 48f76f97b..227fdfee0 100644 --- a/neuron/src/lib/Neuron/Zettelkasten/ID.hs +++ b/neuron/src/lib/Neuron/Zettelkasten/ID.hs @@ -63,7 +63,7 @@ instance FromJSON ZettelID where parseJSON = fmap unsafeMkZettelID . parseJSON instance ToJSONKey ZettelID where - toJSONKey = toJSONKeyText zettelIDSlug + toJSONKey = toJSONKeyText zettelIDRaw instance FromJSONKey ZettelID where fromJSONKey = FromJSONKeyTextParser $ \s -> @@ -72,7 +72,11 @@ instance FromJSONKey ZettelID where Left e -> fail $ show e zettelIDSourceFileName :: ZettelID -> ZettelFormat -> FilePath -zettelIDSourceFileName zid fmt = toString $ zettelIDRaw zid <> zettelFormatToExtension fmt +zettelIDSourceFileName zid fmt = + toString (fn <> ext) + where + fn = zettelIDRaw zid + ext = zettelFormatToExtension fmt --------- -- Parser