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

Begin cleaning up old things

Browse source
This commit is contained in:
Vincent Ambo 2015-11-19 18:16:34 +01:00
parent f703c03916
commit 71b2ccd927
3 changed files with 4 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Blog.hs
View file

@ -57,8 +57,6 @@ $doctype 5
<br> <br>
<div .span6> <div .span6>
<span .contacts #cosx>^{contactInfo} <span .contacts #cosx>^{contactInfo}
<div .span6>
<span .righttext>^{preEscapedToHtml $ rightText lang}
<div .container> <div .container>
^{body} ^{body}
<footer .footer> <footer .footer>

7
src/Locales.hs
View file

@ -118,12 +118,7 @@ notFoundTitle EN = "Not found"
notFoundText :: BlogLang -> Text notFoundText :: BlogLang -> Text
notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden." notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden."
notFoundText EN = "The requested object could unfortunately not be found." notFoundText EN = "The requested object could not be found."
-- right side text (this is inserted AS IS. Escape HTML!)
rightText :: BlogLang -> Text
rightText DE = "English version <a href=\"/en\" class=\"link\">available here</a>."
rightText EN = "Deutsche Version <a href=\"/de\" class=\"link\">hier verf&uuml;gbar</a>."
-- static information -- static information
repoURL :: Text = "http://hg.tazj.in/tazblog-haskell" repoURL :: Text = "http://hg.tazj.in/tazblog-haskell"

19
src/Server.hs
View file

@ -15,21 +15,12 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time import Data.Time
import Happstack.Server hiding (Session) import Happstack.Server hiding (Session)
import Happstack.Server.Compression
import Blog import Blog
import BlogDB hiding (updateEntry) import BlogDB hiding (updateEntry)
import Locales import Locales
import RSS import RSS
instance FromReqURI BlogLang where
fromReqURI sub =
case map toLower sub of
"de" -> Just DE
"en" -> Just EN
_ -> Nothing
tmpPolicy :: BodyPolicy tmpPolicy :: BodyPolicy
tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000 tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000
@ -39,13 +30,9 @@ runBlog acid port respath =
tazBlog :: AcidState Blog -> String -> ServerPart Response tazBlog :: AcidState Blog -> String -> ServerPart Response
tazBlog acid resDir = do tazBlog acid resDir = do
compr <- compressedResponseFilter msum [ nullDir >> blogHandler acid EN
msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang , dir "de" $ blogHandler acid DE
, nullDir >> showIndex acid EN
, dir " " $ nullDir >>
seeOther ("https://plus.google.com/115916629925754851590" :: Text) (toResponse ())
, path $ \(year :: Int) -> path $ \(month :: Int) -> path $ \(id_ :: String) -> formatOldLink year month id_ , path $ \(year :: Int) -> path $ \(month :: Int) -> path $ \(id_ :: String) -> formatOldLink year month id_
, dir "res" $ serveDirectory DisableBrowsing [] "../res"
, dir "notice" $ ok $ toResponse showSiteNotice , dir "notice" $ ok $ toResponse showSiteNotice
{- :Admin handlers -} {- :Admin handlers -}
, do dirs "admin/postentry" nullDir , do dirs "admin/postentry" nullDir
@ -75,7 +62,7 @@ tazBlog acid resDir = do
setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT" setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
dir "static" $ serveDirectory DisableBrowsing [] resDir dir "static" $ serveDirectory DisableBrowsing [] resDir
, serveDirectory DisableBrowsing [] resDir , serveDirectory DisableBrowsing [] resDir
, notFound $ toResponse $ showError NotFound DE , notFound $ toResponse $ showError NotFound EN
] ]
blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response