salvia-extras (empty) → 0.1
raw patch · 6 files changed
+154/−0 lines, 6 filesdep +basedep +clevercssdep +fclabelssetup-changed
Dependencies added: base, clevercss, fclabels, hscolour, salvia
Files
- LICENSE +28/−0
- Setup.lhs +6/−0
- salvia-extras.cabal +17/−0
- src/Network/Salvia/Handler/CleverCSS.hs +29/−0
- src/Network/Salvia/Handler/ExtendedFileSystem.hs +21/−0
- src/Network/Salvia/Handler/HsColour.hs +53/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) Sebastiaan Visser 2008++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++>import Distribution.Simple++>main = defaultMain+
+ salvia-extras.cabal view
@@ -0,0 +1,17 @@+Name: salvia-extras+Version: 0.1+Description: Collection of non-fundamental request handler for the Salvia web server.+Synopsis: Collection of non-fundamental request handler for the Salvia web server.+Category: Network, Web+License: BSD3+License-file: LICENSE+Author: Sebastiaan Visser+Maintainer: sfvisser@cs.uu.nl+Build-Type: Simple+Build-Depends: base >=3.0.0.0, fclabels ==0.1, clevercss ==0.1.1, hscolour ==1.11, salvia ==0.1+GHC-Options: -Wall+HS-Source-Dirs: src+Exposed-modules: Network.Salvia.Handler.CleverCSS,+ Network.Salvia.Handler.ExtendedFileSystem,+ Network.Salvia.Handler.HsColour+
+ src/Network/Salvia/Handler/CleverCSS.hs view
@@ -0,0 +1,29 @@+module Network.Salvia.Handler.CleverCSS (+ hFilterCSS+ , hCleverCSS+ , hParametrizedCleverCSS+ ) where++import Network.Protocol.Uri (Parameters)+import Network.Salvia.Handler.ExtensionDispatcher (hExtension)+import Network.Salvia.Handler.Fallback (hOr)+import Network.Salvia.Handler.File (hFile, hFileFilter)+import Network.Salvia.Handler.PathRouter (hParameters)+import Network.Salvia.Handler.Rewrite (hRewriteExt)+import Network.Salvia.Httpd (Handler)+import Text.CSS.CleverCSS (cleverCSSConvert)++hFilterCSS :: Handler () -> Handler () -> Handler ()+hFilterCSS cssfilter handler = do+ hExtension (Just "css")+ (hFile `hOr` cssfilter)+ handler++hCleverCSS :: Handler ()+hCleverCSS = hParameters >>= hParametrizedCleverCSS++hParametrizedCleverCSS :: Parameters -> Handler ()+hParametrizedCleverCSS p = do+ hRewriteExt (fmap ('c':)) (hFileFilter convert)+ where convert = either id id . flip (cleverCSSConvert "") (map (fmap $ maybe "" id) p)+
+ src/Network/Salvia/Handler/ExtendedFileSystem.hs view
@@ -0,0 +1,21 @@+module Network.Salvia.Handler.ExtendedFileSystem (hExtendedFileSystem) where++import Network.Salvia.Handler.CleverCSS (hFilterCSS, hCleverCSS)+import Network.Salvia.Handler.HsColour (hHighlightHaskell, hHsColour)+import Network.Salvia.Handler.Directory (hDirectoryResource)+import Network.Salvia.Handler.File (hFileResource)+import Network.Salvia.Handler.FileSystem (hFileTypeDispatcher)+import Network.Salvia.Handler.Rewrite (hWithDir)+import Network.Salvia.Httpd (Handler)++hExtendedFileSystem :: FilePath -> Handler ()+hExtendedFileSystem dir =+ hFileTypeDispatcher+ hDirectoryResource+ ( \r -> hHighlightHaskell (hHsColour r)+ $ hWithDir dir+ $ hFilterCSS hCleverCSS+ $ hFileResource r)+ dir++
+ src/Network/Salvia/Handler/HsColour.hs view
@@ -0,0 +1,53 @@+module Network.Salvia.Handler.HsColour (+ hHighlightHaskell+ , hHsColour+ , hHsColourCustomStyle++ , defaultStyleSheet+ ) where++import Data.Record.Label+import Language.Haskell.HsColour.CSS+import Network.Protocol.Http (contentType, utf8)+import Network.Salvia.Handlers+import Network.Salvia.Httpd++hHighlightHaskell :: Handler () -> Handler () -> Handler ()+hHighlightHaskell highlighter = + hExtensionRouter [+ (Just "hs", highlighter)+ , (Just "lhs", highlighter)+ , (Just "ag", highlighter)+ ]++hHsColour :: ResourceHandler ()+hHsColour = hHsColourCustomStyle (Left defaultStyleSheet)++-- Left means direct inclusion of stylesheet, right means link to external+-- stylesheet.++hHsColourCustomStyle :: Either String String -> ResourceHandler ()+hHsColourCustomStyle style r = do+ sendStr (either id makeStyleLink style)+ hFileResourceFilter (hscolour False True "") r+ setM (contentType % response) ("text/html", Just utf8)++makeStyleLink :: String -> String+makeStyleLink css = "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ css ++ "\"></link>"++defaultStyleSheet :: String+defaultStyleSheet = filter (/=' ') $ concat [+ "<style>"+ , ".varop { color : #960; font-weight : normal; }"+ , ".keyglyph { color : #960; font-weight : normal; }"+ , ".definition { color : #005; font-weight : bold; }"+ , ".varid { color : #444; font-weight : normal; }"+ , ".keyword { color : #000; font-weight : bold; }"+ , ".comment { color : #44f; font-weight : normal; }"+ , ".conid { color : #000; font-weight : normal; }"+ , ".num { color : #00a; font-weight : normal; }"+ , ".str { color : #a00; font-weight : normal; }"+ , "</style>"+ , ""+ ]+