Drop support for legacy date IDs (#368)

CHANGELOG.md

@@ -24,6 +24,7 @@
     - support for [fancy lists](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/fancy_lists.md) (#335)
     - Fix hard line breaks to actually work (#354)
   - Allow dot in Zettel ID (#369)
+  - Drop support for legacy date IDs (#368)
 - CLI
   - Faster querying: add `--cached` option to `neuron query`, to run faster using the cache. To keep the cache up to date, make sure that `neuron rib` is running.
   - Add `--id` and `--search` options to `open` command to open given zettel ID or search page respectively  (#317)

guide/guide.md

@@ -2,7 +2,7 @@
 
 Neuron includes a web interface for your notes that update automatically. This very site you are viewing is managed by neuron; and you may access its notes [here](https://github.com/srid/neuron/tree/master/guide). The "zettel" you are viewing currently is conceptually termed an "overview zettel", as it provides a portal into the other zettels. 
 
-Neuron also generates a complete index (at [z-index](z-index.html)) of *all* Zettels visualized as a [[2017401]].
+Neuron also generates a complete index (at [z-index](./z-index.html)) of *all* Zettels visualized as a [[2017401]].
 
 - [[[2011403]]]
 - [[[2011404]]]

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.9.1
+version: 0.6.10.0
 license: AGPL-3.0-only
 copyright: 2020 Sridhar Ratnakumar
 maintainer: [email protected]

neuron/src/app/Neuron/CLI/Types.hs

@@ -145,9 +145,6 @@ commandParser defaultNotesDir now = do
         fmap
           (const $ const $ Some IDSchemeHash)
           (switch (long "id-hash" <> help "Use random hash ID (default)"))
-          <|> fmap
-            (const $ Some . IDSchemeDate)
-            (switch (long "id-date" <> help "Use date encoded ID"))
           <|> fmap
             (const . Some . IDSchemeCustom)
             (option str (long "id" <> help "Use a custom ID" <> metavar "IDNAME"))

neuron/src/app/Neuron/Config/Alias.hs

@@ -32,7 +32,7 @@ getAliases Config {..} graph = do
       pure v
   where
     hasIndexZettel =
-      isJust . G.getZettel (ZettelCustomID "index")
+      isJust . G.getZettel (ZettelID "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 '" <> zettelIDText aliasZettel <> "', because a zettel with that ID already exists"
-      when (zettelIDText targetZettel /= "z-index" && isNothing (G.getZettel targetZettel graph)) $ do
+          "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
         throwError $
-          "Target zettel '" <> zettelIDText targetZettel <> "' does not exist"
+          "Target zettel '" <> unZettelID targetZettel <> "' does not exist"
       pure alias
 
 aliasParser :: Parser Alias

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 (zettelIDText -> s) ->
+    Route_Zettel (unZettelID -> s) ->
       pure $ toString s <> ".html"
 
 staticRouteConfig :: RouteConfig t m

neuron/src/app/Neuron/Web/View.hs

@@ -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 (ZettelCustomID "index") g
+      indexZettel = G.getZettel (ZettelID "index") g
   elAttr "div" ("class" =: "ui fluid container" <> "id" =: themeSelector) $ do
     case r of
       Route_ZIndex -> do

neuron/src/app/Neuron/Zettelkasten/ID/Scheme.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
+-- TODO: Simplify or eliminate this module, now that date IDs are gone.
 module Neuron.Zettelkasten.ID.Scheme
   ( nextAvailableZettelID,
     genVal,
@@ -18,7 +19,6 @@ import Data.GADT.Compare.TH
 import Data.GADT.Show.TH
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import Data.Time
 import Data.UUID (UUID)
 import qualified Data.UUID as UUID
 import Data.UUID.V4 (nextRandom)
@@ -29,16 +29,13 @@ import Text.Show
 
 -- | The scheme to use when generating new IDs
 data IDScheme a where
-  -- | Legacy date IDs (deprecated)
-  IDSchemeDate :: Day -> IDScheme ()
   -- | Random IDs (default)
   IDSchemeHash :: IDScheme UUID
   -- | Custom ID (specified by the user)
   IDSchemeCustom :: Text -> IDScheme ()
 
 data IDConflict
   = IDConflict_AlreadyExists
-  | IDConflict_DateIDExhausted
   | IDConflict_HashConflict Text
   | IDConflict_BadCustomID Text Text
   deriving (Eq)
@@ -47,8 +44,6 @@ instance Show IDConflict where
   show = \case
     IDConflict_AlreadyExists ->
       "A zettel with that ID already exists"
-    IDConflict_DateIDExhausted ->
-      "Ran out of date ID indices for this day"
     IDConflict_HashConflict s ->
       "Hash conflict on " <> toString s <> "; try again"
     IDConflict_BadCustomID s e ->
@@ -59,8 +54,6 @@ genVal :: forall a. IDScheme a -> IO a
 genVal = \case
   IDSchemeHash ->
     nextRandom
-  IDSchemeDate _ ->
-    pure ()
   IDSchemeCustom _ ->
     pure ()
 
@@ -79,27 +72,16 @@ nextAvailableZettelID ::
   IDScheme a ->
   Either IDConflict ZettelID
 nextAvailableZettelID zs val = \case
-  IDSchemeDate day -> do
-    let dayIndices = nonEmpty $
-          sort $
-            flip mapMaybe (Set.toList zs) $ \case
-              ZettelDateID d x
-                | d == day -> Just x
-              _ -> Nothing
-    case last <$> dayIndices of
-      Nothing -> pure $ ZettelDateID day 1
-      Just 99 -> throwError IDConflict_DateIDExhausted
-      Just idx -> pure $ ZettelDateID day (idx + 1)
   IDSchemeHash -> do
     let s = T.take 8 $ UUID.toText val
-    if s `Set.member` (zettelIDText `Set.map` zs)
+    if s `Set.member` (unZettelID `Set.map` zs)
       then throwError $ IDConflict_HashConflict s
       else
-        either (error . toText) (pure . ZettelCustomID) $
+        either (error . toText) (pure . ZettelID) $
           parse customIDParser "<random-hash>" s
   IDSchemeCustom s -> runExcept $ do
     zid <-
-      either (throwError . IDConflict_BadCustomID s) (pure . ZettelCustomID) $
+      either (throwError . IDConflict_BadCustomID s) (pure . ZettelID) $
         parse customIDParser "<next-id>" s
     if zid `Set.member` zs
       then throwError IDConflict_AlreadyExists

neuron/src/lib/Neuron/Web/Query/View.hs

@@ -118,7 +118,7 @@ renderZettelLink mInner conn (fromMaybe def -> linkView) Zettel {..} = do
           LinkView_ShowDate ->
             elTime <$> zettelDate
           LinkView_ShowID ->
-            Just $ el "tt" $ text $ zettelIDText zettelID
+            Just $ el "tt" $ text $ unZettelID zettelID
       classes :: [Text] = catMaybes $ [Just "zettel-link-container"] <> [connClass, rawClass]
   elClass "span" (T.intercalate " " classes) $ do
     forM_ mextra $ \extra ->
@@ -162,7 +162,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 $ zettelIDText zid
+      neuronRouteLink (Some $ Route_Zettel zid) mempty $ text $ unZettelID zid
 
 renderTagTree :: forall t m. DomBuilder t m => Forest (NonEmpty TagNode, Natural) -> NeuronWebT t m ()
 renderTagTree t =

neuron/src/lib/Neuron/Web/ZIndex.hs

@@ -121,7 +121,7 @@ renderErrors errors = do
         ZettelError_AmbiguousFiles _ -> do
           text $
             "More than one file define the same zettel ID ("
-              <> zettelIDText zid
+              <> unZettelID zid
               <> "):"
   forM_ (Map.toList errors) $ \(zid, zError) ->
     divClass ("ui tiny message " <> severity zError) $ do

neuron/src/lib/Neuron/Zettelkasten/ID.hs

@@ -10,7 +10,6 @@
 module Neuron.Zettelkasten.ID
   ( ZettelID (..),
     InvalidID (..),
-    zettelIDText,
     parseZettelID,
     idParser,
     getZettelID,
@@ -21,22 +20,15 @@ where
 
 import Data.Aeson
 import Data.Aeson.Types (toJSONKeyText)
-import qualified Data.Text as T
-import Data.Time
 import Neuron.Reader.Type (ZettelFormat, zettelFormatToExtension)
 import Relude
 import System.FilePath
 import qualified Text.Megaparsec as M
 import qualified Text.Megaparsec.Char as M
 import Text.Megaparsec.Simple
-import Text.Printf
 import qualified Text.Show
 
-data ZettelID
-  = -- | Short Zettel ID encoding `Day` and a numeric index (on that day).
-    ZettelDateID Day Int
-  | -- | Arbitrary alphanumeric ID.
-    ZettelCustomID Text
+newtype ZettelID = ZettelID {unZettelID :: Text}
   deriving (Eq, Show, Ord, Generic)
 
 instance Show InvalidID where
@@ -51,7 +43,7 @@ instance FromJSON ZettelID where
       Right zid -> pure zid
 
 instance ToJSONKey ZettelID where
-  toJSONKey = toJSONKeyText zettelIDText
+  toJSONKey = toJSONKeyText unZettelID
 
 instance FromJSONKey ZettelID where
   fromJSONKey = FromJSONKeyTextParser $ \s ->
@@ -60,29 +52,10 @@ instance FromJSONKey ZettelID where
       Left e -> fail $ show e
 
 instance ToJSON ZettelID where
-  toJSON = toJSON . zettelIDText
-
-zettelIDText :: ZettelID -> Text
-zettelIDText = \case
-  ZettelDateID day idx ->
-    formatDay day <> toText @String (printf "%02d" idx)
-  ZettelCustomID s -> s
-
-formatDay :: Day -> Text
-formatDay day =
-  subDay $ toText $ formatTime defaultTimeLocale "%y%W%a" day
-  where
-    subDay =
-      T.replace "Mon" "1"
-        . T.replace "Tue" "2"
-        . T.replace "Wed" "3"
-        . T.replace "Thu" "4"
-        . T.replace "Fri" "5"
-        . T.replace "Sat" "6"
-        . T.replace "Sun" "7"
+  toJSON = toJSON . unZettelID
 
 zettelIDSourceFileName :: ZettelID -> ZettelFormat -> FilePath
-zettelIDSourceFileName zid fmt = toString $ zettelIDText zid <> zettelFormatToExtension fmt
+zettelIDSourceFileName zid fmt = toString $ unZettelID zid <> zettelFormatToExtension fmt
 
 ---------
 -- Parser
@@ -97,26 +70,7 @@ parseZettelID =
 
 idParser :: Parser ZettelID
 idParser =
-  M.try (fmap (uncurry ZettelDateID) $ dayParser <* M.eof)
-    <|> fmap ZettelCustomID customIDParser
-
-dayParser :: Parser (Day, Int)
-dayParser = do
-  year <- parseNum 2
-  week <- parseNum 2
-  dayName <- dayFromIdx =<< parseNum 1
-  idx <- parseNum 2
-  day <-
-    parseTimeM False defaultTimeLocale "%y%W%a" $
-      printf "%02d" year <> printf "%02d" week <> dayName
-  pure (day, idx)
-  where
-    parseNum n = readNum =<< M.count n M.digitChar
-    readNum = maybe (fail "Not a number") pure . readMaybe
-    dayFromIdx :: MonadFail m => Int -> m String
-    dayFromIdx idx =
-      maybe (fail "Day should be a value from 1 to 7") pure $
-        ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"] !!? (idx - 1)
+  fmap ZettelID customIDParser
 
 customIDParser :: Parser Text
 customIDParser = do

neuron/src/lib/Neuron/Zettelkasten/Query/Error.hs

@@ -8,7 +8,7 @@ module Neuron.Zettelkasten.Query.Error where
 
 import Data.Aeson
 import Neuron.Orphans ()
-import Neuron.Zettelkasten.ID (InvalidID, ZettelID, zettelIDText)
+import Neuron.Zettelkasten.ID (InvalidID, ZettelID (..))
 import Relude
 import Text.URI (URI)
 import qualified Text.URI as URI
@@ -50,4 +50,4 @@ showQueryParseError qe =
 
 showQueryResultError :: QueryResultError -> Text
 showQueryResultError (QueryResultError_NoSuchZettel zid) =
-  "links to non-existant zettel: " <> zettelIDText zid
+  "links to non-existant zettel: " <> unZettelID zid

neuron/src/lib/Neuron/Zettelkasten/Zettel/Parser.hs

@@ -13,7 +13,6 @@ import Data.List (nub)
 import Data.Some
 import Data.TagTree (Tag)
 import qualified Data.Text as T
-import Data.Time.DateMayTime (mkDateMayTime)
 import Neuron.Reader.Type
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.Query.Error
@@ -43,11 +42,7 @@ parseZettel format zreader fn zid s = do
               ((,True) . plainify . snd <$> getH1 doc)
                 <|> ((,False) . takeInitial . plainify <$> getFirstParagraphText doc)
           metaTags = fromMaybe [] $ Meta.tags =<< meta
-          date = case zid of
-            -- We ignore the "data" meta field on legacy Date IDs, which encode the
-            -- creation date in the ID.
-            ZettelDateID v _ -> Just $ mkDateMayTime $ Left v
-            ZettelCustomID _ -> Meta.date =<< meta
+          date = Meta.date =<< meta
           unlisted = fromMaybe False $ Meta.unlisted =<< meta
           (queries, errors) = runWriter $ extractQueries doc
           queryTags = getInlineTag `mapMaybe` queries

neuron/test/Neuron/Config/AliasSpec.hs

@@ -26,4 +26,4 @@ itParsesAlias name s =
     fmap renderAlias (parse aliasParser "<hspec>" s) `shouldBe` Right s
   where
     renderAlias Alias {..} =
-      zettelIDText aliasZettel <> ":" <> zettelIDText targetZettel
+      unZettelID aliasZettel <> ":" <> unZettelID targetZettel

neuron/test/Neuron/Zettelkasten/ID/SchemeSpec.hs

@@ -7,7 +7,6 @@ module Neuron.Zettelkasten.ID.SchemeSpec
 where
 
 import qualified Data.Set as Set
-import Data.Time
 import Neuron.Zettelkasten.ID
 import Neuron.Zettelkasten.ID.Scheme
 import Relude
@@ -23,7 +22,6 @@ spec = do
               [ "ribeye-steak",
                 "2015403"
               ]
-        day = fromGregorian 2020 4 16
         nextAvail scheme = do
           v <- genVal scheme
           pure $ nextAvailableZettelID zettels v scheme
@@ -33,15 +31,7 @@ spec = do
           `shouldReturn` Left IDConflict_AlreadyExists
       it "succeeds" $ do
         nextAvail (IDSchemeCustom "sunny-side-eggs")
-          `shouldReturn` Right (ZettelCustomID "sunny-side-eggs")
-    context "date ID" $ do
-      it "should return index 0" $ do
-        let otherDay = fromGregorian 2020 5 16
-        nextAvail (IDSchemeDate otherDay)
-          `shouldReturn` Right (ZettelDateID otherDay 1)
-      it "should return correct index" $
-        nextAvail (IDSchemeDate day)
-          `shouldReturn` Right (ZettelDateID day 4)
+          `shouldReturn` Right (ZettelID "sunny-side-eggs")
     context "hash ID" $ do
       it "should succeed" $
         nextAvail IDSchemeHash