git.iko.soy/hakyll
on master help sign in
Clean cabal file, migrate to serveDirectoryWith
47521b3Jasper Van der Jeugt
hakyll.cabal+21−24
compare with master
unifiedsplit
@@ -55,30 +55,27 @@ Library
55 Hs-Source-Dirs: src
55 Hs-Source-Dirs: src
56
56
57 Build-Depends:
57 Build-Depends:
58− base >= 4 && < 5,
58+ base >= 4 && < 5,
59− binary >= 0.5,
59+ binary >= 0.5 && < 1.0,
60− blaze-html >= 0.4,
60+ blaze-html >= 0.4 && < 0.6,
61− bytestring >= 0.9,
61+ bytestring >= 0.9 && < 1.0,
62− containers == 0.*,
62+ containers >= 0.3 && < 1.0,
63− directory == 1.*,
63+ directory >= 1.0 && < 1.3,
64− filepath == 1.*,
64+ filepath >= 1.0 && < 2.0,
65− hamlet >= 0.7,
65+ hamlet >= 0.7 && < 0.9,
66− hopenssl >= 1.4,
66+ hopenssl >= 1.4 && < 1.7,
67− HTTP >= 4000,
68− mtl >= 1,
67+ mtl >= 1 && < 3.0,
69− old-locale == 1.*,
68+ old-locale >= 1.0 && < 2.0,
70− old-time == 1.*,
69+ old-time >= 1.0 && < 1.3,
71− pandoc == 1.*,
70+ pandoc >= 1.6 && < 2.0,
72− process >= 1.0,
71+ process >= 1.0 && < 1.4,
73− regex-base >= 0.93,
72+ regex-base >= 0.93 && < 1.0,
74− regex-pcre >= 0.93,
73+ regex-pcre >= 0.93 && < 1.0,
75− snap-core >= 0.4,
74+ snap-core >= 0.5.1 && < 0.6,
76− snap-server >= 0.4,
75+ snap-server >= 0.5.1 && < 0.6,
77− strict-concurrency >= 0.2,
78− tagsoup >= 0.12,
76+ tagsoup >= 0.12 && < 0.13,
79− time >= 1.1,
77+ time >= 1.1 && < 1.3,
80− unix >= 2.4,
78+ unix >= 2.4 && < 2.6
81− utf8-string >= 0.3
82
79
83 Exposed-Modules:
80 Exposed-Modules:
84 Hakyll
81 Hakyll
src/Hakyll/Core/Logger.hs+2−2
@@ -15,8 +15,8 @@ import Control.Monad (forever)
15import Control.Monad.Trans (MonadIO, liftIO)
15import Control.Monad.Trans (MonadIO, liftIO)
16import Control.Applicative (pure, (<$>), (<*>))
16import Control.Applicative (pure, (<$>), (<*>))
17import Control.Concurrent (forkIO)
17import Control.Concurrent (forkIO)
18−import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)
18+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
19−import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar)
19+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
20import Text.Printf (printf)
20import Text.Printf (printf)
21
21
22import Data.Time (getCurrentTime, diffUTCTime)
22import Data.Time (getCurrentTime, diffUTCTime)
src/Hakyll/Web/Preview/Server.hs+14−43
@@ -6,56 +6,27 @@ module Hakyll.Web.Preview.Server
6 ) where
6 ) where
7
7
8import Control.Monad.Trans (liftIO)
8import 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)
14
9
15−import qualified Data.ByteString as SB
10+import Snap.Types (Snap)
16−import Snap.Util.FileServe (serveFile)
11+import Snap.Util.FileServe ( DirectoryConfig (..), fancyDirectoryConfig
17−import Snap.Types (Snap, rqURI, getRequest, writeBS)
12+ , serveDirectoryWith
13+ )
18−import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog, addListen
14+import Snap.Http.Server ( httpServe, setAccessLog, setErrorLog
19− , ConfigListen (..), emptyConfig
15+ , setPort, emptyConfig
20 )
16 )
21
17
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−
32-- | Serve a given directory
18-- | Serve a given directory
33--
19--
34static :: FilePath -- ^ Directory to serve
20static :: FilePath -- ^ Directory to serve
35 -> (FilePath -> IO ()) -- ^ Pre-serve hook
21 -> (FilePath -> IO ()) -- ^ Pre-serve hook
36 -> Snap ()
22 -> Snap ()
37−static directory preServe = do
23+static directory preServe =
38− -- Obtain the path
24+ serveDirectoryWith directoryConfig directory
39− uri <- rqURI <$> getRequest
25+ where
40− let filePath = replaceAll "\\?.*$" (const "") -- Remove trailing ?
26+ directoryConfig :: DirectoryConfig Snap
41− $ replaceAll "#[^#]*$" (const "") -- Remove #section
27+ directoryConfig = fancyDirectoryConfig
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
28+ { preServeHook = liftIO . preServe
58− serveFile f
29+ }
59
30
60-- | Main method, runs a static server in the given directory
31-- | Main method, runs a static server in the given directory
61--
32--
@@ -67,7 +38,7 @@ staticServer directory preServe port =
67 httpServe config $ static directory preServe
38 httpServe config $ static directory preServe
68 where
39 where
69 -- Snap server config
40 -- Snap server config
70− config = addListen (ListenHttp "0.0.0.0" port)
41+ config = setPort port
71 $ setAccessLog Nothing
42 $ setAccessLog Nothing
72 $ setErrorLog Nothing
43 $ setErrorLog Nothing
73 $ emptyConfig
44 $ emptyConfig