snaplet-css-min (empty) → 0.1.0

raw patch · 4 files changed

+182/−0 lines, 4 filesdep +basedep +bytestringdep +css-textsetup-changed

Dependencies added: base, bytestring, css-text, directory, filepath, lens, mtl, snap, snap-core, text, transformers, utf8-string

Files

LICENSE +19/−0
Setup.hs +2/−0
snaplet-css-min.cabal +54/−0
src/Snap/Snaplet/CSS/Minify.hs +107/−0

+ LICENSE view

@@ -0,0 +1,19 @@+Copyright (c) 2014 Timothy Jones++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ snaplet-css-min.cabal view

@@ -0,0 +1,54 @@+name:          snaplet-css-min+version:       0.1.0+license:       MIT+license-file:  LICENSE+author:        Timothy Jones+maintainer:    Timothy Jones <git@zmthy.io>+homepage:      https://github.com/zmthy/snaplet-css-min+bug-reports:   https://github.com/zmthy/snaplet-css-min/issues+copyright:     (c) 2014 Timothy Jones+category:      Web+build-type:    Simple+cabal-version: >= 1.10+synopsis:      A Snaplet for CSS minification+description:+  A Snaplet for minifying and caching CSS files.+  .+  Nest this Snaplet inside your own, and place your CSS files in+  @snaplets/css-min@.+  .+  The minifier just parses and renders the contents of the files with+  @css-text@, so the minification is not complete. It will remove most+  whitespace, though.++library+  hs-source-dirs:   src+  default-language: Haskell2010++  default-extensions:+    OverloadedStrings++  other-extensions:+    DeriveDataTypeable++  exposed-modules:+    Snap.Snaplet.CSS.Minify++  build-depends:+    base         >= 4.6    && < 5,+    bytestring   >= 0.10   && < 0.11,+    css-text     >= 0.1.2  && < 0.2,+    directory    >= 1.2    && < 2,+    filepath     >= 1.3    && < 2,+    lens         >= 3.9.2  && < 5,+    mtl          >= 2.1    && < 3,+    snap         >= 0.13.1 && < 0.14,+    snap-core    >= 0.9.3  && < 0.10,+    text         >= 0.11.3 && < 0.12,+    transformers >= 0.3.0  && < 0.4,+    utf8-string  >= 0.3    && < 0.4++source-repository head+  type:     git+  location: git://github.com/zmthy/http-media.git+

+ src/Snap/Snaplet/CSS/Minify.hs view

@@ -0,0 +1,107 @@+{-# LANGUAGE DeriveDataTypeable #-}++------------------------------------------------------------------------------+-- | Nest this Snaplet within another to have it retrieve and minify the CSS+-- in its directory.+--+-- First, embed this Snaplet in your application:+--+-- > import Snap.Snaplet.CSS.Minify+-- >+-- > data App = App { cssMin :: Snaplet CssMin, ... }+--+-- Then nest this Snaplet in your initializer at the route you want your+-- stylesheets to be available at:+--+-- > nestSnaplet "style" cssMin cssMinInit+--+-- The stylesheets in @snaplets/css-min@ will now be available in minified+-- form at the @/style@ route.+--+-- To have the files reloaded in development mode add @\"snaplets/css-min\"@+-- to the list of watched directories in the Main module generated by Snap.+module Snap.Snaplet.CSS.Minify+    ( CssMin+    , cssMinInit+    , ParseException+    ) where++------------------------------------------------------------------------------+import qualified Data.Text              as T+import qualified Data.Text.IO           as T+import qualified Data.Text.Lazy         as LT+import qualified Data.Text.Lazy.Builder as LT+import qualified Data.ByteString.UTF8   as BS++------------------------------------------------------------------------------+import Control.Applicative    ((<$), (<$>), (<*>))+import Control.Exception      (Exception (..), SomeException (..), throw)+import Control.Lens           (Lens', (<&>), over, view)+import Control.Monad          (unless)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.State    (get, modify)+import Data.List              (isSuffixOf)+import Data.Text              (Text)+import Data.Typeable          (Typeable, cast)+import Snap.Core+import Snap.Snaplet+import System.FilePath        ((</>))+import System.Directory       (doesFileExist)+import Text.CSS.Parse         (NestedBlock, parseNestedBlocks)+import Text.CSS.Render        (renderNestedBlocks)+++------------------------------------------------------------------------------+-- | The Snaplet's state, storing the cache of minified files.+data CssMin = CssMin { _cache :: [(FilePath, Text)] }++cache :: Lens' CssMin [(FilePath, Text)]+cache f m = f (_cache m) <&> \ c -> m { _cache = c }+++------------------------------------------------------------------------------+-- | Initializes the CSS minifier by adding a route for reading, minifying and+-- serving the CSS files in the snaplet/css-min directory.+cssMinInit :: SnapletInit b CssMin+cssMinInit = makeSnaplet "css-min" "CSS minifier" Nothing $+    CssMin [] <$ addRoutes [("", serveCss)]++serveCss :: Handler b CssMin ()+serveCss = do+    fp <- (</>) <$> getSnapletFilePath <*>+        (BS.toString . rqPathInfo <$> getRequest)+    liftIO (doesFileExist fp) >>=+        flip unless pass . (".css" `isSuffixOf` fp &&)+    view cache <$> get >>= maybe (minify fp) writeCss . lookup fp++minify :: FilePath -> Handler b CssMin ()+minify fp = parseNestedBlocks <$>+    (getSnapletFilePath >>= liftIO . T.readFile . (</> fp)) >>=+        either (throw . ParseException) (cacheAndWrite fp)++cacheAndWrite :: FilePath -> [NestedBlock] -> Handler b CssMin ()+cacheAndWrite fp css = do+    let text = LT.toStrict $ LT.toLazyText $ renderNestedBlocks css+    modify $ over cache ((fp, text) :)+    writeCss text++writeCss :: Text -> Handler b v ()+writeCss css = do+    modifyResponse+        $ setContentLength (fromIntegral $ T.length css)+        . setContentType "text/css"+        . setResponseCode 200+    writeText css+++------------------------------------------------------------------------------+data ParseException = ParseException String+    deriving (Typeable)++instance Show ParseException where+    show (ParseException msg) = "CSS parse exception: " ++ msg++instance Exception ParseException where+    toException = SomeException+    fromException = cast+