wai-middleware-content-type 0.0.3.2 → 0.0.3.3

raw patch · 5 files changed

+131/−2 lines, 5 filesdep +pandocsetup-changedPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: pandoc

API changes (from Hackage documentation)

Files

• Setup.hs +52/−0
• src/Network/Wai/Middleware/ContentType.hs +1/−0
• src/Network/Wai/Middleware/ContentType/Pandoc.hs +70/−0
• src/Network/Wai/Middleware/ContentType/Types.hs +4/−1
• wai-middleware-content-type.cabal +4/−1

@@ -0,0 +1,52 @@+import Distribution.Simple+import Distribution.Simple.PreProcess+import Distribution.Simple.Setup (ConfigFlags(..))+import Distribution.PackageDescription (PackageDescription(..), FlagName(..))+import Distribution.Simple.Utils ( rawSystemExitCode, findProgramVersion )+import System.Exit+import Distribution.Verbosity ( Verbosity )+import Distribution.Simple.Utils (info, notice, installOrdinaryFiles)+import Distribution.Simple.Setup+import Distribution.Simple.Program (simpleProgram, Program(..))+import Distribution.Simple.LocalBuildInfo+import Data.Version+import Control.Monad (when)+import qualified Control.Exception as E++main :: IO ()+main = defaultMainWithHooks $ simpleUserHooks {+      -- enable hsb2hs preprocessor for .hsb files+      hookedPreProcessors = [ppBlobSuffixHandler]+    , hookedPrograms = [(simpleProgram "hsb2hs"){+                           programFindVersion = \verbosity fp ->+                             findProgramVersion "--version" id verbosity fp }]+    , postCopy = installManPage+    }++ppBlobSuffixHandler :: PPSuffixHandler+ppBlobSuffixHandler = ("hsb", \_ lbi ->+  PreProcessor {+    platformIndependent = True,+    runPreProcessor = mkSimplePreProcessor $ \infile outfile verbosity ->+      do let embedData = case lookup (FlagName "embed_data_files")+                              (configConfigurationsFlags (configFlags lbi)) of+                              Just True -> True+                              _         -> False+         when embedData $+            do info verbosity $ "Preprocessing " ++ infile ++ " to " ++ outfile+               ec <- rawSystemExitCode verbosity "hsb2hs"+                          [infile, infile, outfile]+               case ec of+                    ExitSuccess   -> return ()+                    ExitFailure _ -> error "hsb2hs is needed to build this program"+  })++installManPage :: Args -> CopyFlags+               -> PackageDescription -> LocalBuildInfo -> IO ()+installManPage _ flags pkg lbi = do+  let verbosity = fromFlag (copyVerbosity flags)+  let copydest  = fromFlag (copyDest flags)+  let mandest   = mandir (absoluteInstallDirs pkg lbi copydest)+                     ++ "/man1"+  notice verbosity $ "Copying man page to " ++ mandest+  installOrdinaryFiles verbosity mandest [("man", "wai-middleware-content-type.1")]

@@ -91,6 +91,7 @@     sortFE Json       xs = [Json, JavaScript, Text] `intersect` xs     sortFE Css        xs = [Css, Text]              `intersect` xs     sortFE Text       xs = [Text]                   `intersect` xs+    sortFE Markdown   xs = [Markdown, Text]         `intersect` xs   

