top server side routing using Snap

hosts.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Control.Applicative
import           Snap.Core
import           Snap.Util.FileServe
import           Snap.Http.Server


main :: IO ()
main = do
    httpServe (setPort 80 defaultConfig) skite

-- Applications for each site

site1 :: Snap ()
site1 = route [ ("/",        ifTop $ serveDirectory "site1")
              , ("yst",      serveDirectory "site1/folder")
              -- and this can go on and on
             ]


skite :: Snap ()
skite = do
    req <- fmap rqServerName getRequest
    routes req
  where
    routes req =
        if (req == "www.site1.ro") then (site1) else pass <|>
        if (req == "site1.ro") then (site1) else pass <|>
        if (req == "www.site2.ro") then (writeBS req) else pass <|>
        if (req == "site2.ro") then (writeBS "Nowhere to be found") else pass <|>
        ifTop (writeBS req)