servius 1.1.1.2 → 1.2.0.0
raw patch · 6 files changed
+113/−145 lines, 6 filesdep +markdowndep +shakespearedep −cmdargsdep −containersdep −directorydep ~basedep ~blaze-builderdep ~blaze-htmlsetup-changed
Dependencies added: markdown, shakespeare
Dependencies removed: cmdargs, containers, directory, hamlet, mime-types, shakespeare-css, transformers, wai-extra, warp
Dependency ranges changed: base, blaze-builder, blaze-html, bytestring, http-types, text, wai, wai-app-static
Files
- LICENSE +1/−1
- Setup.hs +2/−0
- Setup.lhs +0/−7
- app/servius.hs +77/−0
- servius.cabal +33/−34
- servius.hs +0/−103
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/+Copyright (c) 2015 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,7 +0,0 @@-#!/usr/bin/env runhaskell--> module Main where-> import Distribution.Simple--> main :: IO ()-> main = defaultMain
+ app/servius.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Main (main) where++import Blaze.ByteString.Builder.Char.Utf8 (fromLazyText)+import qualified Data.ByteString.Char8 as S8+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import qualified Data.Text.Lazy as TL+import Network.HTTP.Types (status200)+import Network.Wai (Middleware, Response,+ pathInfo, responseBuilder)+import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)+import Text.Hamlet (defaultHamletSettings)+import Text.Hamlet.RT (parseHamletRT,+ renderHamletRT)+import Text.Lucius (luciusRT)+import Text.Markdown (def, msXssProtect, msAddHeadingId, markdown)+import WaiAppStatic.CmdLine (docroot, runCommandLine)++main :: IO ()+main = runCommandLine (shake . docroot)++shake :: FilePath -> Middleware+shake docroot app req respond+ | any unsafe p = app req respond+ | null p = app req respond+ | ".hamlet" `T.isSuffixOf` l = hamlet pr >>= respond+ | ".lucius" `T.isSuffixOf` l = lucius pr >>= respond+ | ".markdown" `T.isSuffixOf` l = markdown' pr >>= respond+ | ".md" `T.isSuffixOf` l = markdown' pr >>= respond+ | otherwise = app req respond+ where+ p = pathInfo req+ pr = T.intercalate "/" $ T.pack docroot : p+ l = last p++unsafe :: Text -> Bool+unsafe s+ | T.null s = False+ | T.head s == '.' = True+ | otherwise = T.any (== '/') s++readFileUtf8 :: Text -> IO String+readFileUtf8 fp = do+ bs <- S8.readFile $ T.unpack fp+ let t = decodeUtf8With lenientDecode bs+ return $ T.unpack t++hamlet :: Text -> IO Response+hamlet fp = do+ str <- readFileUtf8 fp+ hrt <- parseHamletRT defaultHamletSettings str+ html <- renderHamletRT hrt [] (error "No URLs allowed")+ return $ responseBuilder status200 [("Content-Type", "text/html; charset=utf-8")] $ renderHtmlBuilder html++lucius :: Text -> IO Response+lucius fp = do+ str <- readFileUtf8 fp+ let text = either error id $ luciusRT (TL.pack str) []+ return $ responseBuilder status200 [("Content-Type", "text/css; charset=utf-8")] $ fromLazyText text++markdown' :: Text -> IO Response+markdown' fp = do+ bs <- S8.readFile $ T.unpack fp+ let t = decodeUtf8With lenientDecode bs+ html = markdown settings $ TL.fromStrict t+ return $ responseBuilder status200 [("Content-Type", "text/html; charset=utf-8")] $ renderHtmlBuilder html+ where+ settings = def+ { msXssProtect = False+ , msAddHeadingId = True+ }
servius.cabal view
@@ -1,37 +1,36 @@-Name: servius-Version: 1.1.1.2-Synopsis: Serve Shakespearean templates via Warp (deprecated)-Homepage: http://github.com/yesodweb/hamlet-License: MIT-License-file: LICENSE-Author: Michael Snoyman-Maintainer: michael@snoyman.com-Category: Web-Build-type: Simple-Cabal-version: >=1.6-Description: Does not support any variable interpolation. Supports Hamlet and Lucius files (must have .hamlet and .lucius file extensions, respectively).+name: servius+version: 1.2.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: 2015 Michael Snoyman+maintainer: michael@snoyman.com+homepage: http://github.com/snoyberg/servius#readme+synopsis: Warp web server with template rendering+description:+ Please see README.md+category: Web+author: Michael Snoyman +source-repository head+ type: git+ location: https://github.com/snoyberg/servius -Executable servius- Main-is: servius.hs- Build-depends: base >= 4 && < 5- , warp >= 1.3 && < 2.2- , wai-app-static >= 1.3 && < 2.1- , wai-extra >= 1.3 && < 2.2- , cmdargs >= 0.6.7- , directory >= 1.0- , containers >= 0.2- , bytestring >= 0.9.1.4- , text >= 0.7- , blaze-builder- , blaze-html >= 0.5- , http-types- , hamlet >= 1.1 && < 1.2- , shakespeare-css >= 1.0 && < 1.1- , transformers- , wai >= 1.3 && < 2.2- , mime-types >= 0.1 && < 0.2+executable servius+ main-is: servius.hs+ build-depends:+ base >=4.8.1.0 && <4.9,+ blaze-builder >=0.4.0.1 && <0.5,+ blaze-html >=0.8.1.1 && <0.9,+ bytestring >=0.10.6.0 && <0.11,+ http-types >=0.8.6 && <0.9,+ markdown >=0.1.13.2 && <0.2,+ shakespeare >=2.0.6 && <2.1,+ text >=1.2.1.3 && <1.3,+ wai >=3.0.4.0 && <3.1,+ wai-app-static >=3.1.1 && <3.2+ default-language: Haskell2010+ hs-source-dirs: app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -source-repository head- type: git- location: git://github.com/yesodweb/shakespeare.git
− servius.hs
@@ -1,103 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)-import Network.Wai.Handler.Warp (run)-import System.Console.CmdArgs hiding (def)-import Text.Printf (printf)-import System.Directory (canonicalizePath)-import Control.Monad (unless)-import Network.Wai.Middleware.Autohead-import Network.Wai.Middleware.RequestLogger-import Network.Wai.Middleware.Gzip-import qualified Data.Map as Map-import qualified Data.ByteString.Char8 as S8-import Control.Arrow ((***))-import Data.Text (Text, pack)-import qualified Data.Text as T-import Network.Wai-import Control.Monad.IO.Class (liftIO)-import Data.Text.Encoding (decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import Text.Lucius (luciusRT)-import Text.Hamlet (defaultHamletSettings)-import Text.Hamlet.RT (parseHamletRT, renderHamletRT)-import Network.HTTP.Types (status200)-import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)-import qualified Data.Text.Lazy as TL-import Blaze.ByteString.Builder.Char.Utf8 (fromLazyText)-import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)-import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)-import Data.String (fromString)-import Data.Maybe (mapMaybe)--data Args = Args- { docroot :: FilePath- , index :: [FilePath]- , port :: Int- , noindex :: Bool- , quiet :: Bool- , verbose :: Bool- , mime :: [(String, String)]- }- deriving (Show, Data, Typeable)--defaultArgs :: Args-defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False []--main :: IO ()-main = do- Args {..} <- cmdArgs defaultArgs- let mime' = map (pack *** S8.pack) mime- let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap- docroot' <- canonicalizePath docroot- unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)- let middle = gzip def- . (if verbose then logStdoutDev else id)- . autohead- . shake docroot- run port $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)- { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index- , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fromPiece . fileName- }--shake :: FilePath -> Middleware-shake docroot app req- | any unsafe p = app req- | null p = app req- | ".hamlet" `T.isSuffixOf` l = liftIO $ hamlet pr- | ".lucius" `T.isSuffixOf` l = liftIO $ lucius pr- | otherwise = app req- where- p = pathInfo req- pr = T.intercalate "/" $ T.pack docroot : p- l = last p--unsafe :: Text -> Bool-unsafe s- | T.null s = False- | T.head s == '.' = True- | otherwise = T.any (== '/') s--readFileUtf8 :: Text -> IO String-readFileUtf8 fp = do- bs <- S8.readFile $ T.unpack fp- let t = decodeUtf8With lenientDecode bs- return $ T.unpack t--#if MIN_VERSION_wai(2, 0, 0)-#define ResponseBuilder responseBuilder-#endif--hamlet :: Text -> IO Response-hamlet fp = do- str <- readFileUtf8 fp- hrt <- parseHamletRT defaultHamletSettings str- html <- renderHamletRT hrt [] (error "No URLs allowed")- return $ ResponseBuilder status200 [("Content-Type", "text/html; charset=utf-8")] $ renderHtmlBuilder html--lucius :: Text -> IO Response-lucius fp = do- str <- readFileUtf8 fp- let text = either error id $ luciusRT (TL.pack str) []- return $ ResponseBuilder status200 [("Content-Type", "text/css; charset=utf-8")] $ fromLazyText text