Initial commit

.gitignore

@@ -0,0 +1,7 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc*
+/.psa*

README.md

@@ -0,0 +1,18 @@
+# purescript-hyper-routing-server
+
+The `purescript-hyper-routing-server` lets you build Hyper web servers on top
+of the [purescript-hyper-routing](https://github.com/owickstrom/purescript-hyper-routing)
+API for routing types.
+
+## Usage
+
+For the documentation on how to use this package, please head over to the
+extensions section in the Hyper documentation, and the part on [Servers for
+Routing
+Types](http://hyper.wickstrom.tech/extensions/type-level-routing/servers-for-routing-types.html).
+
+There are also [runnable examples in this repository](examples/).
+
+## API Documentation
+
+This library's API documentation is published [on Pursuit](https://pursuit.purescript.org/packages/purescript-hyper-routing-server).

bower.json

@@ -0,0 +1,25 @@
+{
+  "name": "purescript-hyper-routing-server",
+  "license": "MPL-2.0",
+  "repository": {
+    "type": "git",
+    "url": "git://github.com/owickstrom/purescript-hyper-routing-server.git"
+  },
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "output"
+  ],
+  "dependencies": {
+    "purescript-prelude": "^2.5.0",
+    "purescript-console": "^2.0.0",
+    "purescript-hyper": "^0.4.2",
+    "purescript-hyper-routing": "^0.4.2"
+  },
+  "devDependencies": {
+    "purescript-psci-support": "^2.0.0",
+    "purescript-spec": "^0.12.4",
+    "purescript-spec-discovery": "^0.4.0"
+  }
+}

examples/Routing.purs

@@ -0,0 +1,107 @@
+module Examples.Routing where
+
+import Prelude
+import Control.IxMonad ((:*>))
+import Control.Monad.Aff (Aff)
+import Control.Monad.Aff.AVar (AVAR)
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE)
+import Control.Monad.Eff.Exception (EXCEPTION)
+import Control.Monad.Error.Class (throwError)
+import Control.Monad.Except (ExceptT)
+import Data.Argonaut (class EncodeJson, gEncodeJson, jsonEmptyObject, (:=), (~>))
+import Data.Array (find, (..))
+import Data.Foldable (traverse_)
+import Data.Generic (class Generic)
+import Data.Maybe (Maybe(..), maybe)
+import Data.MediaType.Common (textHTML)
+import Hyper.Node.Server (defaultOptions, runServer)
+import Hyper.Response (closeHeaders, contentType, respond, writeStatus)
+import Hyper.Routing (type (:/), type (:<|>), type (:>), Capture, (:<|>))
+import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML, linkTo)
+import Hyper.Routing.ContentType.JSON (JSON)
+import Hyper.Routing.Links (linksTo)
+import Hyper.Routing.Method (Get)
+import Hyper.Routing.Router (RoutingError(..), router)
+import Hyper.Status (statusNotFound)
+import Node.HTTP (HTTP)
+import Text.Smolder.HTML (h1, li, nav, p, section, ul)
+import Text.Smolder.Markup (text)
+import Type.Proxy (Proxy(..))
+
+type PostID = Int
+
+newtype Post = Post { id :: PostID
+                    , title :: String
+                    }
+
+derive instance genericPost :: Generic Post
+
+instance encodeJsonPost :: EncodeJson Post where
+  encodeJson (Post { id, title }) =
+    "id" := id
+    ~> "title" := title
+    ~> jsonEmptyObject
+
+instance encodeHTMLPost :: EncodeHTML Post where
+  encodeHTML (Post { id: postId, title}) =
+    case linksTo site of
+      allPostsUri :<|> _ ->
+        section do
+          h1 (text title)
+          p (text "Contents...")
+          nav (linkTo allPostsUri (text "All Posts"))
+
+newtype PostsView = PostsView (Array Post)
+
+derive instance genericPostsView :: Generic PostsView
+
+instance encodeJsonPostsView :: EncodeJson PostsView where
+  encodeJson = gEncodeJson
+
+instance encodeHTMLPostsView :: EncodeHTML PostsView where
+  encodeHTML (PostsView posts) =
+    case linksTo site of
+      _ :<|> getPostUri ->
+        let postLink (Post { id: postId, title }) =
+              li (linkTo (getPostUri postId) (text title))
+        in section do
+            h1 (text "Posts")
+            ul (traverse_ postLink posts)
+
+type Site = Get (HTML :<|> JSON) PostsView
+            :<|> "posts" :/ Capture "id" PostID :> Get (HTML :<|> JSON) Post
+
+site :: Proxy Site
+site = Proxy
+
+type AppM e a = ExceptT RoutingError (Aff e) a
+
+-- This would likely be a database query in
+-- a real app:
+allPosts :: forall e. AppM e (Array Post)
+allPosts = pure (map (\i -> Post { id: i, title: "Post #" <> show i }) (1..10))
+
+postsView :: forall e. AppM e PostsView
+postsView = PostsView <$> allPosts
+
+viewPost :: forall e. PostID -> AppM e Post
+viewPost postId =
+  find (\(Post p) -> p.id == postId) <$> allPosts >>=
+  case _ of
+    Just post -> pure post
+    -- You can throw 404 Not Found in here as well.
+    Nothing -> throwError (HTTPError { status: statusNotFound
+                                     , message: Just "Post not found."
+                                     })
+
+main :: forall e. Eff (http :: HTTP, console :: CONSOLE, err :: EXCEPTION, avar :: AVAR | e) Unit
+main =
+  runServer defaultOptions {} siteRouter
+  where
+    siteRouter = router site (postsView :<|> viewPost) onRoutingError
+    onRoutingError status msg = do
+      writeStatus status
+      :*> contentType textHTML
+      :*> closeHeaders
+      :*> respond (maybe "" id msg)

examples/RoutingReaderT.purs

@@ -0,0 +1,46 @@
+module Examples.RoutingReaderT where
+
+import Prelude
+import Control.IxMonad ((:*>))
+import Control.Monad.Aff (Aff)
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE)
+import Control.Monad.Except (ExceptT)
+import Control.Monad.Reader (ReaderT, ask, runReaderT)
+import Data.Maybe (fromMaybe)
+import Hyper.Node.Server (defaultOptionsWithLogging, runServer')
+import Hyper.Response (closeHeaders, respond, writeStatus)
+import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML)
+import Hyper.Routing.Method (Get)
+import Hyper.Routing.Router (RoutingError, router)
+import Node.HTTP (HTTP)
+import Text.Smolder.HTML (p)
+import Text.Smolder.Markup (text)
+import Type.Proxy (Proxy(..))
+
+data Greeting = Greeting String
+
+type Site = Get HTML Greeting
+
+instance encodeHTMLGreeting :: EncodeHTML Greeting where
+  encodeHTML (Greeting g) = p (text g)
+
+runAppM ∷ ∀ e a. String -> ReaderT String (Aff e) a → (Aff e) a
+runAppM = flip runReaderT
+
+site :: Proxy Site
+site = Proxy
+
+greet :: forall m. Monad m => ExceptT RoutingError (ReaderT String m) Greeting
+greet = Greeting <$> ask
+
+main :: forall e. Eff (console :: CONSOLE, http :: HTTP | e) Unit
+main =
+  let app = router site greet onRoutingError
+
+      onRoutingError status msg =
+        writeStatus status
+        :*> closeHeaders
+        :*> respond (fromMaybe "" msg)
+
+  in runServer' defaultOptionsWithLogging {} (runAppM "Hello") app