module Waldo.Server (
waldoApp
) where
import Control.Monad.Trans
import Control.Monad.Reader
import qualified Data.Text as T
import qualified Data.HashMap.Strict as Map
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Aeson as JS
import qualified Network.Wai as WAI
import qualified Network.HTTP.Types as HTTP
import qualified Blaze.ByteString.Builder.Char8 as BB8
import qualified Blaze.ByteString.Builder.ByteString as BBB
import Waldo.Waldo
import Waldo.Stalk
waldoApp :: WaldoData -> WAI.Application
waldoApp wd req resp =
(flip runReaderT wd) $
case (WAI.requestMethod req, WAI.pathInfo req) of
("GET", [s]) -> getScript req s >>= (lift . resp)
_ -> lift $ resp resp404
resp404 :: WAI.Response
resp404 =
WAI.responseBuilder
HTTP.status404
[("Content-Type", "text/plain")] $
BB8.fromString "Not Found"
getScript :: WAI.Request -> T.Text -> ReaderT WaldoData IO WAI.Response
getScript req storySet = do
let stalkreq = wai2stalk req
wd <- ask
pd <- liftIO $ stalk (wdStalkDB wd) stalkreq
case Map.lookup storySet (wdGenScript wd) of
Nothing -> return resp404
Just storyGen -> do
script <- liftIO $ storyGen pd
return $ WAI.responseBuilder
HTTP.status200
[("Content-Type", "application/javascript")
,("Access-Control-Allow-Origin", "*")] $
mconcat $ concat [
[BBB.fromByteString "waldoCallback(" ]
, map BBB.fromByteString $ BSL.toChunks $ JS.encode script
, [BBB.fromByteString ")"]
]