From 44d43c706a985d0e91586ad01930661dc069a146 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Thu, 5 Nov 2020 17:29:54 +0100
Subject: [PATCH] chore: have db-fill use modification times for changelog

---
 src/Utils/DB.hs       | 14 ++++++++++++++
 test/Database/Fill.hs | 19 +++++++++++++++++++
 2 files changed, 33 insertions(+)

diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs
index 6847ea0cf..d7dfcc3b9 100644
--- a/src/Utils/DB.hs
+++ b/src/Utils/DB.hs
@@ -139,3 +139,17 @@ put :: ( MonadIO m
 put v = do
   forM_ (persistUniqueKeys v) deleteBy
   insert v
+
+selectMaybe :: forall record backend m.
+               ( MonadIO m
+               , PersistQueryRead backend
+               , PersistRecordBackend record backend
+               )
+            => [Filter record] -> [SelectOpt record]
+            -> ReaderT backend m (Maybe (Entity record))
+selectMaybe fltrs opts = listToMaybe <$> selectList fltrs (LimitTo 1 : opts')
+  where opts' = filter (not . isLimit) opts
+        isLimit = \case
+          LimitTo _ -> True
+          _other    -> False
+  
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index bb0b65c50..8139235f4 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -31,6 +31,9 @@ import Data.List (genericLength)
 
 import qualified Data.Conduit.Combinators as C
 
+import System.Directory (getModificationTime)
+import System.FilePath.Glob (glob)
+
 
 testdataDir :: FilePath
 testdataDir = "testdata"
@@ -1283,3 +1286,19 @@ fillDb = do
         _other -> return mempty
   
   liftIO . LBS.writeFile (testdataDir </> "bigAlloc_ordinal.csv") $ Csv.encode ordinalPriorities
+
+  forM_ universeF $ \changelogItem -> do
+    let ptn = "templates/i18n/changelog/" <> unpack (toPathPiece changelogItem) <> ".*"
+    files <- liftIO $ glob ptn
+    mTime <- fmap minimum . fromNullable <$> mapM (liftIO . getModificationTime) files
+    whenIsJust mTime $ \(utctDay -> firstSeen) -> do
+      oldFirstSeen <- selectMaybe [ ChangelogItemFirstSeenItem ==. changelogItem ] [ Asc ChangelogItemFirstSeenFirstSeen ]
+      case oldFirstSeen of
+        Just (Entity firstSeenId oldEntry)
+          | changelogItemFirstSeenFirstSeen oldEntry > firstSeen
+            -> update firstSeenId [ ChangelogItemFirstSeenFirstSeen =. firstSeen ]
+        Just _
+            -> return ()
+        Nothing
+            -> insert_ $ ChangelogItemFirstSeen changelogItem firstSeen
+