Remove Yore.Repl and Yore.Index, only run indexer at 3 AM

src/Yore/DB.hs

@@ -98,44 +98,47 @@ newtype CountResult = CountResult
   }
   deriving (Show, Generic, Opium.FromRow)
 
-createDayIndex :: Day -> Opium.Connection -> IO (Either Opium.Error DayIndex)
+createDayIndex :: Day -> Opium.Connection -> ExceptT Error IO DayIndex
 createDayIndex date =
   ex runIdentity
     . Opium.fetch
       "INSERT INTO yore.day_index (day) VALUES ($1) RETURNING *"
       (Identity date)
 
-createDayFile :: Int -> Text -> FilePath -> Opium.Connection -> IO (Either Opium.Error ())
+createDayFile :: Int -> Text -> FilePath -> Opium.Connection -> ExceptT Error IO ()
 createDayFile dayId label path =
-  Opium.execute
-    "INSERT INTO yore.day_file (day_index_id, label, relative_path) VALUES ($1, $2, $3)"
-    (dayId, label, path)
+  lift
+    . Opium.execute
+      "INSERT INTO yore.day_file (day_index_id, label, relative_path) VALUES ($1, $2, $3)"
+      (dayId, label, path)
 
-readDayIndex :: Day -> Opium.Connection -> IO (Either Opium.Error (Maybe DayIndex))
+readDayIndex :: Day -> Opium.Connection -> ExceptT Error IO (Maybe DayIndex)
 readDayIndex date =
-  Opium.fetch
-    "SELECT * FROM yore.day_index WHERE day = $1"
-    (Identity date)
+  lift
+    . Opium.fetch
+      "SELECT * FROM yore.day_index WHERE day = $1"
+      (Identity date)
 
-readDayPaths :: Day -> Opium.Connection -> IO (Either Opium.Error [(DayIndex, DayFile)])
+readDayPaths :: Day -> Opium.Connection -> ExceptT Error IO [(DayIndex, DayFile)]
 readDayPaths date =
-  Opium.fetch
-    "SELECT * FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
-    (Identity date)
+  lift
+    . Opium.fetch
+      "SELECT * FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
+      (Identity date)
 
-getDayFileByIssue :: Day -> Int -> Opium.Connection -> IO (Either Opium.Error DayFile)
+getDayFileByIssue :: Day -> Int -> Opium.Connection -> ExceptT Error IO DayFile
 getDayFileByIssue date issue =
   ex runIdentity
     . Opium.fetch
       "SELECT yore.day_file.* FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1 ORDER BY day_file_id LIMIT 1 OFFSET $2"
       (date, issue)
 
-getNumberOfIssues :: Day -> Opium.Connection -> IO (Either Opium.Error Int)
+getNumberOfIssues :: Day -> Opium.Connection -> ExceptT Error IO Int
 getNumberOfIssues date =
   ex (count . runIdentity)
     . Opium.fetch
       "SELECT count(*) FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
       (Identity date)
 
-ex :: (a -> b) -> IO (Either e a) -> IO (Either e b)
-ex = fmap . fmap
+ex :: (a -> b) -> IO (Either Opium.Error a) -> ExceptT Error IO b
+ex f = fmap f . lift

src/Yore/Index.hs

@@ -1,21 +0,0 @@
-{-# LANGUAGE OverloadedRecordDot #-}
-
-module Yore.Index (createEntries) where
-
-import Control.Exception (Exception, throwIO)
-import Control.Monad (forM_)
-import Data.Text (Text)
-import Data.Time (Day)
-
-import qualified Database.PostgreSQL.Opium as Opium
-
-import qualified Yore.DB as DB
-
-createEntries :: Day -> [(Text, FilePath)] -> Opium.Connection -> IO ()
-createEntries date urls conn = do
-  dayIndex <- confidently $ DB.createDayIndex date conn
-  forM_ urls $ \(text, url) ->
-    confidently $ DB.createDayFile dayIndex.day_index_id text url conn
-
-confidently :: (Exception e) => IO (Either e a) -> IO a
-confidently action = action >>= either throwIO pure

src/Yore/Repl.hs

@@ -1,59 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Yore.Repl (connect, exec, getToday, indexDay, addYears) where
-
-import Control.Exception (bracket, throwIO)
-import Control.Monad (forM)
-import Data.Time (Day, getZonedTime, localDay, zonedTimeToLocalTime)
-import Text.Printf (printf)
-
-import qualified Database.PostgreSQL.Opium as Opium
-
-import Yore.DB (DayIndex)
-import Yore.Download (downloadInto)
-import Yore.Index (createEntries)
-import Yore.Scrape (Issue (..), getIssuesByDay)
-import Yore.Time (addYears)
-
-import qualified Yore.DB as DB
-
-connect :: IO Opium.Connection
-connect =
-  Opium.connect "host=localhost port=5433 user=yore-test" >>= \case
-    Left e -> error $ show e
-    Right c -> pure c
-
-exec :: (Opium.Connection -> IO a) -> IO a
-exec = bracket connect Opium.close
-
-getToday :: IO [Issue]
-getToday = do
-  now <- getZonedTime
-  print now
-  let currentDay = localDay $ zonedTimeToLocalTime now
-  case addYears (-100) currentDay of
-    Right then_ ->
-      getIssuesByDay then_
-    Left _ ->
-      pure []
-
-indexDay :: Day -> IO ()
-indexDay date = exec $ \conn -> do
-  either throwIO pure =<< Opium.execute_ "SELECT pg_advisory_lock(42);" conn
-  printf "Checking whether %s already exists...\n" (show date)
-  mbDi <- either throwIO pure =<< DB.readDayIndex date conn
-  case mbDi of
-    Just (_ :: DayIndex) ->
-      putStrLn "Nothing to do."
-    Nothing -> do
-      putStrLn "Retrieving URLs..."
-      issues <- getIssuesByDay date
-      paths <- forM issues $ \issue -> do
-        printf "Downloading %s...\n" issue.url
-        path <- downloadInto "./download" issue.url
-        pure (issue.label, path)
-      putStrLn "Creating DB entries..."
-      createEntries date paths conn
-      putStrLn "Done."

src/Yore/Schedule.hs

@@ -1,18 +1,19 @@
 module Yore.Schedule (schedule) where
 
+import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad (when)
-import Data.Time (ZonedTime, getZonedTime, secondsToNominalDiffTime, nominalDiffTimeToSeconds)
-import Control.Concurrent (threadDelay, forkIO)
+import Data.Functor (($>))
+import Data.Time (ZonedTime, getZonedTime, nominalDiffTimeToSeconds, secondsToNominalDiffTime)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 
-schedule :: (ZonedTime -> Bool) -> IO () -> IO ()
-schedule shouldRunAt f = everyMinute $ \now -> when (shouldRunAt now) f
+schedule :: (ZonedTime -> Bool) -> IO a -> IO ()
+schedule shouldRunAt f = everyMinute $ \now -> when (shouldRunAt now) (f $> ())
 
 everyMinute :: (ZonedTime -> IO ()) -> IO ()
 everyMinute f = do
   -- Use POSIX time to avoid having to handle leap seconds
   now <- getPOSIXTime
-  let posixSeconds :: Int 
+  let posixSeconds :: Int
       posixSeconds = floor $ nominalDiffTimeToSeconds now
       lastFullMinute = secondsToNominalDiffTime $ fromIntegral $ posixSeconds - posixSeconds `mod` 60
       secondsSinceLastFullMinute = now - lastFullMinute