Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 71 lines (64 sloc) 2.303 kb
4b3aa41 @davean Initial checkin.
authored
1 {-# LANGUAGE OverloadedStrings #-}
2 module Main where
3
4 import Control.Monad
5 import Control.Monad.Trans
6 import Control.Monad.Reader
7 import Data.Monoid
8 import qualified Data.Text as T
9 import qualified Data.HashMap.Strict as Map
10 import qualified Data.ByteString.Lazy as BSL
11 import qualified Data.Aeson as JS
12 import qualified Network.Wai as WAI
13 import qualified Network.Wai.Handler.Warp as Warp
14 import qualified Network.HTTP.Types as HTTP
15 import qualified Blaze.ByteString.Builder.Char8 as BB8
16 import qualified Blaze.ByteString.Builder.ByteString as BBB
17 import Control.Monad.Trans.Resource (ResourceT, transResourceT)
18 import System.Environment
19 import Data.Maybe
20 import Safe
21
22 import Waldo.Waldo
23 import Waldo.Stalk
24 import qualified Waldo.StoryExample as SE
25
26 main :: IO ()
27 main = do
28 env <- getEnvironment
29 {- This is where we "load" a set of scripts to serve.
30 - Conceptually the server can serve any number of scripts.
31 -}
32 wdata <- loadWaldo [("jarUcyikAg3", SE.loadScriptGen)]
33 Warp.runSettings (warpsettings env) (route wdata)
34 where
35 warpsettings env = Warp.defaultSettings {
36 Warp.settingsPort = fromMaybe 3000 (join $ fmap readMay $ lookup "WALDO_PORT" env)
37 }
38
39 route :: WaldoData -> WAI.Application
40 route wd req =
41 transResourceT (flip runReaderT wd) $
42 case (WAI.requestMethod req, WAI.pathInfo req) of
43 ("GET", ["story", s]) -> getScript req s
44 _ -> return resp404
45
46 resp404 :: WAI.Response
47 resp404 =
48 WAI.ResponseBuilder
49 HTTP.status404
50 [("Content-Type", "text/plain")] $
51 BB8.fromString "Not Found"
52
53 getScript :: WAI.Request -> T.Text -> ResourceT (ReaderT WaldoData IO) WAI.Response
54 getScript req storySet = do
55 let stalkreq = wai2stalk req
56 wd <- lift $ ask
57 pd <- liftIO $ stalk (wdStalkDB wd) stalkreq
58 case Map.lookup storySet (wdGenScript wd) of
59 Nothing -> return resp404
60 Just storyGen -> do
61 script <- liftIO $ storyGen pd
62 return $ WAI.ResponseBuilder
63 HTTP.status200
64 [("Content-Type", "application/javascript")
65 ,("Access-Control-Allow-Origin", "*")] $
66 mconcat $ concat [
67 [BBB.fromByteString "waldoCallback(" ]
68 , map BBB.fromByteString $ BSL.toChunks $ JS.encode script
69 , [BBB.fromByteString ")"]
70 ]
Something went wrong with that request. Please try again.