Clean cabal file, migrate to serveDirectoryWith

1 files changed, 14 insertions, 43 deletions

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