yesod-static (empty) → 0.0.0

raw patch · 5 files changed

+285/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, base64-bytestring, bytestring, cereal, directory, pureMD5, template-haskell, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers, wai-app-static, web-routes, yesod-core

Files

• LICENSE +25/−0
• Setup.lhs +7/−0
• Yesod/Helpers/Static.hs +198/−0
• runtests.hs +6/−0
• yesod-static.cabal +49/−0

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 COPYRIGHT HOLDERS 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.

@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,198 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+---------------------------------------------------------+--+-- Module        : Yesod.Helpers.Static+-- Copyright     : Michael Snoyman+-- License       : BSD3+--+-- Maintainer    : Michael Snoyman <michael@snoyman.com>+-- Stability     : Unstable+-- Portability   : portable+--++-- | Serve static files from a Yesod app.+--+-- This is most useful for standalone testing. When running on a production+-- server (like Apache), just let the server do the static serving.+--+-- In fact, in an ideal setup you'll serve your static files from a separate+-- domain name to save time on transmitting cookies. In that case, you may wish+-- to use 'urlRenderOverride' to redirect requests to this subsite to a+-- separate domain name.+module Yesod.Helpers.Static+    ( -- * Subsite+      Static (..)+    , StaticRoute (..)+      -- * Smart constructor+    , static+      -- * Template Haskell helpers+    , staticFiles+    {-+      -- * Embed files+    , getStaticHandler+    -}+      -- * Hashing+    , base64md5+#if TEST+    , testSuite+#endif+    ) where++import System.Directory+import Control.Monad++import Yesod.Handler+import Yesod.Core++import Data.List (intercalate)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax++import qualified Data.ByteString.Lazy as L+import Data.Digest.Pure.MD5+import qualified Data.ByteString.Base64+import qualified Data.ByteString.Char8 as S8+import qualified Data.Serialize++import Network.Wai.Application.Static+    ( defaultMimeTypeByExt, StaticSettings (..), staticAppPieces+    , defaultListing+    )++#if TEST+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+#endif++newtype Static = Static StaticSettings++-- | Default value of 'Static' for a given file folder.+--+-- Does not have index files, uses default directory listings and default mime+-- type list.+static :: FilePath -> Static+static fp = Static $ StaticSettings fp [] (Just defaultListing)+                     (return . defaultMimeTypeByExt)++-- | Manually construct a static route.+-- The first argument is a sub-path to the file being served whereas the second argument is the key value pairs in the query string.+-- For example,+-- > StaticRoute $ StaticR ["thumb001.jpg"] [("foo", "5"), ("bar", "choc")]+-- would generate a url such as 'http://site.com/static/thumb001.jpg?foo=5&bar=choc'+-- The StaticRoute constructor can be used when url's cannot be statically generated at compile-time.+-- E.g. When generating image galleries.+data StaticRoute = StaticRoute [String] [(String, String)]+    deriving (Eq, Show, Read)++type instance Route Static = StaticRoute++instance RenderRoute StaticRoute where+    renderRoute (StaticRoute x y) = (x, y)++instance Yesod master => YesodDispatch Static master where+    yesodDispatch (Static set) _ pieces  _ _ =+        Just $ staticAppPieces set pieces++{- FIXME+-- | Dispatch static route for a subsite+--+-- Subsites with static routes can't (yet) define Static routes the same way "master" sites can.+-- Instead of a subsite route:+-- /static StaticR Static getStatic+-- Use a normal route:+-- /static/*Strings StaticR GET+--+-- Then, define getStaticR something like:+-- getStaticR = getStaticHandler ($(mkEmbedFiles "static") typeByExt) StaticR+-- */ end CPP comment+getStaticHandler :: Static -> (StaticRoute -> Route sub) -> [String] -> GHandler sub y ChooseRep+getStaticHandler static toSubR pieces = do+  toMasterR <- getRouteToMaster   +  toMasterHandler (toMasterR . toSubR) toSub route handler+  where route = StaticRoute pieces []+        toSub _ = static+        staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep))+        handler = fromMaybe notFound $ handleSite staticSite undefined route "GET"+-}++notHidden :: FilePath -> Bool+notHidden ('.':_) = False+notHidden "tmp" = False+notHidden _ = True++getFileList :: FilePath -> IO [[String]]+getFileList = flip go id+  where+    go :: String -> ([String] -> [String]) -> IO [[String]]+    go fp front = do+        allContents <- filter notHidden `fmap` getDirectoryContents fp+        let fullPath :: String -> String+            fullPath f = fp ++ '/' : f+        files <- filterM (doesFileExist . fullPath) allContents+        let files' = map (front . return) files+        dirs <- filterM (doesDirectoryExist . fullPath) allContents+        dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs+        return $ concat $ files' : dirs'++-- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create:+--+-- > style_css = StaticRoute ["style.css"] []+-- > js_script_js = StaticRoute ["js/script.js"] []+staticFiles :: FilePath -> Q [Dec]+staticFiles fp = do+    fs <- qRunIO $ getFileList fp+    concat `fmap` mapM go fs+  where+    replace' c+        | 'A' <= c && c <= 'Z' = c+        | 'a' <= c && c <= 'z' = c+        | '0' <= c && c <= '9' = c+        | otherwise = '_'+    go f = do+        let name = mkName $ intercalate "_" $ map (map replace') f+        f' <- lift f+        let sr = ConE $ mkName "StaticRoute"+        hash <- qRunIO $ fmap base64md5 $ L.readFile $ fp ++ '/' : intercalate "/" f+        let qs = ListE [TupE [LitE $ StringL hash, ListE []]]+        return+            [ SigD name $ ConT ''Route `AppT` ConT ''Static+            , FunD name+                [ Clause [] (NormalB $ sr `AppE` f' `AppE` qs) []+                ]+            ]++#if TEST++testSuite :: Test+testSuite = testGroup "Yesod.Helpers.Static"+    [ testCase "get file list" caseGetFileList+    ]++caseGetFileList :: Assertion+caseGetFileList = do+    x <- getFileList "test"+    x @?= [["foo"], ["bar", "baz"]]++#endif++-- | md5-hashes the given lazy bytestring and returns the hash as+-- base64url-encoded string.+--+-- This function returns the first 8 characters of the hash.+base64md5 :: L.ByteString -> String+base64md5 = map go+          . take 8+          . S8.unpack+          . Data.ByteString.Base64.encode+          . Data.Serialize.encode+          . md5+  where+    go '+' = '-'+    go '/' = '_'+    go c   = c

