Clean cabal file, migrate to serveDirectoryWith

3 files changed, 37 insertions, 69 deletions

diff --git a/hakyll.cabal b/hakyll.cabal
index 9446fe5..46379a0 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -55,30 +55,27 @@ Library
   Hs-Source-Dirs: src
 
   Build-Depends:
-    base >= 4 && < 5,
-    binary >= 0.5,
-    blaze-html >= 0.4,
-    bytestring >= 0.9,
-    containers == 0.*,
-    directory == 1.*,
-    filepath == 1.*,
-    hamlet >= 0.7,
-    hopenssl >= 1.4,
-    HTTP >= 4000,
-    mtl >= 1,
-    old-locale == 1.*,
-    old-time == 1.*,
-    pandoc == 1.*,
-    process >= 1.0,
-    regex-base >= 0.93,
-    regex-pcre >= 0.93,
-    snap-core >= 0.4,
-    snap-server >= 0.4,
-    strict-concurrency >= 0.2,
-    tagsoup >= 0.12,
-    time >= 1.1,
-    unix >= 2.4,
-    utf8-string >= 0.3
+    base        >= 4     && < 5,
+    binary      >= 0.5   && < 1.0,
+    blaze-html  >= 0.4   && < 0.6,
+    bytestring  >= 0.9   && < 1.0,
+    containers  >= 0.3   && < 1.0,
+    directory   >= 1.0   && < 1.3,
+    filepath    >= 1.0   && < 2.0,
+    hamlet      >= 0.7   && < 0.9,
+    hopenssl    >= 1.4   && < 1.7,
+    mtl         >= 1     && < 3.0,
+    old-locale  >= 1.0   && < 2.0,
+    old-time    >= 1.0   && < 1.3,
+    pandoc      >= 1.6   && < 2.0,
+    process     >= 1.0   && < 1.4,
+    regex-base  >= 0.93  && < 1.0,
+    regex-pcre  >= 0.93  && < 1.0,
+    snap-core   >= 0.5.1 && < 0.6,
+    snap-server >= 0.5.1 && < 0.6,
+    tagsoup     >= 0.12  && < 0.13,
+    time        >= 1.1   && < 1.3,
+    unix        >= 2.4   && < 2.6
 
   Exposed-Modules:
     Hakyll
diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs
index 912cc98..fb9b276 100644
--- a/src/Hakyll/Core/Logger.hs
+++ b/src/Hakyll/Core/Logger.hs
@@ -15,8 +15,8 @@ import Control.Monad (forever)
 import Control.Monad.Trans (MonadIO, liftIO)
 import Control.Applicative (pure, (<$>), (<*>))
 import Control.Concurrent (forkIO)
-import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)
-import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar)
+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
 import Text.Printf (printf)
 
 import Data.Time (getCurrentTime, diffUTCTime)
diff --git a/src/Hakyll/Web/Preview/Server.hs b/src/Hakyll/Web/Preview/Server.hs
index 4269509..22d48ad 100644
--- a/src/Hakyll/Web/Preview/Server.hs
+++ b/src/Hakyll/Web/Preview/Server.hs
@@ -6,56 +6,27 @@ module Hakyll.Web.Preview.Server
     ) where
 
 import Control.Monad.Trans (liftIO)
-import Control.Applicative ((<$>))
-import Codec.Binary.UTF8.String
-import Network.HTTP.Base (urlDecode)
-import System.FilePath ((</>))
-import System.Directory (doesFileExist)
 
-import qualified Data.ByteString as SB
-import Snap.Util.FileServe (serveFile)
-import Snap.Types (Snap, rqURI, getRequest, writeBS)
-import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen
-                        , ConfigListen (..), emptyConfig
+import Snap.Types (Snap)
+import Snap.Util.FileServe ( DirectoryConfig (..), fancyDirectoryConfig
+                           , serveDirectoryWith
+                           )
+import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog
+                        , setPort, emptyConfig
                         )
 
-import Hakyll.Core.Util.String (replaceAll)
-
--- | The first file in the list that actually exists is returned
---
-findFile :: [FilePath] -> IO (Maybe FilePath)
-findFile [] = return Nothing
-findFile (x : xs) = do
-    exists <- doesFileExist x
-    if exists then return (Just x) else findFile xs
-
 -- | Serve a given directory
 --
 static :: FilePath             -- ^ Directory to serve
        -> (FilePath -> IO ())  -- ^ Pre-serve hook
        -> Snap ()
-static directory preServe = do
-    -- Obtain the path
-    uri <- rqURI <$> getRequest
-    let filePath = replaceAll "\\?.*$"  (const "")  -- Remove trailing ?
-                 $ replaceAll "#[^#]*$" (const "")  -- Remove #section
-                 $ replaceAll "^/"      (const "")  -- Remove leading /
-                 $ urlDecode $ decode $ SB.unpack uri
-
-    -- Try to find the requested file
-    r <- liftIO $ findFile $ map (directory </>) $
-        [ filePath
-        , filePath </> "index.htm"
-        , filePath </> "index.html"
-        ]
-
-    case r of
-        -- Not found, error
-        Nothing -> writeBS "Not found"
-        -- Found, serve
-        Just f  -> do
-            liftIO $ preServe f
-            serveFile f
+static directory preServe =
+    serveDirectoryWith directoryConfig directory
+  where
+    directoryConfig :: DirectoryConfig Snap
+    directoryConfig = fancyDirectoryConfig
+        { preServeHook = liftIO . preServe
+        }
 
 -- | Main method, runs a static server in the given directory
 --
@@ -67,7 +38,7 @@ staticServer directory preServe port =
     httpServe config $ static directory preServe
   where
     -- Snap server config
-    config = addListen (ListenHttp "0.0.0.0" port)
+    config = setPort port
            $ setAccessLog Nothing
            $ setErrorLog Nothing
            $ emptyConfig