breve 0.0.4.0 → 0.1.0.0

raw patch · 4 files changed

+27/−25 lines, 4 filesdep +configuratordep −tconfig

Dependencies added: configurator

Dependencies removed: tconfig

Files

• README.md +3/−3
• breve.cabal +2/−2
• src/Application.hs +4/−3
• src/Breve/Common.hs +18/−17

@@ -30,9 +30,9 @@ The default values are:  ```ini-hostname localhost-port     3000-urltable $XDG_CONFIG_HOME/breve+hostname = "localhost"+port     = 3000+urltable = "$XDG_CONFIG_HOME/breve" ```  `urltable` is the location of breve url hashtable

@@ -1,5 +1,5 @@ name:                breve-version:             0.0.4.0+version:             0.1.0.0 synopsis:            a url shortener description: @@ -34,5 +34,5 @@                      aeson, bytestring, binary,                      transformers, mtl,                      hashtables, cryptohash, random,-                     xdg-basedir, tconfig, directory+                     xdg-basedir, configurator, directory   ghc-options:       -threaded -O2

@@ -42,9 +42,10 @@         Nothing  -> respond notFound      post "/short" $ do-      (form, _) <- parseForm-      case BS.unpack <$> lookup "url" form of-        Just url -> do+      form <- fmap fst parseForm+      case lookup "url" form of+        Just url' -> do+          let url = BS.unpack url'           name <- liftIO (insert table url)           logStr (printf "Registered %s -> %s " url name)           render done $ object ["link" .= (bindUrl ++ name)]

@@ -1,21 +1,22 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-} module Breve.Common where  import Paths_breve                     (getDataFileName)  import Control.Monad.IO.Class          (liftIO)+import Control.Monad                   (when) import Text.Printf                     (printf) import System.Environment              (lookupEnv) import System.Environment.XDG.BaseDir import System.Directory                (doesFileExist)-import Data.TConfig+import Data.Configurator  import Web.Simple.Templates import Network.Wai.Handler.Warp  data ServerSettings = ServerSettings-  { bindPort     :: Int-  , bindHostname :: String+  { bindHostname :: String+  , bindPort     :: Int   , bindUrl      :: String   , urlTable     :: FilePath   , warpSettings :: Settings@@ -29,31 +30,31 @@     Just <$> getTemplate main  +createEmptyIfMissing :: FilePath -> IO ()+createEmptyIfMissing file = do+  exists <- doesFileExist file+  when (not exists) (writeFile file "")++ 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) +  config <- load [Required configPath] +  host   <- lookupDefault "localhost" config "hostname"+  port   <- lookupDefault 3000        config "port"    +  urls   <- lookupDefault urlsPath    config "urltable"+   createEmptyIfMissing urls    return ServerSettings-    { bindPort     = port-    , bindHostname = host+    { bindHostname = host+    , bindPort     = port     , bindUrl      = if port == 80                        then printf "http://%s/"    host                        else printf "http://%s:%d/" host port