mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add an option for the resource folder

Browse source
This commit is contained in:
Vincent Ambo 2014-03-11 18:22:59 +01:00
parent b4b2b053b9
commit f2b5e14cee
1 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/Main.hs
View file

@ -44,7 +44,8 @@ import RSS
data MainOptions = MainOptions { data MainOptions = MainOptions {
optState :: String, optState :: String,
optPort :: Int optPort :: Int,
optRes :: String
} }
instance Options MainOptions where instance Options MainOptions where
@ -53,7 +54,9 @@ instance Options MainOptions where
"Directory in which the BlogState is located." "Directory in which the BlogState is located."
<*> simpleOption "port" 8000 <*> simpleOption "port" 8000
"Port to run on. Default is 8000." "Port to run on. Default is 8000."
<*> simpleOption "res" "/usr/share/tazblog/res"
"Resources folder location."
tmpPolicy :: BodyPolicy tmpPolicy :: BodyPolicy
tmpPolicy = defaultBodyPolicy "./tmp/" 0 200000 1000 tmpPolicy = defaultBodyPolicy "./tmp/" 0 200000 1000
@ -63,10 +66,10 @@ main = do
runCommand $ \opts args -> runCommand $ \opts args ->
bracket (openLocalStateFrom (optState opts ++ "BlogState") initialBlogState) bracket (openLocalStateFrom (optState opts ++ "BlogState") initialBlogState)
createCheckpointAndClose createCheckpointAndClose
(\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid) (\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid (optRes opts))
tazBlog :: AcidState Blog -> ServerPart Response tazBlog :: AcidState Blog -> String -> ServerPart Response
tazBlog acid = do tazBlog acid resDir = do
compr <- compressedResponseFilter compr <- compressedResponseFilter
msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang
, nullDir >> showIndex acid EN , nullDir >> showIndex acid EN
@ -104,8 +107,8 @@ tazBlog acid = do
ok $ toResponse blogStyle ok $ toResponse blogStyle
, do setHeaderM "cache-control" "max-age=630720000" , do setHeaderM "cache-control" "max-age=630720000"
setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT" setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
dir "static" $ serveDirectory DisableBrowsing [] "../res" dir "static" $ serveDirectory DisableBrowsing [] resDir
, serveDirectory DisableBrowsing [] "../res" , serveDirectory DisableBrowsing [] resDir
, notFound $ toResponse $ showError NotFound DE , notFound $ toResponse $ showError NotFound DE
] ]