@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Middleware.ContentType.Pandoc where++import           Network.Wai.Middleware.ContentType.Types+import           Network.Wai.Middleware.ContentType.ByteString+import           Network.HTTP.Types                      (RequestHeaders, Status, status200)+import           Network.Wai.Trans++import qualified Data.Text.Lazy                           as LT+import qualified Data.Text.Lazy.Encoding                  as LT+import qualified Text.Pandoc                              as P+import           Control.Monad.Trans++++-- | Uses the @Html@ key in the map, and @"text/html"@ as the content type.+lucid :: MonadIO m => P.Pandoc -> FileExtListenerT (MiddlewareT m) m ()+lucid = lucidStatusHeaders status200 [("Content-Type", "text/markdown")]++lucidWith :: MonadIO m =>+             (Response -> Response) -> P.Pandoc+          -> FileExtListenerT (MiddlewareT m) m ()+lucidWith f = lucidStatusHeadersWith f status200 [("Content-Type", "text/markdown")]++lucidStatus :: MonadIO m =>+               Status -> P.Pandoc+            -> FileExtListenerT (MiddlewareT m) m ()+lucidStatus s = lucidStatusHeaders s [("Content-Type", "text/markdown")]++lucidStatusWith :: MonadIO m =>+                   (Response -> Response) -> Status -> P.Pandoc+                -> FileExtListenerT (MiddlewareT m) m ()+lucidStatusWith f s = lucidStatusHeadersWith f s [("Content-Type", "text/markdown")]++lucidHeaders :: MonadIO m =>+                RequestHeaders -> P.Pandoc+             -> FileExtListenerT (MiddlewareT m) m ()+lucidHeaders = lucidStatusHeaders status200++lucidHeadersWith :: MonadIO m =>+                    (Response -> Response) -> RequestHeaders -> P.Pandoc+                 -> FileExtListenerT (MiddlewareT m) m ()+lucidHeadersWith f = lucidStatusHeadersWith f status200++lucidStatusHeaders :: MonadIO m =>+                      Status -> RequestHeaders -> P.Pandoc+                   -> FileExtListenerT (MiddlewareT m) m ()+lucidStatusHeaders = lucidStatusHeadersWith id++lucidStatusHeadersWith :: MonadIO m =>+                          (Response -> Response) -> Status -> RequestHeaders -> P.Pandoc+                       -> FileExtListenerT (MiddlewareT m) m ()+lucidStatusHeadersWith f s hs i = do+  bytestringStatusWith f Html s hs . LT.encodeUtf8 . LT.pack $ P.writeMarkdown P.def i+++++lucidOnly :: P.Pandoc -> Response+lucidOnly = lucidOnlyStatusHeaders status200 [("Content-Type", "text/markdown")]++lucidOnlyStatus :: Status -> P.Pandoc -> Response+lucidOnlyStatus s = lucidOnlyStatusHeaders s [("Content-Type", "text/markdown")]++lucidOnlyHeaders :: RequestHeaders -> P.Pandoc -> Response+lucidOnlyHeaders = lucidOnlyStatusHeaders status200++lucidOnlyStatusHeaders :: Status -> RequestHeaders -> P.Pandoc -> Response+lucidOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs . LT.encodeUtf8 . LT.pack $ P.writeMarkdown P.def i

@@ -53,6 +53,7 @@              | JavaScript              | Json              | Text+             | Markdown   deriving (Show, Eq, Ord)  @@ -77,13 +78,15 @@         | x `elem` javascripts = Just JavaScript         | x `elem` jsons       = Just Json         | x `elem` texts       = Just Text-        | otherwise       = Nothing+        | x `elem` markdowns   = Just Markdown+        | otherwise            = Nothing   where     htmls       = [".htm", ".html"]     csss        = [".css"]     javascripts = [".js", ".javascript"]     jsons       = [".json"]     texts       = [".txt"]+    markdowns   = [".md", ".markdown"]  newtype FileExts a = FileExts { unFileExts :: Map FileExt a }   deriving (Show, Eq, Monoid, Functor, Foldable, Traversable)

@@ -1,5 +1,5 @@ Name:                   wai-middleware-content-type-Version:                0.0.3.2+Version:                0.0.3.3 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -8,6 +8,7 @@ -- Description: Cabal-Version:          >= 1.10 Build-Type:             Simple+Category:               Web  Library   Default-Language:     Haskell2010@@ -24,6 +25,7 @@                         Network.Wai.Middleware.ContentType.Julius                         Network.Wai.Middleware.ContentType.Lucid                         Network.Wai.Middleware.ContentType.Lucius+                        Network.Wai.Middleware.ContentType.Pandoc                         Network.Wai.Middleware.ContentType.Text                         Network.Wai.Middleware.ContentType.Middleware   Build-Depends:        base >= 4.8 && < 5@@ -41,6 +43,7 @@                       , monad-control                       , monad-logger                       , mtl+                      , pandoc                       , resourcet                       , shakespeare                       , text