breve 0.0.2.2 → 0.0.3.0

raw patch · 6 files changed

+107/−46 lines, 6 filesdep +directorydep +tconfigdep +xdg-basedir

Dependencies added: directory, tconfig, xdg-basedir

Files

• README.md +16/−2
• breve.cabal +6/−7
• src/Application.hs +10/−10
• src/Breve/Common.hs +48/−17
• src/Breve/UrlTable.hs +23/−6
• src/Main.hs +4/−4

@@ -9,7 +9,7 @@  It was inspired by [hastebin](http://hastebin.com). -## Installing the app+## Installing  Install the app with cabal-install. Run @@ -21,7 +21,21 @@  The app will start serving on `http://localhost:3000`, listening on every active interface. -You can change the port and set a hostname via the `PORT` and `HOSTNAME` environment variables.+## Configure++You can change the options by editing the config file.+When you start the app an empty one will be created in:+`$XDG_CONFIG_HOME/breve` or `~/.config/breve` if unset.++The default values are:++```ini+hostname localhost+port     3000+urltable $XDG_CONFIG_HOME/breve+```++`urltable` is the location of breve url hashtable  ## License 

@@ -1,5 +1,5 @@ name:                breve-version:             0.0.2.2+version:             0.0.3.0 synopsis:            a url shortener description: @@ -29,10 +29,9 @@   other-modules:     Application, Breve.Common,                      Breve.Generator, Breve.UrlTable   other-extensions:  OverloadedStrings-  build-depends:     base ==4.*, simple >= 0.8.0,-                     wai ==2.*, wai-extra ==2.*, warp ==2.1.*,-                     aeson ==0.8.*, bytestring ==0.10.*,-                     transformers ==0.3.*, mtl ==2.1.*,-                     hashtables ==1.2.*, cryptohash ==0.11.*,-                     binary ==0.7.*, random ==1.1.*+  build-depends:     base ==4.*, simple >= 0.8.0, wai ==2.*, wai-extra ==2.*,+                     warp ==2.1.*, aeson ==0.8.*, bytestring ==0.10.*,+                     transformers ==0.3.*, mtl ==2.1.*, hashtables ==1.2.*,+                     cryptohash ==0.11.*, binary ==0.7.*, random ==1.1.*,+                     xdg-basedir ==0.2.*, tconfig ==0.5.*, directory ==1.2.*   ghc-options:       -threaded -O2

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Application where  import Breve.Common@@ -21,17 +21,17 @@  app :: (Application -> IO ()) -> IO () app runner = do-  settings    <- newAppSettings-  (baseUrl,_) <- serverSettings-  table       <- records+  settings            <- newAppSettings+  ServerSettings {..} <- newServerSettings+  table               <- load urlTable -  cssPath   <- getDataFileName "layouts/main.css"-  indexPath <- getDataFileName "views/index.html"-  donePath  <- getDataFileName "views/done.html"+  css   <- getDataFileName "layouts/main.css"+  index <- getDataFileName "views/index.html"+  done  <- getDataFileName "views/done.html"    runner $ controllerApp settings $ do-    get "/" (render indexPath ())-    get "/main.css" (serveStatic cssPath)+    get "/" (render index ())+    get "/main.css" (serveStatic css)      get "/:word" $ do       word <- queryParam' "word"@@ -48,5 +48,5 @@         Just url -> do           word <- liftIO (insert table url)           logStr (printf "Registered %s -> %s " url word)-          render donePath $ object ["link" .= (baseUrl ++ word)]+          render done $ object ["link" .= (bindUrl ++ word)]         Nothing  -> respond badRequest

@@ -1,32 +1,63 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Breve.Common where -import Paths_breve            (getDataFileName)+import Paths_breve                     (getDataFileName)  import Control.Applicative-import Control.Monad.IO.Class (liftIO)-import Text.Printf            (printf)-import System.Environment     (lookupEnv)+import Control.Monad.IO.Class          (liftIO)+import Text.Printf                     (printf)+import System.Environment              (lookupEnv)+import System.Environment.XDG.BaseDir+import System.Directory                (doesFileExist)+import Data.TConfig  import Web.Simple.Templates import Network.Wai.Handler.Warp -data AppSettings = AppSettings { }--serverSettings :: IO (String, Settings)-serverSettings = do-  port <- maybe  3000       read <$> lookupEnv "PORT"-  host <- maybe "localhost" id   <$> lookupEnv "HOSTNAME"-  let opts = setPort port defaultSettings-      url  = if port == 80-             then printf "http://%s/"    host-             else printf "http://%s:%d/" host port-  return (url, opts)+data ServerSettings = ServerSettings+  { bindPort     :: Int+  , bindHostname :: String+  , bindUrl      :: String+  , urlTable     :: FilePath+  , warpSettings :: Settings+  } -newAppSettings :: IO AppSettings-newAppSettings = return AppSettings+data AppSettings = AppSettings {}  instance HasTemplates IO AppSettings where   defaultLayout = do     main <- liftIO (getDataFileName "layouts/main.html")     Just <$> getTemplate main+++newAppSettings :: IO AppSettings+newAppSettings = return AppSettings++createEmptyIfMissing :: FilePath -> IO FilePath+createEmptyIfMissing file = do+  exists <- doesFileExist file+  if not exists+    then writeFile file "" >> return file+    else return file++newServerSettings :: IO ServerSettings+newServerSettings = do+  urlsPath   <- getUserDataFile   "breve" ""+  configPath <- getUserConfigFile "breve" ""+  +  config <- readConfig =<< createEmptyIfMissing configPath+  let host = maybe "localhost" id   (getValue "hostname" config)+      port = maybe 3000        read (getValue "port"     config)+      urls = maybe urlsPath    id   (getValue "urltable" config)++  createEmptyIfMissing urls++  return ServerSettings+    { bindPort     = port+    , bindHostname = host+    , bindUrl      = if port == 80+                       then printf "http://%s/"    host+                       else printf "http://%s:%d/" host port+    , urlTable     = urls+    , warpSettings = setPort port defaultSettings+    }

@@ -1,24 +1,41 @@ module Breve.UrlTable ( UrlTable-, records+, load , insert , extract ) where  import Breve.Generator++import Control.Monad       (forever)+import Control.Concurrent  (forkIO, threadDelay)+import Text.Read           (readMaybe) import qualified Data.HashTable.IO as H  type UrlTable = H.CuckooHashTable Word Url ---Empty url hash table-records :: IO UrlTable-records = H.new+-- Periodically write a url table to a file+sync :: UrlTable -> FilePath -> IO ()+sync table file = forever $ do+  threadDelay (round 3.0e8)+  content <- fmap show (H.toList table)+  writeFile file content --- Insert the url in the table and return the word+-- Load a url table from a file+load :: FilePath -> IO UrlTable+load file = do+  content <- readFile file+  table <- case readMaybe content of+    Just list -> H.fromList list+    Nothing   -> H.new+  forkIO (sync table file)+  return table++-- Insert the url in a table and return the word insert :: UrlTable -> Url -> IO Word insert table url = H.insert table new url >> return new   where new = wordID url --- Lookup the table for the associated url+-- Lookup a table for the associated url extract :: UrlTable -> Word -> IO (Maybe Url) extract = H.lookup

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}  import Application import Breve.Common@@ -9,6 +9,6 @@  main :: IO () main = do-  (url, settings) <- serverSettings-  putStrLn ("Serving on " ++ url)-  app (runSettings settings . logStdout)+  ServerSettings {..} <- newServerSettings+  putStrLn ("Serving on " ++ bindUrl)+  app (runSettings warpSettings . logStdout)