{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax #-} module Main (main) where import Prelude.Compat 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 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