{-# LANGUAGE OverloadedStrings #-} 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 ")"] ]