From 9cdbce950820a7222e8d4eaed6ecceb997a1132d Mon Sep 17 00:00:00 2001 From: rnhmjoj Date: Thu, 9 Apr 2015 17:11:27 +0200 Subject: [PATCH] Repackage for cabal-install support --- Application.hs => src/Application.hs | 34 ++++++++++++++++------------ {Breve => src/Breve}/Common.hs | 21 +++++++++-------- {Breve => src/Breve}/Generator.hs | 0 {Breve => src/Breve}/UrlTable.hs | 4 ---- Main.hs => src/Main.hs | 0 5 files changed, 31 insertions(+), 28 deletions(-) rename Application.hs => src/Application.hs (50%) rename {Breve => src/Breve}/Common.hs (60%) rename {Breve => src/Breve}/Generator.hs (100%) rename {Breve => src/Breve}/UrlTable.hs (88%) rename Main.hs => src/Main.hs (100%) diff --git a/Application.hs b/src/Application.hs similarity index 50% rename from Application.hs rename to src/Application.hs index 614f4bf..80136ac 100644 --- a/Application.hs +++ b/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 Text.Printf -import Data.Maybe +import Control.Monad.IO.Class (liftIO) +import Text.Printf (printf) 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 "/main.css" (serveStatic "layouts/main.css") + get "/" (render indexPath ()) + 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 - Just url' -> do - let url = BS.unpack url' - word <- liftIO (insert table url) - liftIO $ putStrLn (printf "Registered %s -> %s " url word) - render "done.html" $ object ["link" .= (baseUrl ++ word)] + case BS.unpack <$> lookup "url" form of + Just url -> do + word <- liftIO (insert table url) + logStr (printf "Registered %s -> %s " url word) + render donePath $ object ["link" .= (baseUrl ++ word)] Nothing -> respond badRequest diff --git a/Breve/Common.hs b/src/Breve/Common.hs similarity index 60% rename from Breve/Common.hs rename to src/Breve/Common.hs index 6da9131..4484832 100644 --- a/Breve/Common.hs +++ b/src/Breve/Common.hs @@ -1,22 +1,23 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Breve.Common where -import Control.Applicative -import Text.Printf -import Data.String -import System.Environment -import Network.Wai.Handler.Warp +import Paths_breve (getDataFileName) + +import Control.Applicative +import Control.Monad.IO.Class (liftIO) +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" - let opts = setPort port $ setHost (fromString host) defaultSettings + 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 @@ -26,4 +27,6 @@ newAppSettings :: IO AppSettings newAppSettings = return AppSettings instance HasTemplates IO AppSettings where - defaultLayout = Just <$> getTemplate "layouts/main.html" \ No newline at end of file + defaultLayout = do + main <- liftIO (getDataFileName "layouts/main.html") + Just <$> getTemplate main \ No newline at end of file diff --git a/Breve/Generator.hs b/src/Breve/Generator.hs similarity index 100% rename from Breve/Generator.hs rename to src/Breve/Generator.hs diff --git a/Breve/UrlTable.hs b/src/Breve/UrlTable.hs similarity index 88% rename from Breve/UrlTable.hs rename to src/Breve/UrlTable.hs index d78d028..ac3b143 100644 --- a/Breve/UrlTable.hs +++ b/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 diff --git a/Main.hs b/src/Main.hs similarity index 100% rename from Main.hs rename to src/Main.hs