save url table on exit

master
Michele Guerini Rocco 2019-11-06 21:33:03 +01:00
parent 7fdfb25ce0
commit 7e1e95fa2a
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
2 changed files with 21 additions and 8 deletions

View File

@ -5,6 +5,7 @@ to store the URLs in memory and on disk.
module Breve.UrlTable module Breve.UrlTable
( UrlTable ( UrlTable
, load , load
, save
, insert , insert
, extract , extract
) where ) where
@ -19,20 +20,26 @@ import qualified Data.HashTable.IO as H
-- | The hash table that stores URLs -- | The hash table that stores URLs
type UrlTable = H.CuckooHashTable Name Url type UrlTable = H.CuckooHashTable Name Url
-- | Periodically writes a 'UrlTable' to a file -- | Periodically save a 'UrlTable' to a file
--
-- The table is stored in a text file
-- as Haskell code for semplicity.
sync :: UrlTable -> FilePath -> IO () sync :: UrlTable -> FilePath -> IO ()
sync table file = forever $ do sync table file = forever $ do
threadDelay (round 3.0e8) threadDelay (round 3.0e8)
save table file
-- | Writes a 'UrlTable' to a file
--
-- The table is stored in a text file
-- as Haskell code for semplicity.
save :: UrlTable -> FilePath -> IO ()
save table file = do
content <- show <$> H.toList table content <- show <$> H.toList table
writeFile file content writeFile file content
putStrLn "\n[breve] url table synced."
-- | Loads a URL table from a file -- | Loads a URL table from a file
-- --
-- The format should be the same one used -- Once the file is loaded it will be synced
-- by the 'sync' function. -- periodically (every 5min) on the disk.
load :: FilePath -> IO UrlTable load :: FilePath -> IO UrlTable
load file = do load file = do
content <- readFile file content <- readFile file

View File

@ -20,6 +20,7 @@ import Data.Maybe (listToMaybe)
-- IO -- IO
import Control.Monad (when, void) import Control.Monad (when, void)
import Control.Exception as E
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
import System.Environment (getArgs) import System.Environment (getArgs)
import Data.Text.IO as T import Data.Text.IO as T
@ -61,9 +62,14 @@ main = do
when (bindPort == 443) $ void $ when (bindPort == 443) $ void $
forkIO (run 80 $ forceSSL emptyApp) forkIO (run 80 $ forceSSL emptyApp)
-- Save the table just before exiting
let exit E.UserInterrupt = save table urlTable
exit e = throwIO e
-- Middlewares are functions (Application -> Application). -- Middlewares are functions (Application -> Application).
-- We use one here to add requests -- We use one here to add requests
let middlewares = logStdout let middlewares = logStdout
T.putStrLn ("Serving on " <> bindUrl) handle exit $ do
runApp config (middlewares $ breve static bindUrl table) T.putStrLn ("Serving on " <> bindUrl)
runApp config (middlewares $ breve static bindUrl table)