@@ -0,0 +1,6 @@+import Test.Framework (defaultMain)++import Yesod.Helpers.Static++main :: IO ()+main = defaultMain [testSuite]

@@ -0,0 +1,49 @@+name:            yesod-static+version:         0.0.0+license:         BSD3+license-file:    LICENSE+author:          Michael Snoyman <michael@snoyman.com>+maintainer:      Michael Snoyman <michael@snoyman.com>+synopsis:        Static file serving subsite for Yesod Web Framework.+category:        Web, Yesod+stability:       Stable+cabal-version:   >= 1.6+build-type:      Simple+homepage:        http://docs.yesodweb.com/++flag test+  description: Build the executable to run unit tests+  default: False++library+    build-depends:   base                      >= 4        && < 5+                   , yesod-core                >= 0.7      && < 0.8+                   , base64-bytestring         >= 0.1.0.1  && < 0.2+                   , pureMD5                   >= 2.1.0.3  && < 2.2+                   , cereal                    >= 0.3      && < 0.4+                   , bytestring                >= 0.9      && < 0.10+                   , web-routes                >= 0.23     && < 0.24+                   , template-haskell+                   , directory                 >= 1.0      && < 1.2+                   , transformers              >= 0.2      && < 0.3+                   , wai-app-static            >= 0.0.1    && < 0.1+    exposed-modules: Yesod.Helpers.Static+    ghc-options:     -Wall++executable             runtests+    if flag(test)+        Buildable: True+        cpp-options:   -DTEST+        build-depends: test-framework,+                       test-framework-quickcheck2,+                       test-framework-hunit,+                       HUnit,+                       QuickCheck >= 2 && < 3+    else+        Buildable: False+    ghc-options:     -Wall+    main-is:         runtests.hs++source-repository head+  type:     git+  location: git://github.com/snoyberg/yesod-static.git