From d7c0b8d4a59ca64387da427fd46d3cca368d258e Mon Sep 17 00:00:00 2001
From: rnhmjoj <micheleguerinirocco@me.com>
Date: Wed, 8 Apr 2015 15:54:06 +0200
Subject: [PATCH] Load bind address from environment

---
 Application.hs      |  8 ++++----
 Main.hs             |  7 +++----
 Shortener/Common.hs | 15 +++++++++++++++
 3 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/Application.hs b/Application.hs
index e09d51b..e2214dc 100644
--- a/Application.hs
+++ b/Application.hs
@@ -20,8 +20,9 @@ import qualified Data.ByteString.Char8      as BS
 
 app :: (Application -> IO ()) -> IO ()
 app runner = do
-  settings <- newAppSettings
-  table    <- records
+  settings    <- newAppSettings
+  (baseUrl,_) <- serverSettings
+  table       <- records
 
   runner $ controllerApp settings $ do
     get "/" (render "index.html" ())
@@ -41,8 +42,7 @@ app runner = do
       case lookup "url" form of
         Just url' -> do
           let url = BS.unpack url'
-          address <- return "http://localhost:3000/"
           word    <- liftIO (insert table url)
           liftIO $ putStrLn (printf "Registered %s -> %s " url word)
-          render "done.html" $ object ["link" .= (address ++ word)]
+          render "done.html" $ object ["link" .= (baseUrl ++ word)]
         Nothing  -> respond badRequest
diff --git a/Main.hs b/Main.hs
index 1cb9a03..34d085b 100644
--- a/Main.hs
+++ b/Main.hs
@@ -2,14 +2,13 @@
 module Main where
 
 import Application
+import Shortener.Common
 
 import Control.Applicative
-import System.Environment
 import Network.Wai.Handler.Warp
 import Network.Wai.Middleware.RequestLogger
 
-
 main :: IO ()
 main = do
-  port <- maybe 3000 read <$> lookupEnv "PORT"
-  app (run port . logStdout)
\ No newline at end of file
+  (_, settings) <- serverSettings
+  app (runSettings settings . logStdout)
\ No newline at end of file
diff --git a/Shortener/Common.hs b/Shortener/Common.hs
index 0f0f774..e25657d 100644
--- a/Shortener/Common.hs
+++ b/Shortener/Common.hs
@@ -2,11 +2,26 @@
 module Shortener.Common where
 
 import Control.Applicative
+import Text.Printf
+import Data.String
+import System.Environment
+import Network.Wai.Handler.Warp
+
 import Web.Simple
 import Web.Simple.Templates
 
 data AppSettings = AppSettings { }
 
+serverSettings :: IO (String, Settings)
+serverSettings = do
+  port <- maybe  3000       read <$> lookupEnv "PORT"
+  host <- maybe "127.0.0.1" id   <$> lookupEnv "ADDRESS"
+  let opts = setPort port $ setHost (fromString host) defaultSettings
+      url  = if port == 80
+             then printf "http://%s/"    host
+             else printf "http://%s:%d/" host port
+  return (url, opts)
+
 newAppSettings :: IO AppSettings
 newAppSettings = return AppSettings