save url table on exit
This commit is contained in:
parent
7fdfb25ce0
commit
7e1e95fa2a
@ -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
|
||||||
|
10
src/Main.hs
10
src/Main.hs
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user