atomo webserver.atomo.hs

load: "examples/html.atomo"
load: "examples/web.hs"

Demo = Website clone

Demo index :=
    HTML new (do: {
        doctype
        html: {
            head: {
                title: "Hi!"
            }
            body: {
                h1: "Hello, world!"
                p: "Hop on over to the REPL and add some methods to the Demo object!"
                a: "Here's another page." href: "hello-world"
            }
        }
    }) (as: String)

Demo hello-world := "Hello, world!"

-- be sure to load this in the REPL and play around with
-- Demo, adding new routes at runtime
{ Demo start-on: 8000 } spawn

web.hs

{-# LANGUAGE QuasiQuotes #-}
import Data.IORef
import Data.Hashable (hash)
import Snap.Http.Server
import Snap.Types
import qualified Control.Monad.IO.Class as IO
import qualified Data.ByteString as BS
import qualified Data.Vector as V

import Atomo.Environment
import Atomo.Haskell


load :: VM ()
load = do
    (eval [$e|Object clone|]) >>= ([$p|Website|] =::)

    [$p|(w: Website) start-on: (port: Integer)|] =: do
        w <- here "w"
        Integer p <- here "port" >>= findValue isInteger
        e <- get
        liftIO $
            httpServe
                (toBS "*")
                (fromIntegral p)
                (toBS "127.0.0.1")
                Nothing
                Nothing
                (serveWith (findHandler w e))
        return (particle "ok")

findHandler :: Value -> Env -> String -> IO (Either AtomoError Value)
findHandler w e "" = runWith (dispatch (Single (hash "index") "index" w)) e
findHandler w e n = runWith (dispatch (Single (hash n) n w)) e

serveWith :: (String -> IO (Either AtomoError Value)) -> Snap ()
serveWith handle = do
    path <- fmap (fromBS . rqPathInfo) getRequest
    h <- IO.liftIO (handle path)

    case h of
        Right (List bodyv) -> do
            body <- fmap V.toList $ IO.liftIO (readIORef bodyv)
            writeBS (toBS $ map (\(Char c) -> c) body)
        _ -> writeBS (toBS "500: Internal Server Error")

toBS :: String -> BS.ByteString
toBS = BS.pack . map (fromIntegral . fromEnum)

fromBS :: BS.ByteString -> String
fromBS = map (toEnum . fromIntegral) . BS.unpack