module Happstack.Server.YUI
(
implYUISite
, YUISitemap(..)
, sitemap
, route
, showCSSComboURL
, gridUnit
, fontSize
, createNode
, isYUIFile
, readYUIFile
) where
import Prelude hiding ((.))
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Web.Routes as WR
import Control.Category (Category((.)))
import Control.Monad (guard, liftM, void)
import Control.Monad.Trans (liftIO)
import Data.List (intercalate)
import Data.Ratio ((%), numerator,denominator)
import Data.Text.Encoding (encodeUtf8)
import Happstack.Server (Happstack, Response, neverExpires, setHeaderM, badRequest, ok, toResponse, guessContentTypeM, mimeTypes, lookPairs)
import Happstack.Server.Compression (compressedResponseFilter)
import Happstack.Server.JMacro ()
import Happstack.Server.YUI.Bundle (isYUIFile, readYUIFile)
import HSP (XML, renderAsHTML)
import Language.Javascript.JMacro (JStat(BlockStat), JExpr, jmacro, jmacroE, renderJs, jhFromList, toJExpr)
import Text.Boomerang.TH (derivePrinterParsers)
import Text.InterpolatedString.Perl6 (qq)
import Text.PrettyPrint (Style(mode), Mode(OneLineMode), renderStyle, style)
import Text.Printf (printf)
import Web.Routes (Site, RouteT)
import Web.Routes.Boomerang (Router, (<>), (</>), rList, anyString, eos, boomerangSiteRouteT)
import Web.Routes.Happstack (implSite)
import Web.Routes.TH (derivePathInfo)
#if !MIN_VERSION_template_haskell(2,7,0)
import Language.Javascript.JMacro (JStat(..), JExpr(..), JVal(..), Ident(..))
#endif
data YUISitemap
= SeedURL
| ComboURL
| BundleURL [String]
| ConfigURL
| CSSComboURL
derivePathInfo ''YUISitemap
derivePrinterParsers ''YUISitemap
sitemap :: Router YUISitemap
sitemap =
YUI_VERSION_STR </>
( rComboURL . "combo"
<> rCSSComboURL . "css"
<> rBundleURL . "bundle" </> rList (anyString . eos)
<> rConfigURL . "config"
<> rSeedURL
)
site :: Happstack m => Site YUISitemap (m Response)
site = boomerangSiteRouteT route sitemap
implYUISite :: Happstack m
=> T.Text
-> T.Text
-> m Response
implYUISite domain approot = implSite domain approot site
mkConfig :: Happstack m => RouteT YUISitemap m JStat
mkConfig = do
comboURL <- WR.showURL ComboURL
return [jmacro|
YUI.applyConfig { comboBase: `((T.unpack comboURL) ++ "?")`, root: "" }
|]
route :: Happstack m => YUISitemap -> RouteT YUISitemap m Response
route url = do
neverExpires
void compressedResponseFilter
case url of
BundleURL paths ->
do let name = intercalate "/" paths
exists <- liftIO $ isYUIFile name
guard exists
mime <- guessContentTypeM mimeTypes name
setHeaderM "Content-Type" mime
bytes <- liftIO $ readYUIFile name
ok . toResponse $ bytes
ComboURL ->
do qs <- liftM (map fst) lookPairs
exists <- liftIO $ mapM isYUIFile qs
if null qs || any not exists
then badRequest $ toResponse ()
else do mime <- guessContentTypeM mimeTypes $ head qs
setHeaderM "Content-Type" mime
bytes <- liftIO $ mapM readYUIFile qs
ok $ toResponse $ B.concat bytes
CSSComboURL ->
do qs <- liftM (map (css . fst)) lookPairs
exists <- liftIO $ mapM isYUIFile qs
if null qs || any not exists
then badRequest $ toResponse ()
else do setHeaderM "Content-Type" "text/css"
bytes <- liftIO $ mapM readYUIFile qs
ok $ toResponse $ B.concat bytes
ConfigURL ->
do config <- mkConfig
ok $ toResponse config
SeedURL ->
do config <- mkConfig
seed <- liftIO $ readYUIFile "yui/yui-min.js"
setHeaderM "Content-Type" "application/javascript"
ok $ toResponse $ seed `B.append` (encode . render) config
where
render = renderStyle (style { mode = OneLineMode }) . renderJs
encode = encodeUtf8 . T.pack
css fn = "css" ++ fn ++ "/css" ++ fn ++ "-min.css"
showCSSComboURL :: WR.MonadRoute m
=> (YUISitemap -> WR.URL m)
-> [T.Text]
-> m T.Text
showCSSComboURL yui ms =
WR.showURLParams (yui CSSComboURL) [(m,Nothing) | m <- ms]
gridUnit :: Integer -> Integer -> T.Text
gridUnit n d
| num == 0 = "yui3-u"
| (num,den) == (1,1) = "yui3-u-1"
| otherwise = [qq|yui3u-$num-$den|]
where
num = numerator $ n % d
den = denominator $ n % d
fontSize :: Integer -> T.Text
fontSize 10 = "77%"
fontSize 11 = "85%"
fontSize 12 = "93%"
fontSize 13 = "100%"
fontSize 14 = "108%"
fontSize 15 = "116%"
fontSize 16 = "123.1%"
fontSize 17 = "131%"
fontSize 18 = "138.5%"
fontSize 19 = "146.5%"
fontSize 20 = "153.9%"
fontSize 21 = "161.6%"
fontSize 22 = "167%"
fontSize 23 = "174%"
fontSize 24 = "182%"
fontSize 25 = "189%"
fontSize 26 = "197%"
fontSize px =
T.pack . printf "%.1f%%" $ percentage
where
percentage :: Double
percentage = fromIntegral px * (100 / 13)
createNode :: JExpr -> XML -> JExpr
createNode y xml = [jmacroE| `(y)`.Node.create(`(renderAsHTML xml)`) |]