Removed extraneous modules, Yesod.Yesod -> Yesod.Core
This commit is contained in:
Michael Snoyman
parent
fccefcd1dd
commit
a9e713921e
48
Yesod.hs
48
Yesod.hs
@ -1,48 +0,0 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
-- | This module simply re-exports from other modules for your convenience.
|
|
||||||
module Yesod
|
|
||||||
( module Yesod.Request
|
|
||||||
, module Yesod.Content
|
|
||||||
, module Yesod.Yesod
|
|
||||||
, module Yesod.Handler
|
|
||||||
, module Yesod.Dispatch
|
|
||||||
, module Yesod.Hamlet
|
|
||||||
, module Yesod.Widget
|
|
||||||
, Application
|
|
||||||
, lift
|
|
||||||
, liftIO
|
|
||||||
, MonadPeelIO
|
|
||||||
, mempty
|
|
||||||
, showIntegral
|
|
||||||
, readIntegral
|
|
||||||
) where
|
|
||||||
|
|
||||||
#if TEST
|
|
||||||
import Yesod.Content hiding (testSuite)
|
|
||||||
import Yesod.Dispatch hiding (testSuite)
|
|
||||||
import Yesod.Yesod hiding (testSuite)
|
|
||||||
import Yesod.Handler hiding (runHandler, testSuite)
|
|
||||||
#else
|
|
||||||
import Yesod.Content
|
|
||||||
import Yesod.Dispatch
|
|
||||||
import Yesod.Yesod
|
|
||||||
import Yesod.Handler hiding (runHandler)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import Yesod.Request
|
|
||||||
import Yesod.Widget
|
|
||||||
import Network.Wai (Application)
|
|
||||||
import Yesod.Hamlet
|
|
||||||
import Control.Monad.Trans.Class (lift)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Data.Monoid (mempty)
|
|
||||||
import Control.Monad.IO.Peel (MonadPeelIO)
|
|
||||||
|
|
||||||
showIntegral :: Integral a => a -> String
|
|
||||||
showIntegral x = show (fromIntegral x :: Integer)
|
|
||||||
|
|
||||||
readIntegral :: Num a => String -> Maybe a
|
|
||||||
readIntegral s =
|
|
||||||
case reads s of
|
|
||||||
(i, _):_ -> Just $ fromInteger i
|
|
||||||
[] -> Nothing
|
|
||||||
@ -6,7 +6,7 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
-- | The basic typeclass for a Yesod application.
|
-- | The basic typeclass for a Yesod application.
|
||||||
module Yesod.Yesod
|
module Yesod.Core
|
||||||
( -- * Type classes
|
( -- * Type classes
|
||||||
Yesod (..)
|
Yesod (..)
|
||||||
, YesodSite (..)
|
, YesodSite (..)
|
||||||
@ -27,10 +27,10 @@ module Yesod.Dispatch
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
#if TEST
|
#if TEST
|
||||||
import Yesod.Yesod hiding (testSuite)
|
import Yesod.Core hiding (testSuite)
|
||||||
import Yesod.Handler hiding (testSuite)
|
import Yesod.Handler hiding (testSuite)
|
||||||
#else
|
#else
|
||||||
import Yesod.Yesod
|
import Yesod.Core
|
||||||
import Yesod.Handler
|
import Yesod.Handler
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|||||||
@ -1,96 +0,0 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
---------------------------------------------------------
|
|
||||||
--
|
|
||||||
-- Module : Yesod.Helpers.AtomFeed
|
|
||||||
-- Copyright : Michael Snoyman
|
|
||||||
-- License : BSD3
|
|
||||||
--
|
|
||||||
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
|
||||||
-- Stability : Stable
|
|
||||||
-- Portability : portable
|
|
||||||
--
|
|
||||||
-- Generating atom news feeds.
|
|
||||||
--
|
|
||||||
---------------------------------------------------------
|
|
||||||
|
|
||||||
-- | Generation of Atom newsfeeds. See
|
|
||||||
-- <http://en.wikipedia.org/wiki/Atom_(standard)>.
|
|
||||||
module Yesod.Helpers.AtomFeed
|
|
||||||
( AtomFeed (..)
|
|
||||||
, AtomFeedEntry (..)
|
|
||||||
, atomFeed
|
|
||||||
, atomLink
|
|
||||||
, RepAtom (..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Yesod
|
|
||||||
import Data.Time.Clock (UTCTime)
|
|
||||||
|
|
||||||
newtype RepAtom = RepAtom Content
|
|
||||||
instance HasReps RepAtom where
|
|
||||||
chooseRep (RepAtom c) _ = return (typeAtom, c)
|
|
||||||
|
|
||||||
atomFeed :: AtomFeed (Route master) -> GHandler sub master RepAtom
|
|
||||||
atomFeed = fmap RepAtom . hamletToContent . template
|
|
||||||
|
|
||||||
data AtomFeed url = AtomFeed
|
|
||||||
{ atomTitle :: String
|
|
||||||
, atomLinkSelf :: url
|
|
||||||
, atomLinkHome :: url
|
|
||||||
, atomUpdated :: UTCTime
|
|
||||||
, atomEntries :: [AtomFeedEntry url]
|
|
||||||
}
|
|
||||||
|
|
||||||
data AtomFeedEntry url = AtomFeedEntry
|
|
||||||
{ atomEntryLink :: url
|
|
||||||
, atomEntryUpdated :: UTCTime
|
|
||||||
, atomEntryTitle :: String
|
|
||||||
, atomEntryContent :: Html
|
|
||||||
}
|
|
||||||
|
|
||||||
template :: AtomFeed url -> Hamlet url
|
|
||||||
template arg =
|
|
||||||
#if GHC7
|
|
||||||
[xhamlet|
|
|
||||||
#else
|
|
||||||
[$xhamlet|
|
|
||||||
#endif
|
|
||||||
<?xml version="1.0" encoding="utf-8"?>
|
|
||||||
%feed!xmlns="http://www.w3.org/2005/Atom"
|
|
||||||
%title $atomTitle.arg$
|
|
||||||
%link!rel=self!href=@atomLinkSelf.arg@
|
|
||||||
%link!href=@atomLinkHome.arg@
|
|
||||||
%updated $formatW3.atomUpdated.arg$
|
|
||||||
%id @atomLinkHome.arg@
|
|
||||||
$forall atomEntries.arg entry
|
|
||||||
^entryTemplate.entry^
|
|
||||||
|]
|
|
||||||
|
|
||||||
entryTemplate :: AtomFeedEntry url -> Hamlet url
|
|
||||||
entryTemplate arg =
|
|
||||||
#if GHC7
|
|
||||||
[xhamlet|
|
|
||||||
#else
|
|
||||||
[$xhamlet|
|
|
||||||
#endif
|
|
||||||
%entry
|
|
||||||
%id @atomEntryLink.arg@
|
|
||||||
%link!href=@atomEntryLink.arg@
|
|
||||||
%updated $formatW3.atomEntryUpdated.arg$
|
|
||||||
%title $atomEntryTitle.arg$
|
|
||||||
%content!type=html $cdata.atomEntryContent.arg$
|
|
||||||
|]
|
|
||||||
|
|
||||||
-- | Generates a link tag in the head of a widget.
|
|
||||||
atomLink :: Route m
|
|
||||||
-> String -- ^ title
|
|
||||||
-> GWidget s m ()
|
|
||||||
atomLink u title = addHamletHead
|
|
||||||
#if GHC7
|
|
||||||
[hamlet|
|
|
||||||
#else
|
|
||||||
[$hamlet|
|
|
||||||
#endif
|
|
||||||
%link!href=@u@!type="application/atom+xml"!rel="alternate"!title=$title$
|
|
||||||
|]
|
|
||||||
@ -1,79 +0,0 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
---------------------------------------------------------
|
|
||||||
--
|
|
||||||
-- Module : Yesod.Helpers.Sitemap
|
|
||||||
-- Copyright : Michael Snoyman
|
|
||||||
-- License : BSD3
|
|
||||||
--
|
|
||||||
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
|
||||||
-- Stability : Stable
|
|
||||||
-- Portability : portable
|
|
||||||
--
|
|
||||||
-- Generating Google sitemap files.
|
|
||||||
--
|
|
||||||
---------------------------------------------------------
|
|
||||||
|
|
||||||
-- | Generates XML sitemap files.
|
|
||||||
--
|
|
||||||
-- See <http://www.sitemaps.org/>.
|
|
||||||
module Yesod.Helpers.Sitemap
|
|
||||||
( sitemap
|
|
||||||
, robots
|
|
||||||
, SitemapUrl (..)
|
|
||||||
, SitemapChangeFreq (..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Yesod
|
|
||||||
import Data.Time (UTCTime)
|
|
||||||
|
|
||||||
data SitemapChangeFreq = Always
|
|
||||||
| Hourly
|
|
||||||
| Daily
|
|
||||||
| Weekly
|
|
||||||
| Monthly
|
|
||||||
| Yearly
|
|
||||||
| Never
|
|
||||||
|
|
||||||
showFreq :: SitemapChangeFreq -> String
|
|
||||||
showFreq Always = "always"
|
|
||||||
showFreq Hourly = "hourly"
|
|
||||||
showFreq Daily = "daily"
|
|
||||||
showFreq Weekly = "weekly"
|
|
||||||
showFreq Monthly = "monthly"
|
|
||||||
showFreq Yearly = "yearly"
|
|
||||||
showFreq Never = "never"
|
|
||||||
|
|
||||||
data SitemapUrl url = SitemapUrl
|
|
||||||
{ sitemapLoc :: url
|
|
||||||
, sitemapLastMod :: UTCTime
|
|
||||||
, sitemapChangeFreq :: SitemapChangeFreq
|
|
||||||
, priority :: Double
|
|
||||||
}
|
|
||||||
|
|
||||||
template :: [SitemapUrl url] -> Hamlet url
|
|
||||||
template urls =
|
|
||||||
#if GHC7
|
|
||||||
[xhamlet|
|
|
||||||
#else
|
|
||||||
[$xhamlet|
|
|
||||||
#endif
|
|
||||||
%urlset!xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"
|
|
||||||
$forall urls url
|
|
||||||
%url
|
|
||||||
%loc @sitemapLoc.url@
|
|
||||||
%lastmod $formatW3.sitemapLastMod.url$
|
|
||||||
%changefreq $showFreq.sitemapChangeFreq.url$
|
|
||||||
%priority $show.priority.url$
|
|
||||||
|]
|
|
||||||
|
|
||||||
sitemap :: [SitemapUrl (Route master)] -> GHandler sub master RepXml
|
|
||||||
sitemap = fmap RepXml . hamletToContent . template
|
|
||||||
|
|
||||||
-- | A basic robots file which just lists the "Sitemap: " line.
|
|
||||||
robots :: Route sub -- ^ sitemap url
|
|
||||||
-> GHandler sub master RepPlain
|
|
||||||
robots smurl = do
|
|
||||||
tm <- getRouteToMaster
|
|
||||||
render <- getUrlRender
|
|
||||||
return $ RepPlain $ toContent $ "Sitemap: " ++ render (tm smurl)
|
|
||||||
@ -1,252 +0,0 @@
|
|||||||
{-# 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 (..)
|
|
||||||
-- * Lookup files in filesystem
|
|
||||||
, fileLookupDir
|
|
||||||
, staticFiles
|
|
||||||
-- * Embed files
|
|
||||||
, mkEmbedFiles
|
|
||||||
, getStaticHandler
|
|
||||||
-- * Hashing
|
|
||||||
, base64md5
|
|
||||||
#if TEST
|
|
||||||
, testSuite
|
|
||||||
#endif
|
|
||||||
) where
|
|
||||||
|
|
||||||
import System.Directory
|
|
||||||
import Control.Monad
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
|
|
||||||
import Yesod hiding (lift)
|
|
||||||
import Data.List (intercalate)
|
|
||||||
import Language.Haskell.TH
|
|
||||||
import Language.Haskell.TH.Syntax
|
|
||||||
import Web.Routes
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
#if TEST
|
|
||||||
import Test.Framework (testGroup, Test)
|
|
||||||
import Test.Framework.Providers.HUnit
|
|
||||||
import Test.HUnit hiding (Test)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- | A function for looking up file contents. For serving from the file system,
|
|
||||||
-- see 'fileLookupDir'.
|
|
||||||
data Static = Static
|
|
||||||
{ staticLookup :: FilePath -> IO (Maybe (Either FilePath Content))
|
|
||||||
-- | Mapping from file extension to content type. See 'typeByExt'.
|
|
||||||
, staticTypes :: [(String, ContentType)]
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | 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 YesodSubSite Static master where
|
|
||||||
getSubSite = Site
|
|
||||||
{ handleSite = \_ (StaticRoute ps _) m ->
|
|
||||||
case m of
|
|
||||||
"GET" -> Just $ fmap chooseRep $ getStaticRoute ps
|
|
||||||
_ -> Nothing
|
|
||||||
, formatPathSegments = \(StaticRoute x y) -> (x, y)
|
|
||||||
, parsePathSegments = \x -> Right $ StaticRoute x []
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Lookup files in a specific directory.
|
|
||||||
--
|
|
||||||
-- If you are just using this in combination with the static subsite (you
|
|
||||||
-- probably are), the handler itself checks that no unsafe paths are being
|
|
||||||
-- requested. In particular, no path segments may begin with a single period,
|
|
||||||
-- so hidden files and parent directories are safe.
|
|
||||||
--
|
|
||||||
-- For the second argument to this function, you can just use 'typeByExt'.
|
|
||||||
fileLookupDir :: FilePath -> [(String, ContentType)] -> Static
|
|
||||||
fileLookupDir dir = Static $ \fp -> do
|
|
||||||
let fp' = dir ++ '/' : fp
|
|
||||||
exists <- doesFileExist fp'
|
|
||||||
if exists
|
|
||||||
then return $ Just $ Left fp'
|
|
||||||
else return Nothing
|
|
||||||
|
|
||||||
-- | Lookup files in a specific directory, and embed them into the haskell source.
|
|
||||||
--
|
|
||||||
-- A variation of fileLookupDir which allows subsites distributed via cabal to include
|
|
||||||
-- static content. You can still use staticFiles to generate route identifiers. See getStaticHandler
|
|
||||||
-- for dispatching static content for a subsite.
|
|
||||||
mkEmbedFiles :: FilePath -> Q Exp
|
|
||||||
mkEmbedFiles d = do
|
|
||||||
fs <- qRunIO $ getFileList d
|
|
||||||
clauses <- mapM (mkClause . intercalate "/") fs
|
|
||||||
defC <- defaultClause
|
|
||||||
return $ static $ clauses ++ [defC]
|
|
||||||
where static clauses = LetE [fun clauses] $ ConE 'Static `AppE` VarE f
|
|
||||||
f = mkName "f"
|
|
||||||
fun clauses = FunD f clauses
|
|
||||||
defaultClause = do
|
|
||||||
b <- [| return Nothing |]
|
|
||||||
return $ Clause [WildP] (NormalB b) []
|
|
||||||
|
|
||||||
mkClause path = do
|
|
||||||
content <- qRunIO $ readFile $ d ++ '/':path
|
|
||||||
let pat = LitP $ StringL path
|
|
||||||
foldAppE = foldl1 AppE
|
|
||||||
content' = return $ LitE $ StringL $ content
|
|
||||||
body <- normalB [| return $ Just $ Right $ toContent ($content' :: [Char]) |]
|
|
||||||
return $ Clause [pat] body []
|
|
||||||
|
|
||||||
-- | 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"
|
|
||||||
|
|
||||||
getStaticRoute :: [String]
|
|
||||||
-> GHandler Static master (ContentType, Content)
|
|
||||||
getStaticRoute fp' = do
|
|
||||||
Static fl ctypes <- getYesodSub
|
|
||||||
when (any isUnsafe fp') notFound
|
|
||||||
let fp = intercalate "/" fp'
|
|
||||||
content <- liftIO $ fl fp
|
|
||||||
case content of
|
|
||||||
Nothing -> notFound
|
|
||||||
Just (Left fp'') -> do
|
|
||||||
let ctype = fromMaybe typeOctet $ lookup (ext fp'') ctypes
|
|
||||||
sendFile ctype fp''
|
|
||||||
Just (Right bs) -> do
|
|
||||||
let ctype = fromMaybe typeOctet $ lookup (ext fp) ctypes
|
|
||||||
return (ctype, bs)
|
|
||||||
where
|
|
||||||
isUnsafe [] = True
|
|
||||||
isUnsafe ('.':_) = True
|
|
||||||
isUnsafe _ = False
|
|
||||||
|
|
||||||
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
|
|
||||||
@ -57,17 +57,13 @@ library
|
|||||||
, cookie >= 0.0 && < 0.1
|
, cookie >= 0.0 && < 0.1
|
||||||
, json-enumerator >= 0.0 && < 0.1
|
, json-enumerator >= 0.0 && < 0.1
|
||||||
, json-types >= 0.1 && < 0.2
|
, json-types >= 0.1 && < 0.2
|
||||||
exposed-modules: Yesod
|
exposed-modules: Yesod.Content
|
||||||
Yesod.Content
|
Yesod.Core
|
||||||
Yesod.Dispatch
|
Yesod.Dispatch
|
||||||
Yesod.Hamlet
|
Yesod.Hamlet
|
||||||
Yesod.Handler
|
Yesod.Handler
|
||||||
Yesod.Request
|
Yesod.Request
|
||||||
Yesod.Widget
|
Yesod.Widget
|
||||||
Yesod.Yesod
|
|
||||||
Yesod.Helpers.AtomFeed
|
|
||||||
Yesod.Helpers.Sitemap
|
|
||||||
Yesod.Helpers.Static
|
|
||||||
other-modules: Yesod.Internal
|
other-modules: Yesod.Internal
|
||||||
Paths_yesod_core
|
Paths_yesod_core
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user