59 lines
1.7 KiB
Haskell
59 lines
1.7 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Yore.Repl (connect, exec, getToday, indexDay, addYears) where
|
|
|
|
import Control.Exception (bracket, throwIO)
|
|
import Control.Monad (forM)
|
|
import Data.Text (Text)
|
|
import Data.Time (Day)
|
|
import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
|
|
import Text.Printf (printf)
|
|
|
|
import qualified Database.PostgreSQL.Opium as Opium
|
|
|
|
import Yore.DB (DayIndex)
|
|
import Yore.Download (downloadInto, getUrls)
|
|
import Yore.Index (createEntries)
|
|
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 [(Text, Text)]
|
|
getToday = do
|
|
now <- getZonedTime
|
|
print now
|
|
let currentDay = localDay $ zonedTimeToLocalTime now
|
|
case addYears (-100) currentDay of
|
|
Just then_ ->
|
|
getUrls then_
|
|
Nothing ->
|
|
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..."
|
|
urls <- getUrls date
|
|
paths <- forM urls $ \(text, url) -> do
|
|
printf "Downloading %s...\n" url
|
|
(text,) <$> downloadInto "./download" url
|
|
putStrLn "Creating DB entries..."
|
|
createEntries date paths conn
|
|
putStrLn "Done."
|