chore: Significantly restructure folder layout
This moves the various projects from "type-based" folders (such as "services" or "tools") into more appropriate semantic folders (such as "nix", "ops" or "web"). Deprecated projects (nixcon-demo & gotest) which only existed for testing/demonstration purposes have been removed. (Note: *all* builds are broken with this commit)
This commit is contained in:
parent
e52eed3cd4
commit
03bfe08e1d
110 changed files with 1 additions and 998 deletions
81
web/tazblog/src/Server.hs
Normal file
81
web/tazblog/src/Server.hs
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Server where
|
||||
|
||||
import Blog
|
||||
import BlogStore
|
||||
import Control.Applicative (optional)
|
||||
import Control.Monad (msum)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Maybe (maybe)
|
||||
import qualified Data.Text as T
|
||||
import Happstack.Server hiding (Session)
|
||||
import RSS
|
||||
|
||||
pageSize :: Int
|
||||
pageSize = 3
|
||||
|
||||
tmpPolicy :: BodyPolicy
|
||||
tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000
|
||||
|
||||
runBlog :: Int -> String -> IO ()
|
||||
runBlog port respath =
|
||||
withCache "blog.tazj.in." $ \cache ->
|
||||
simpleHTTP nullConf {port = port} $ tazblog cache respath
|
||||
|
||||
tazblog :: BlogCache -> String -> ServerPart Response
|
||||
tazblog cache resDir =
|
||||
msum
|
||||
[ -- legacy language-specific routes
|
||||
dir "de" $ blogHandler cache,
|
||||
dir "en" $ blogHandler cache,
|
||||
dir "static" $ staticHandler resDir,
|
||||
blogHandler cache,
|
||||
staticHandler resDir,
|
||||
notFound $ toResponse $ showError "Not found" "Page not found"
|
||||
]
|
||||
|
||||
blogHandler :: BlogCache -> ServerPart Response
|
||||
blogHandler cache =
|
||||
msum
|
||||
[ path $ \(eId :: Integer) -> showEntry cache $ EntryId eId,
|
||||
nullDir >> showIndex cache,
|
||||
dir "rss" $ nullDir >> showRSS cache,
|
||||
dir "rss.xml" $ nullDir >> showRSS cache
|
||||
]
|
||||
|
||||
staticHandler :: String -> ServerPart Response
|
||||
staticHandler resDir = do
|
||||
setHeaderM "cache-control" "max-age=630720000"
|
||||
setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
|
||||
serveDirectory DisableBrowsing [] resDir
|
||||
|
||||
showEntry :: BlogCache -> EntryId -> ServerPart Response
|
||||
showEntry cache eId = do
|
||||
entry <- getEntry cache eId
|
||||
tryEntry entry
|
||||
|
||||
tryEntry :: Maybe Entry -> ServerPart Response
|
||||
tryEntry Nothing = notFound $ toResponse $ showError "Not found" "Blog entry not found"
|
||||
tryEntry (Just entry) = ok $ toResponse $ blogTemplate eTitle $ renderEntry entry
|
||||
where
|
||||
eTitle = T.append ": " (title entry)
|
||||
|
||||
offset :: Maybe Int -> Int
|
||||
offset = maybe 0 (pageSize *)
|
||||
|
||||
showIndex :: BlogCache -> ServerPart Response
|
||||
showIndex cache = do
|
||||
(page :: Maybe Int) <- optional $ lookRead "page"
|
||||
entries <- listEntries cache (offset page) pageSize
|
||||
ok $ toResponse $ blogTemplate ""
|
||||
$ renderEntries entries (Just $ showLinks page)
|
||||
|
||||
showRSS :: BlogCache -> ServerPart Response
|
||||
showRSS cache = do
|
||||
entries <- listEntries cache 0 4
|
||||
feed <- liftIO $ renderFeed entries
|
||||
setHeaderM "content-type" "text/xml"
|
||||
ok $ toResponse feed
|
||||
Loading…
Add table
Add a link
Reference in a new issue