{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE OverloadedStrings, UnicodeSyntax, CPP #-} module Main (main) where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif import Control.Exception import Data.Microformats2.Parser import Data.List import Data.Maybe (fromMaybe) import Data.Aeson.Encode.Pretty import Data.Aeson.Types (object) import Data.Default import qualified Data.Text.Lazy as TL import Data.Streaming.Network (bindPath) import qualified Data.Stringable as S import Network.Wai.Handler.Warp import qualified Network.Wai.Handler.CGI as CGI import Network.Wai.Middleware.Autohead import qualified Network.Socket as S import Network.URI (parseURI) import Web.Scotty import Text.Blaze.Html5 as H hiding (main, param, object) import Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import qualified Options as O data AppOptions = AppOptions { port ∷ Int , socket ∷ String , protocol ∷ String } instance O.Options AppOptions where defineOptions = pure AppOptions <*> O.simpleOption "port" 3000 "The port the app should listen for connections on (for http protocol)" <*> O.simpleOption "socket" "/var/run/mf2/mf2.sock" "The UNIX domain socket the app should listen for connections on (for unix protocol)" <*> O.simpleOption "protocol" "http" "The protocol for the server. One of: http, unix, cgi" exampleValue = "

17 Austerstræti Reykjavík Iceland 107

Mitchell Baker (Mozilla Foundation)

Microformats are amazing

Published by W. Developer on

In which I extoll the virtues of using microformats.

Blah blah blah

AUTHOR: TITLE " homePage ∷ TL.Text → Html homePage v = docTypeHtml $ do H.head $ do H.meta ! charset "utf-8" H.title "microformats2-parser" H.style "body { font-family: 'Helvetica Neue', sans-serif; max-width: 900px; margin: 0 auto; } a { color: #ba2323; } a:hover { color: #da4343; } pre, input, textarea, button { width: 100%; } input, textarea { margin-bottom: 1em; } textarea { resize: vertical; min-height: 15em; } pre { white-space: pre-wrap; } footer { margin: 2em 0; }" H.body $ do H.header $ do h1 $ do a ! href "https://github.com/myfreeweb/microformats2-parser" $ "microformats2-parser" a ! href "https://github.com/myfreeweb/microformats2-parser" $ img ! alt "GitHub" ! src "https://img.shields.io/badge/git-hub-gray.svg?style=flat" " " a ! href "https://hackage.haskell.org/package/microformats2-parser" $ img ! alt "Hackage" ! src "https://img.shields.io/hackage/v/microformats2-parser.svg?style=flat" " " a ! href "https://travis-ci.org/myfreeweb/microformats2-parser" $ img ! alt "Build Status" ! src "https://img.shields.io/travis/myfreeweb/microformats2-parser.svg?style=flat" " " a ! href "http://unlicense.org" $ img ! alt "unlicense" ! src "https://img.shields.io/badge/un-license-green.svg?style=flat" p "This is a test page for the Microformats 2 Haskell parser." p "Notes:" ul $ do li "this demo page uses the Sanitize mode for e-*" li $ do a ! href "http://enable-cors.org" $ "CORS is enabled" " on the endpoint (POST parse.json, form-urlencoded, 'html' and 'base' parameter)" li $ a ! href "http://jsonview.com" $ "JSONView is awesome" H.form ! method "post" ! action "parse.json" $ do textarea ! name "html" $ toHtml v input ! name "base" ! type_ "url" ! placeholder "https://example.com/base/url/for/resolving/relative/urls" button "Parse!" footer $ do a ! href "https://unrelenting.technology" ! rel "author" $ "unrelenting.technology" app = scottyApp $ do middleware autohead get "/" $ do setHeader "Content-Type" "text/html; charset=utf-8" raw $ renderHtml $ homePage exampleValue get "/parse.json" $ do setHeader "Access-Control-Allow-Origin" "*" json $ object [] post "/parse.json" $ do html ← param "html" base ← param "base" `rescue` (\_ → return "") setHeader "Content-Type" "application/json; charset=utf-8" setHeader "Access-Control-Allow-Origin" "*" let root = documentRoot $ parseLBS html raw $ encodePretty $ parseMf2 (def { baseUri = parseURI base }) root main = O.runCommand $ \opts args → do let warpSettings = setPort (port opts) defaultSettings case protocol opts of "http" → app >>= runSettings warpSettings "unix" → bracket (bindPath $ socket opts) S.close (\socket → app >>= runSettingsSocket warpSettings socket) "cgi" → app >>= CGI.run _ → putStrLn $ "Unsupported protocol: " ++ protocol opts