hakyll 3.1.2.4 → 3.1.2.5

raw patch · 2 files changed

+32/−5 lines, 2 files

Files

• hakyll.cabal +1/−1
• src/Hakyll/Web/Preview/Server.hs +31/−4

@@ -1,5 +1,5 @@ Name:               hakyll-Version:            3.1.2.4+Version:            3.1.2.5  Synopsis:           A simple static site generator library. Description:        A simple static site generator library, mainly aimed at

@@ -13,7 +13,7 @@ import System.Directory (doesFileExist)  import qualified Data.ByteString as SB-import Snap.Util.FileServe+import Snap.Util.FileServe (serveFile) import Snap.Types (Snap, rqURI, getRequest, writeBS) import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen                         , ConfigListen (..), emptyConfig@@ -21,14 +21,41 @@  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 = serveDirectoryWith cfg directory-  where-    cfg = fancyDirectoryConfig {preServeHook = liftIO . preServe}+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  -- | Main method, runs a static server in the given directory --