wip, issues pages

fixme-new/app/FixmeMain.hs

@@ -1,73 +1,8 @@
 module Main where
 
-import Fixme
--- import Fixme.Run
 import Fixme.Run
-import System.Environment
-
--- TODO: fixme-new
---   $author: Dmitry Zuikov <dzuikov@gmail.com>
---   $milestone: undefined
---   $priority: ASAP
---  после майских:
---  1.  fixme переезжает в дерево hbs2, конкретно в hbs2-git
-
---  2.  fixme преобразуется в утилиту для генерации отчётов по репозиторию git
---
---  3.  fixme генерирует поток фактов про репозиторий git, включая записи todo/fixme
---
---  4.  fixme начинает генерировать PR-ы в формате git (у гита есть простенькие пулл-реквесты!)
---      и умеет постить их куда там их следует постить
---
---  5.  fixme получает ограничитель глубины сканирования и фильтр бранчей,
---      что бы не окочуриваться на больших проектах
---
---  6.  fixme генерирует настройки по умолчанию, включая .gitignore
---
---  7.  fixme позволяет явно задавать лог изменений статуса, беря его как из
---      .fixme/log так и откуда скажут
---
---  8.  fixme интегрируется в hbs2-git-dashboard
---
---  9.  fixme временно получает название fixme2 или nfixme или hfixme (не решил пока),
---      потом возвращается к старому названию
---
---  10. fixme умеет постить записи в своём формате в hbs2 или же умеет любые источники дампить в своём формате так,
---        что бы hbs2-git мог запостить их в соответствующий рефчан
---
---  11. fixme оформляет либу для экстракции фактов из git, которую будет использовать и hbs2-git-dashboard
---
---  12. hbs2-git-dashboard понимает и уважает каталог настроек .fixme , а стейт берёт прямо оттуда
-
---  открытые вопросы:
-
---  hbs2-git использует fixme или fixme использует hbs2
-
---  переводить fixme на fuzzy-parse или нет (скорее, да)
-
---  переводить ли suckless-conf на fuzzy-parse сейчас (или хрен пока с ним)
-
---  встроить ли jq внутрь или лучше дать доступ к sql запросам по json
 
 main :: IO ()
 main = do
-
-  -- TODO: discover-config
-  --
-  -- TODO: local-config-has-same-name-with-binary
-  --
-  -- TODO: per-user-config-has-same-name-with-binary
-  --
-  -- TODO: per-user-config-added-after-per-project-config
-
-  -- TODO: scan-all-sources
-  --   for-source-from-con
-
   runFixmeCLI runCLI
 
--- FIXME: test-fixme
---   $workflow: wip
---   $assigned: voidlizard
---
---   Тестовый тикет с параметрами
-

fixme-new/lib/Fixme/State.hs

@@ -6,6 +6,7 @@ module Fixme.State
   , withState
   , cleanupDatabase
   , listFixme
+  , countFixme
   , insertFixme
   , insertFixmeExported
   , modifyFixme
@@ -319,6 +320,28 @@ selectFixmeKey s = do
 sqliteToAeson :: FromJSON a => Text -> Maybe a
 sqliteToAeson = Aeson.decode . LBS.fromStrict . Text.encodeUtf8
 
+
+countFixme :: (FixmePerks m, MonadReader FixmeEnv m) => m Int
+countFixme = do
+
+  let present = [qc|coalesce(json_extract(s1.blob, '$.deleted'),'false') <> 'true' |] :: String
+
+  let sql = [qc|
+    with s1 as (
+      select cast (json_insert(json_group_object(o.k, o.v), '$.w', max(o.w)) as text) as blob
+      from object o
+      group by o.o
+    )
+    select count(s1.blob) from s1
+    where
+      {present}
+    |]
+
+  debug $ pretty sql
+
+  withState $ select_ @_ @(Only Int) sql
+    <&> maybe 0 fromOnly . headMay
+
 listFixme :: (FixmePerks m, MonadReader FixmeEnv m, HasPredicate q)
           => q
           -> m [Fixme]

hbs2-git-dashboard/app/GitDashBoard.hs

