/
Main.hs
64 lines (57 loc) · 1.63 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
module Main where
import Directory
import System
import Control.Applicative
import Control.Monad.Trans
import Snap.Http.Server
import Snap.Types
import Snap.Util.FileServe
import System.FilePath
import Text.Templating.Heist
--templateServe :: TemplateState IO
-- -> Snap ()
--templateServe ts = do
-- req <- getRequest
-- let pInfo = S.unpack $ rqPathInfo req
-- fp <- resolvePath pInfo
-- let fn = takeFileName fp
-- where
-- resolvePath p = do
-- -- relative paths only!
-- when (not $ isRelative p) pass
--
-- -- check that we don't have any sneaky .. paths
-- let dirs = splitDirectories p
-- when (elem ".." dirs) pass
--
-- let f = root </> p
--
-- -- check that the file exists
-- liftIO (doesFileExist f) >>= flip unless pass
--
-- return f
site :: TemplateState IO -> Snap ()
site ts =
ifTop (maybe pass writeBS =<< liftIO (renderTemplate ts "index")) <|>
template "about" <|>
template "download" <|>
template "docs" <|>
template "contribute" <|>
template "news" <|>
template "heist-tutorial" <|>
template "style-guide" <|>
template "tutorials/heist" <|>
fileServe "static"
where
template n = path n (maybe pass writeBS =<< liftIO (renderTemplate' "templates" n))
main :: IO ()
main = do
args <- getArgs
port <- case args of
[] -> error "You must specify a port!" >> exitFailure
port:_ -> return $ read port
templateState <- loadTemplates "templates"
httpServe "*" port "achilles"
(Just "access.log")
(Just "error.log")
(site templateState)