git.iko.soy/hakyll
on master help sign in
Clean cabal file, migrate to serveDirectoryWith
commit47521b3893fd3684400014c393d9914796b4b274 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateMon 20 Jun 2011, 10:46 (15 years ago) parent3674ff8
3 files changed+37−69
compare with master
unifiedsplit
hakyll.cabal+21−24 src/Hakyll/Core/Logger.hs+2−2 src/Hakyll/Web/Preview/Server.hs+14−43
hakyll.cabal+21−24
@@ -55,30 +55,27 @@ Library
5555 Hs-Source-Dirs: src
5656
5757 Build-Depends:
58− base >= 4 && < 5,
59− binary >= 0.5,
60− blaze-html >= 0.4,
61− bytestring >= 0.9,
62− containers == 0.*,
63− directory == 1.*,
64− filepath == 1.*,
65− hamlet >= 0.7,
66− hopenssl >= 1.4,
67− HTTP >= 4000,
68− mtl >= 1,
69− old-locale == 1.*,
70− old-time == 1.*,
71− pandoc == 1.*,
72− process >= 1.0,
73− regex-base >= 0.93,
74− regex-pcre >= 0.93,
75− snap-core >= 0.4,
76− snap-server >= 0.4,
77− strict-concurrency >= 0.2,
78− tagsoup >= 0.12,
79− time >= 1.1,
80− unix >= 2.4,
81− utf8-string >= 0.3
58+ base >= 4 && < 5,
59+ binary >= 0.5 && < 1.0,
60+ blaze-html >= 0.4 && < 0.6,
61+ bytestring >= 0.9 && < 1.0,
62+ containers >= 0.3 && < 1.0,
63+ directory >= 1.0 && < 1.3,
64+ filepath >= 1.0 && < 2.0,
65+ hamlet >= 0.7 && < 0.9,
66+ hopenssl >= 1.4 && < 1.7,
67+ mtl >= 1 && < 3.0,
68+ old-locale >= 1.0 && < 2.0,
69+ old-time >= 1.0 && < 1.3,
70+ pandoc >= 1.6 && < 2.0,
71+ process >= 1.0 && < 1.4,
72+ regex-base >= 0.93 && < 1.0,
73+ regex-pcre >= 0.93 && < 1.0,
74+ snap-core >= 0.5.1 && < 0.6,
75+ snap-server >= 0.5.1 && < 0.6,
76+ tagsoup >= 0.12 && < 0.13,
77+ time >= 1.1 && < 1.3,
78+ unix >= 2.4 && < 2.6
8279
8380 Exposed-Modules:
8481 Hakyll
src/Hakyll/Core/Logger.hs+2−2
@@ -15,8 +15,8 @@ import Control.Monad (forever)
1515import Control.Monad.Trans (MonadIO, liftIO)
1616import Control.Applicative (pure, (<$>), (<*>))
1717import Control.Concurrent (forkIO)
18−import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)
19−import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar)
18+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
19+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
2020import Text.Printf (printf)
2121
2222import Data.Time (getCurrentTime, diffUTCTime)
src/Hakyll/Web/Preview/Server.hs+14−43
@@ -6,56 +6,27 @@ module Hakyll.Web.Preview.Server
66 ) where
77
88import Control.Monad.Trans (liftIO)
9−import Control.Applicative ((<$>))
10−import Codec.Binary.UTF8.String
11−import Network.HTTP.Base (urlDecode)
12−import System.FilePath ((</>))
13−import System.Directory (doesFileExist)
149
15−import qualified Data.ByteString as SB
16−import Snap.Util.FileServe (serveFile)
17−import Snap.Types (Snap, rqURI, getRequest, writeBS)
18−import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen
19− , ConfigListen (..), emptyConfig
10+import Snap.Types (Snap)
11+import Snap.Util.FileServe ( DirectoryConfig (..), fancyDirectoryConfig
12+ , serveDirectoryWith
13+ )
14+import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog
15+ , setPort, emptyConfig
2016 )
2117
22−import Hakyll.Core.Util.String (replaceAll)
23−
24−-- | The first file in the list that actually exists is returned
25−--
26−findFile :: [FilePath] -> IO (Maybe FilePath)
27−findFile [] = return Nothing
28−findFile (x : xs) = do
29− exists <- doesFileExist x
30− if exists then return (Just x) else findFile xs
31−
3218-- | Serve a given directory
3319--
3420static :: FilePath -- ^ Directory to serve
3521 -> (FilePath -> IO ()) -- ^ Pre-serve hook
3622 -> Snap ()
37−static directory preServe = do
38− -- Obtain the path
39− uri <- rqURI <$> getRequest
40− let filePath = replaceAll "\\?.*$" (const "") -- Remove trailing ?
41− $ replaceAll "#[^#]*$" (const "") -- Remove #section
42− $ replaceAll "^/" (const "") -- Remove leading /
43− $ urlDecode $ decode $ SB.unpack uri
44−
45− -- Try to find the requested file
46− r <- liftIO $ findFile $ map (directory </>) $
47− [ filePath
48− , filePath </> "index.htm"
49− , filePath </> "index.html"
50− ]
51−
52− case r of
53− -- Not found, error
54− Nothing -> writeBS "Not found"
55− -- Found, serve
56− Just f -> do
57− liftIO $ preServe f
58− serveFile f
23+static directory preServe =
24+ serveDirectoryWith directoryConfig directory
25+ where
26+ directoryConfig :: DirectoryConfig Snap
27+ directoryConfig = fancyDirectoryConfig
28+ { preServeHook = liftIO . preServe
29+ }
5930
6031-- | Main method, runs a static server in the given directory
6132--
@@ -67,7 +38,7 @@ staticServer directory preServe port =
6738 httpServe config $ static directory preServe
6839 where
6940 -- Snap server config
70− config = addListen (ListenHttp "0.0.0.0" port)
41+ config = setPort port
7142 $ setAccessLog Nothing
7243 $ setErrorLog Nothing
7344 $ emptyConfig