Repackage for cabal-install support

src/Application.hs

@@ -3,20 +3,21 @@ module Application where
 
 import Breve.Common
 import Breve.UrlTable
+import Paths_breve             (getDataFileName)
 
-import Web.Simple
-import Web.Simple.Static
-import Web.Simple.Templates
 import Web.Frank
+import Web.Simple
+import Web.Simple.Static       (serveStatic)
+import Web.Simple.Templates    (render)
 
 import Control.Applicative
-import Control.Monad.IO.Class
+import Control.Monad.IO.Class  (liftIO)
-import Text.Printf
+import Text.Printf             (printf)
-import Data.Maybe
 import Data.Aeson
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.ByteString.Char8      as BS
 
+logStr = liftIO . putStrLn 
 
 app :: (Application -> IO ()) -> IO ()
 app runner = do
@@ -24,25 +25,28 @@ app runner = do
   (baseUrl,_) <- serverSettings
   table       <- records
 
+  cssPath   <- getDataFileName "layouts/main.css"
+  indexPath <- getDataFileName "views/index.html"
+  donePath  <- getDataFileName "views/done.html"
+
   runner $ controllerApp settings $ do
-    get "/" (render "index.html" ())
+    get "/" (render indexPath ())
-    get "/main.css" (serveStatic "layouts/main.css")
+    get "/main.css" (serveStatic cssPath)
 
     get "/:word" $ do
       word <- queryParam' "word"
       url  <- liftIO (extract table word)
       case url of
         Just url -> do
-          liftIO $ putStrLn (printf "Resolved %s -> %s" word url)
+          logStr (printf "Resolved %s -> %s" word url)
           respond $ redirectTo (BS.pack url)
         Nothing  -> respond notFound
 
     post "/short" $ do
       (form, _) <- parseForm
-      case lookup "url" form of
+      case BS.unpack <$> lookup "url" form of
-        Just url' -> do
+        Just url -> do
-          let url = BS.unpack url'
+          word <- liftIO (insert table url)
-          word    <- liftIO (insert table url)
+          logStr (printf "Registered %s -> %s " url word)
-          liftIO $ putStrLn (printf "Registered %s -> %s " url word)
+          render donePath $ object ["link" .= (baseUrl ++ word)]
-          render "done.html" $ object ["link" .= (baseUrl ++ word)]
         Nothing  -> respond badRequest

src/Breve/Common.hs

@@ -1,22 +1,23 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 module Breve.Common where
 
-import Control.Applicative
+import Paths_breve            (getDataFileName)
-import Text.Printf
+
-import Data.String
+import Control.Applicative
-import System.Environment
+import Control.Monad.IO.Class (liftIO)
-import Network.Wai.Handler.Warp
+import Text.Printf            (printf)
+import System.Environment     (lookupEnv)
 
-import Web.Simple
 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 "127.0.0.1" id   <$> lookupEnv "ADDRESS"
+  host <- maybe "localhost" id   <$> lookupEnv "HOSTNAME"
-  let opts = setPort port $ setHost (fromString host) defaultSettings
+  let opts = setPort port defaultSettings
       url  = if port == 80
              then printf "http://%s/"    host
              else printf "http://%s:%d/" host port
@@ -26,4 +27,6 @@ newAppSettings :: IO AppSettings
 newAppSettings = return AppSettings
 
 instance HasTemplates IO AppSettings where
-  defaultLayout = Just <$> getTemplate "layouts/main.html"
+  defaultLayout = do
+    main <- liftIO (getDataFileName "layouts/main.html")
+    Just <$> getTemplate main

src/Breve/UrlTable.hs

@@ -6,10 +6,6 @@ module Breve.UrlTable
 ) where
 
 import Breve.Generator
-
-import Control.Applicative
-import Control.Monad
-import Data.Maybe
 import qualified Data.HashTable.IO as H
 
 type UrlTable = H.CuckooHashTable Word Url