@@ -23,6 +23,7 @@ import HBS2.Git.DashBoard.State.Index
 import HBS2.Git.DashBoard.State.Commits
 import HBS2.Git.DashBoard.Types
 import HBS2.Git.DashBoard.Fixme
+import HBS2.Git.DashBoard.Manifest
 import HBS2.Git.Web.Html.Root
 
 import HBS2.Peer.CLI.Detect
@@ -230,16 +231,8 @@ runDashboardWeb WebOptions{..} = do
     lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic)
     flip runContT pure do
       lww <- lwws' & orFall (status status404)
-
+      TopInfoBlock{..} <- getTopInfoBlock lww
-      item <- lift (selectRepoList ( mempty
+      lift $ html (LT.fromStrict manifest)
-                                      & set repoListByLww (Just lww)
-                                      & set repoListLimit (Just 1))
-                                   )
-                 <&> listToMaybe
-                 >>= orFall (status status404)
-
-      lift $ html =<< renderTextT (thisRepoManifest item)
-
 
   get (routePattern (RepoRefs "lww")) do
     lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic)
@@ -299,6 +292,12 @@ runDashboardWeb WebOptions{..} = do
       lift $ renderHtml (repoForks lww)
       -- lift $ renderHtml (toHtml $ show $ pretty lww)
 
+  get (routePattern (RepoFixmeHtmx "lww")) do
+    lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic)
+    flip runContT pure do
+      lww   <- lwws' & orFall (status status404)
+      lift $ renderHtml (repoFixme lww)
+
   get (routePattern (RepoCommits "lww")) do
     lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic)
 
@@ -602,15 +601,21 @@ theDict = do
 
       entry $ bindMatch "debug:test-with-fixme" $ nil_ $ \case
         [SignPubKeyLike s] -> lift do
-           r <- runInFixme (RepoLww (LWWRefKey s)) (listFixme ())
+           r <- listFixme (RepoLww (LWWRefKey s)) ()
-                    & try @_ @SomeException
-                    >>= orThrowPassIO
-
            for_ r $ \f -> do
               liftIO $ print $ pretty f
 
         _ -> throwIO $ BadFormException @C nil
 
+      entry $ bindMatch "debug:count-fixme" $ nil_ $ \case
+        [SignPubKeyLike s] -> lift do
+           r <- countFixme (RepoLww (LWWRefKey s))
+           liftIO $ print $ pretty r
+
+        _ -> throwIO $ BadFormException @C nil
+
+
+
 main :: IO ()
 main = do
   argz <- getArgs

hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/Fixme.hs

@@ -1,9 +1,18 @@
 module HBS2.Git.DashBoard.Fixme
