From 0eada71b723a7047d49650e8d09e2f6f8f645bea Mon Sep 17 00:00:00 2001 From: Paul Grillenberger Date: Mon, 20 Jul 2026 20:02:10 +0200 Subject: [PATCH] feat!(registry): remodel registry as map --- app/CertPrep/TUI/ConfigSelect.hs | 6 +++--- cert-prep.cabal | 4 ++++ package.yaml | 1 + src/CertPrep/Registry.hs | 13 ++++++++----- test/RegistrySpec.hs | 33 +++++++++++++++++++------------- 5 files changed, 36 insertions(+), 21 deletions(-) diff --git a/app/CertPrep/TUI/ConfigSelect.hs b/app/CertPrep/TUI/ConfigSelect.hs index f42a5df..3d92a52 100644 --- a/app/CertPrep/TUI/ConfigSelect.hs +++ b/app/CertPrep/TUI/ConfigSelect.hs @@ -1,11 +1,11 @@ module CertPrep.TUI.ConfigSelect (selectConfig) where -import Brick +import Brick hiding (Down) import Brick.Widgets.Border import Brick.Widgets.Border.Style import Brick.Widgets.Center import Brick.Widgets.List qualified as L -import CertPrep.Registry (Registry, RegistryEntry (..)) +import CertPrep.Registry (Registry, RegistryEntry (..), toSortedList) import Data.Time (defaultTimeLocale, formatTime) import Data.Vector qualified as V import Graphics.Vty qualified as Vty @@ -60,7 +60,7 @@ theMap = selectConfig :: Registry -> IO (Maybe FilePath) selectConfig entries = do - let initial = L.list () (V.fromList entries) 1 + let initial = L.list () (V.fromList $ toSortedList entries) 1 app = App { appDraw = drawSelectUI diff --git a/cert-prep.cabal b/cert-prep.cabal index cd99028..0541481 100644 --- a/cert-prep.cabal +++ b/cert-prep.cabal @@ -37,6 +37,7 @@ library mixins: base hiding (Prelude) , relude (Relude as Prelude) + , relude hs-source-dirs: src default-extensions: @@ -90,6 +91,7 @@ library cert-prep-tui mixins: base hiding (Prelude) , relude (Relude as Prelude) + , relude default-language: GHC2021 executable cert-prep @@ -114,6 +116,7 @@ executable cert-prep mixins: base hiding (Prelude) , relude (Relude as Prelude) + , relude hs-source-dirs: exe default-extensions: @@ -164,4 +167,5 @@ test-suite spec mixins: base hiding (Prelude) , relude (Relude as Prelude) + , relude default-language: GHC2021 diff --git a/package.yaml b/package.yaml index d798a23..2edf655 100644 --- a/package.yaml +++ b/package.yaml @@ -18,6 +18,7 @@ dependencies: - name: relude mixin: - (Relude as Prelude) + - "" - text - containers - random >= 1.3 diff --git a/src/CertPrep/Registry.hs b/src/CertPrep/Registry.hs index 34a3e1b..344d7da 100644 --- a/src/CertPrep/Registry.hs +++ b/src/CertPrep/Registry.hs @@ -6,6 +6,7 @@ module CertPrep.Registry ( loadRegistry, saveRegistry, registerConfig, + toSortedList, ) where import Data.Aeson ( @@ -14,6 +15,7 @@ import Data.Aeson ( eitherDecodeStrict, encode, ) +import Data.Map qualified as M import Data.Time (UTCTime, getCurrentTime) import System.Directory ( XdgDirectory (XdgConfig), @@ -31,7 +33,7 @@ data RegistryEntry = RegistryEntry } deriving (Show, Eq, Generic) -type Registry = [RegistryEntry] +type Registry = Map FilePath RegistryEntry instance FromJSON RegistryEntry instance ToJSON RegistryEntry @@ -44,7 +46,7 @@ registryFilePath = do loadRegistry :: IO Registry loadRegistry = do path <- registryFilePath - fromRight [] <$> loadFile path + fromRight M.empty <$> loadFile path loadFile :: (FromJSON a) => FilePath -> IO (Either String a) loadFile p = do @@ -72,7 +74,8 @@ registerConfig p title = do , path = canonPath , lastUsed = now } - updated = - sortWith (Down . lastUsed) $ - entry : filter (\e -> path e /= canonPath) existing + updated = M.insert canonPath entry existing saveRegistry updated + +toSortedList :: Registry -> [RegistryEntry] +toSortedList = sortOn (Down . lastUsed) . toList diff --git a/test/RegistrySpec.hs b/test/RegistrySpec.hs index 7d9ce84..342e563 100644 --- a/test/RegistrySpec.hs +++ b/test/RegistrySpec.hs @@ -2,7 +2,9 @@ module RegistrySpec (spec) where import CertPrep.Registry import Data.Aeson (decode, encode) +import Data.Map qualified as M import Data.Time (UTCTime, getCurrentTime) +import Relude.Extra (StaticMap (lookup), fmapToFst) import System.Environment (setEnv) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec @@ -15,6 +17,9 @@ mkEntry title path lastUsed = , lastUsed = lastUsed } +registryFromList :: [RegistryEntry] -> Registry +registryFromList = fromList . fmapToFst path + spec :: Spec spec = do describe "RegistryEntry JSON" $ do @@ -26,26 +31,28 @@ spec = do it "roundtrips a list through JSON" $ do now <- getCurrentTime let entries = - [ mkEntry "Config A" "/a.json" now - , mkEntry "Config B" "/b.json" now - ] + registryFromList + [ mkEntry "Config A" "/a.json" now + , mkEntry "Config B" "/b.json" now + ] decode (encode entries) `shouldBe` Just entries describe "loadRegistry / saveRegistry" $ do - it "returns [] when no registry file exists" $ do + it "returns empty map when no registry file exists" $ do withSystemTempDirectory "cert-prep-test" $ \tmpDir -> do setEnv "XDG_CONFIG_HOME" tmpDir registry <- loadRegistry - registry `shouldBe` [] + registry `shouldBe` M.empty it "roundtrips entries through save/load" $ do withSystemTempDirectory "cert-prep-test" $ \tmpDir -> do setEnv "XDG_CONFIG_HOME" tmpDir now <- getCurrentTime let entries = - [ mkEntry "Config A" "/a.json" now - , mkEntry "Config B" "/b.json" now - ] + registryFromList + [ mkEntry "Config A" "/a.json" now + , mkEntry "Config B" "/b.json" now + ] saveRegistry entries loaded <- loadRegistry loaded `shouldBe` entries @@ -59,8 +66,8 @@ spec = do writeFile configPath "{}" registerConfig configPath "My Config" registry <- loadRegistry - case registry of - [e] -> title e `shouldBe` "My Config" + case configPath `lookup` registry of + Just e -> title e `shouldBe` "My Config" _ -> expectationFailure $ "Expected 1 entry, got " ++ show (length registry) it "upserts existing entry by path" $ do @@ -71,8 +78,8 @@ spec = do registerConfig configPath "Title v1" registerConfig configPath "Title v2" registry <- loadRegistry - case registry of - [e] -> title e `shouldBe` "Title v2" + case configPath `lookup` registry of + Just e -> title e `shouldBe` "Title v2" _ -> expectationFailure $ "Expected 1 entry, got " ++ show (length registry) it "keeps entries sorted by lastUsed descending" $ do @@ -85,6 +92,6 @@ spec = do registerConfig pathA "Config A" registerConfig pathB "Config B" registry <- loadRegistry - case registry of + case toSortedList registry of (e : _) -> title e `shouldBe` "Config B" [] -> expectationFailure "Expected non-empty registry"