-  ( F.listFixme
+  ( F.HasPredicate(..)
-  , F.HasPredicate(..)
   , F.SelectPredicate(..)
   , runInFixme
+  , countFixme
+  , listFixme
   , RunInFixmeError(..)
+  , Fixme(..)
+  , FixmeKey(..)
+  , FixmeTitle(..)
+  , FixmeTag(..)
+  , FixmePlainLine(..)
+  , FixmeAttrName(..)
+  , FixmeAttrVal(..)
+  , FixmeOpts(..)
   ) where
 
 import HBS2.Git.DashBoard.Prelude
@@ -13,11 +22,13 @@ import HBS2.Git.DashBoard.State
 import HBS2.OrDie
 
 import Fixme.State qualified as F
+import Fixme.State (HasPredicate(..))
 import Fixme.Types
 import Fixme.Config
 
-import DBPipe.SQLite (withDB, shutdown)
+import DBPipe.SQLite (shutdown)
 
+import Data.Either
 import Data.Generics.Product.Fields (field)
 
 data RunInFixmeError =
@@ -49,9 +60,6 @@ runInFixme repo m = do
   let fenvNew  = fenv & set (field @"fixmeEnvWorkDir") twd
                       & set (field @"fixmeEnvOpts") fo
 
-  -- TODO: close-fixme-database-garanteed
-  --  похоже, что надо будет фиксить db-pipe
-
   flip runContT pure do
     dbe <- lift $ withFixmeEnv fenvNew $ F.withState ask
 
@@ -67,4 +75,16 @@ runInFixme repo m = do
 
       m
 
+listFixme :: (DashBoardPerks m, MonadReader DashBoardEnv m, HasPredicate q) => RepoLww -> q -> m [Fixme]
+listFixme repo q = do
+  runInFixme repo $ F.listFixme q
+    & try @_ @RunInFixmeError
+    <&> fromRight mempty
+
+countFixme :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoLww -> m (Maybe Int)
+countFixme repo = do
+  runInFixme repo $ F.countFixme
+    & try @_ @RunInFixmeError
+    <&> either (const Nothing) Just
+
 

hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State.hs

@@ -156,7 +156,7 @@ newtype RepoHeadTx = RepoHeadTx HashRef
 
 newtype RepoName = RepoName Text
                    deriving stock (Eq,Show,Generic)
-                   deriving newtype (ToField,FromField,ToHtml,IsString)
+                   deriving newtype (ToField,FromField,ToHtml,IsString,Pretty)
 
 newtype RepoBrief = RepoBrief Text
                    deriving stock (Generic)
@@ -172,7 +172,7 @@ newtype RepoCommitsNum = RepoCommitsNum Int
                          deriving newtype (ToField,FromField,Show,Pretty)
 
 newtype RepoLww = RepoLww (LWWRefKey 'HBS2Basic)
-                  deriving stock (Generic)
+                  deriving stock (Generic,Ord,Eq)
                   deriving newtype (ToField,FromField,Pretty)
 
 instance Show RepoLww where

hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Root.hs

@@ -9,6 +9,7 @@ import HBS2.Git.DashBoard.Types
 import HBS2.Git.DashBoard.State
 import HBS2.Git.DashBoard.State.Commits
 import HBS2.Git.DashBoard.Manifest
+import HBS2.Git.DashBoard.Fixme as Fixme
 
 import HBS2.OrDie
 
@@ -67,6 +68,7 @@ data RepoListPage = RepoListPage
 data RepoPageTabs =  CommitsTab (Maybe GitHash)
                    | ManifestTab
                    | TreeTab (Maybe GitHash)
+                   | IssuesTab
                    | ForksTab
                     deriving stock (Eq,Ord,Show)
 
@@ -88,6 +90,8 @@ newtype RepoManifest repo = RepoManifest repo
 
 newtype RepoCommits repo = RepoCommits repo
 
+newtype RepoFixmeHtmx repo = RepoFixmeHtmx repo
+
 data RepoCommitsQ repo off lim = RepoCommitsQ repo off lim
 
 data RepoCommitDefault repo commit = RepoCommitDefault repo commit
@@ -115,6 +119,7 @@ instance Pretty RepoPageTabs where
     ManifestTab{}  -> "manifest"
     TreeTab{}      -> "tree"
     ForksTab{}     -> "forks"
+    IssuesTab{}    -> "issues"
 
 instance FromStringMaybe RepoPageTabs where
   fromStringMay = \case
@@ -122,6 +127,7 @@ instance FromStringMaybe RepoPageTabs where
     "manifest" -> pure ManifestTab
     "tree"     -> pure (TreeTab Nothing)
     "forks"    -> pure ForksTab
+    "issues"   -> pure IssuesTab
     _          -> pure (CommitsTab Nothing)
 
 instance ToRoutePattern RepoListPage where
@@ -256,10 +262,20 @@ instance ToURL (RepoForksHtmx (LWWRefKey 'HBS2Basic))  where
     where
       repo = show $ pretty k
 
+instance ToRoutePattern (RepoFixmeHtmx String) where
+  routePattern (RepoFixmeHtmx r) =
+    path ["/", "htmx", "fixme", toArg r] & toPattern
+
+instance ToURL (RepoFixmeHtmx RepoLww)  where
+  toURL (RepoFixmeHtmx k) = path ["/", "htmx", "fixme", repo]
+    where
+      repo = show $ pretty k
+
 instance ToRoutePattern (RepoForksHtmx String) where
   routePattern (RepoForksHtmx r) =
     path ["/", "htmx", "forks", toArg r] & toPattern
 
+
 myCss :: Monad m => HtmlT m ()
 myCss = do
   link_ [rel_ "stylesheet", href_ (path ["css/custom.css"])]
@@ -422,10 +438,10 @@ parsedManifest RepoListItem{..} = do
     Just x  -> parseManifest (snd x)
     Nothing -> pure (mempty, coerce rlRepoBrief)
 
-thisRepoManifest :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoListItem -> HtmlT m ()
+thisRepoManifest :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoHead -> HtmlT m ()
-thisRepoManifest it@RepoListItem{..} = do
+thisRepoManifest rh = do
-  (_, manifest) <- lift $ parsedManifest it
+  (_, man) <- lift $ parseManifest rh
-  toHtmlRaw (renderMarkdown' manifest)
+  toHtmlRaw (renderMarkdown' man)
 
 repoRefs :: (DashBoardPerks m, MonadReader DashBoardEnv m)
          => LWWRefKey 'HBS2Basic
@@ -885,49 +901,60 @@ instance ToHtml (ShortRef (LWWRefKey 'HBS2Basic)) where
   toHtmlRaw (ShortRef a) = toHtml (shortRef 14 3 (show $ pretty a))
 
 
-repoPage :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m)
+newtype H a = H a
-         => RepoPageTabs
+
-         -> LWWRefKey 'HBS2Basic
+instance ToHtml (H FixmeKey) where
-         -> [(Text,Text)]
+  toHtmlRaw (H k) = toHtmlRaw $ take 10 $ show $ pretty k
+  toHtml (H k)    = toHtml    $ take 10 $ show $ pretty k
+
+instance ToHtml (H FixmeTag) where
+  toHtmlRaw (H k) = toHtmlRaw $ coerce @_ @Text k
+  toHtml (H k)    = toHtml    $ coerce @_ @Text k
+
+instance ToHtml (H FixmeTitle) where
+  toHtmlRaw (H k) = toHtmlRaw $ coerce @_ @Text k
+  toHtml (H k)    = toHtml    $ coerce @_ @Text k
+
+repoFixme :: (MonadReader DashBoardEnv m, DashBoardPerks m) => LWWRefKey HBS2Basic -> HtmlT m ()
+repoFixme lww = do
+
+  fme <- lift $ listFixme (RepoLww lww) ()
+
+  table_ [] do
+    for_ fme $ \fixme -> do
+      tr_ [class_ "commit-brief-title"] $ do
+        td_ [class_ "mono", width_ "10"] do
+           a_ [] $ toHtml (H $ fixmeKey fixme)
+        td_ [width_ "10"] do
+           strong_ [] $ toHtml (H $ fixmeTag fixme)
+        td_ [] do
+           toHtml (H $ fixmeTitle fixme)
+      tr_ [class_ "commit-brief-details"] $ do
+        td_ [colspan_ "3"] do
+          small_ "seconday shit"
+
+
+data TopInfoBlock =
+  TopInfoBlock
+  { author      :: Maybe Text
+  , public      :: Maybe Text
+  , forksNum    :: RepoForks
+  , commitsNum  :: RepoCommitsNum
+  , manifest    :: Text
+  , fixme       :: Maybe MyRefChan
+  , fixmeCnt    :: Int
+  , pinned      :: [(Text, Syntax C)]
+  , repoHeadRef :: RepoHeadRef
+  , repoHead    :: Maybe RepoHead
+  , repoName    :: RepoName
+  }
+
+repoTopInfoBlock :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m)
+                 => LWWRefKey 'HBS2Basic
+                 -> TopInfoBlock
                  -> HtmlT m ()
-repoPage tab lww params = rootPage do
-
-  it@RepoListItem{..} <- lift (selectRepoList ( mempty
-                                  & set repoListByLww (Just lww)
-                                  & set repoListLimit (Just 1))
-                               <&> listToMaybe
-                              ) >>= orThrow (itemNotFound lww)
-
-  sto <- asks _sto
-  mhead <- lift $ readRepoHeadFromTx sto (coerce rlRepoTx)
-
-  let mbHead = snd <$> mhead
-
-  (meta, manifest) <- lift $ parsedManifest it
-
-  let author = headMay [ s | ListVal [ SymbolVal "author:", LitStrVal s ] <- meta ]
-  let public = headMay [ s | ListVal [ SymbolVal "public:", SymbolVal (Id s) ] <- meta ]
-  let pinned = [ (name,r) | ListVal [ SymbolVal "pinned:", r@(PinnedRefBlob _ name _) ] <- meta ] & take 5
-
-  allowed <- lift $ checkFixmeAllowed (RepoLww lww)
-  let fixme  = headMay [ x | allowed, FixmeRefChanP x <- meta ]
-
-  debug $ red "META" <+> pretty meta
-
-  main_ [class_ "container-fluid"] do
-    div_ [class_ "wrapper"] do
-      aside_ [class_ "sidebar"] do
-
-        div_ [class_ "info-block" ] do
-          let url = toURL (RepoPage (CommitsTab Nothing) lww)
-          let txt = toHtml (ShortRef lww)
-          a_ [href_ url, class_ "secondary"] txt
-
-        -- div_ [class_ "info-block" ] do
-        --   a_ [ href_ "/"] do
-        --     span_ [class_ "inline-icon-wrapper"] $ svgIcon IconArrowUturnLeft
-        --     "back to projects"
 
+repoTopInfoBlock lww TopInfoBlock{..} = do
   div_ [class_ "info-block" ] do
 
     summary_ [class_ "sidebar-title"] $ small_ $ strong_ "About"
@@ -950,11 +977,13 @@ repoPage tab lww params = rootPage do
 
       for_ fixme $ \_ -> do
         li_ $ small_ do
-                a_ [class_ "secondary"] do
+          a_ [ class_ "secondary"
+             , href_ (toURL (RepoPage IssuesTab lww)) ] do
             span_ [class_ "inline-icon-wrapper"] $ svgIcon IconFixme
+            toHtml $ show fixmeCnt
             " Issues"
 
-            when (rlRepoForks > 0) do
+      when (forksNum > 0) do
         li_ $ small_ do
           a_ [class_ "secondary"
             , href_ "#"
@@ -962,7 +991,7 @@ repoPage tab lww params = rootPage do
             , hxTarget_ "#repo-tab-data"
             ] do
               span_ [class_ "inline-icon-wrapper"] $ svgIcon IconGitFork
-                    toHtml $ show rlRepoForks
+              toHtml $ show forksNum
               " forks"
 
       li_ $ small_ do
@@ -970,7 +999,7 @@ repoPage tab lww params = rootPage do
           , href_ (toURL (RepoPage (CommitsTab Nothing) lww))
           ] do
           span_ [class_ "inline-icon-wrapper"] $ svgIcon IconGitCommit
-                toHtml $ show rlRepoCommits
+          toHtml $ show commitsNum
           " commits"
 
       for_ pinned $ \(_,ref) ->  do
@@ -986,7 +1015,112 @@ repoPage tab lww params = rootPage do
                   " "
                   toHtml $ ShortRef hash
 
-        for_ mbHead $ \rh -> do
+
+getTopInfoBlock lww = do
+
+  it@RepoListItem{..} <- lift (selectRepoList ( mempty
+                                  & set repoListByLww (Just lww)
+                                  & set repoListLimit (Just 1))
+                               <&> listToMaybe
+                              ) >>= orThrow (itemNotFound lww)
+
+  sto <- asks _sto
+  mhead <- lift $ readRepoHeadFromTx sto (coerce rlRepoTx)
+
+  let repoHead = snd <$> mhead
+
+  (meta, manifest) <- lift $ parsedManifest it
+
+  let author = headMay [ s | ListVal [ SymbolVal "author:", LitStrVal s ] <- meta ]
+  let public = headMay [ s | ListVal [ SymbolVal "public:", SymbolVal (Id s) ] <- meta ]
+  let pinned = [ (name,r) | ListVal [ SymbolVal "pinned:", r@(PinnedRefBlob _ name _) ] <- meta ] & take 5
+
+  allowed <- lift $ checkFixmeAllowed (RepoLww lww)
+  let fixme  = headMay [ x | allowed, FixmeRefChanP x <- meta ]
+
+  fixmeCnt <- lift (Fixme.countFixme (RepoLww lww))
+                 <&> fromMaybe 0
+
+  let forksNum = rlRepoForks
+  let commitsNum = rlRepoCommits
+  let repoHeadRef = rlRepoHead
+  let repoName = rlRepoName
+
+  pure $ TopInfoBlock{..}
+
+repoPage :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m)
+         => RepoPageTabs
+         -> LWWRefKey 'HBS2Basic
+         -> [(Text,Text)]
+         -> HtmlT m ()
+
+repoPage IssuesTab lww _ = rootPage do
+
+  topInfoBlock@TopInfoBlock{..} <- getTopInfoBlock lww
+
+  main_ [class_ "container-fluid"] do
+    div_ [class_ "wrapper"] do
+      aside_ [class_ "sidebar"] do
+
+        div_ [class_ "info-block" ] do
+          let url = toURL (RepoPage (CommitsTab Nothing) lww)
+          let txt = toHtml (ShortRef lww)
+          a_ [href_ url, class_ "secondary"] txt
+
+        repoTopInfoBlock lww topInfoBlock
+
+      div_ [class_ "content"] $ do
+
+        -- article_ [class_ "py-0"] $ nav_ [ariaLabel_ "breadcrumb", class_ "repo-menu"] $ ul_ do
+
+        --   let menuTabClasses isActive = if isActive then "tab contrast" else "tab"
+        --       menuTab t misc name = li_ do
+        --         a_ ([class_ $ menuTabClasses $ isActiveTab tab t] <> misc <> [tabClick]) do
+        --           name
+
+        --   menuTab (CommitsTab Nothing)
+        --                  [ href_ "#"
+        --                  , hxGet_ (toURL (RepoCommits lww))
+        --                  , hxTarget_ "#repo-tab-data"
+        --                  ] "commits"
+
+        --   menuTab (TreeTab Nothing)
+        --               [ href_ "#"
+        --               , hxGet_ (toURL (RepoRefs lww))
+        --               , hxTarget_ "#repo-tab-data"
+        --               ] "tree"
+
+        section_ do
+          strong_ $ toHtml (show $ "Issues ::" <+> pretty repoName)
+
+        div_ [ id_ "repo-tab-data"
+             , hxTrigger_ "load"
+             , hxTarget_ "#repo-tab-data"
+             , hxGet_ (toURL (RepoFixmeHtmx (RepoLww lww)))
+             ] do
+          pure ()
+
+        div_ [id_ "repo-tab-data-embedded"] mempty
+
+
+repoPage tab lww params = rootPage do
+
+  sto <- asks _sto
+
+  topInfoBlock@TopInfoBlock{..} <- getTopInfoBlock lww
+
+  main_ [class_ "container-fluid"] do
+    div_ [class_ "wrapper"] do
+      aside_ [class_ "sidebar"] do
+
+        div_ [class_ "info-block" ] do
+          let url = toURL (RepoPage (CommitsTab Nothing) lww)
+          let txt = toHtml (ShortRef lww)
+          a_ [href_ url, class_ "secondary"] txt
+
+        repoTopInfoBlock lww topInfoBlock
+
+        for_ repoHead $ \rh -> do
 
           let theHead = headMay [ v | (GitRef "HEAD", v) <- view repoHeadRefs rh ]
 
@@ -1031,7 +1165,7 @@ repoPage tab lww params = rootPage do
                       ] "tree"
 
         section_ do
-          strong_ $ toHtml rlRepoName
+          strong_ $ toHtml repoName
 
         div_ [id_ "repo-tab-data"] do
 
@@ -1046,7 +1180,7 @@ repoPage tab lww params = rootPage do
               maybe (repoRefs lww) (\t -> repoTree lww t t) tree
 
             ManifestTab -> do
-              thisRepoManifest it
+              for_ repoHead $ thisRepoManifest
 
             CommitsTab{} -> do
               let predicate = Right (fromQueryParams params)

hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs

@@ -52,11 +52,13 @@ newtype LWWRefKey s =
   }
   deriving stock (Generic)
 
-
 instance RefMetaData (LWWRefKey s)
 
 deriving stock instance IsRefPubKey s => Eq (LWWRefKey s)
 
+instance IsRefPubKey s => Ord (LWWRefKey s) where
+  compare a b = compare (serialise a) (serialise b)
+
 instance IsRefPubKey e => Serialise (LWWRefKey e)
 
 instance IsRefPubKey s => Hashable (LWWRefKey s) where