module Happstack.Server.YUI
(
implYUISite
, gridUnit
, fontSize
, isYUIFile
, readYUIFile
) where
import Prelude hiding ((.))
import qualified Data.ByteString as B
import qualified Data.Text as T
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 (ServerPartT, 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 Language.Javascript.JMacro (JStat(BlockStat), jmacro, renderJs, jhFromList, toJExpr)
import Text.Boomerang.TH (derivePrinterParsers)
import Text.PrettyPrint (Style(mode), Mode(OneLineMode), renderStyle, style)
import Text.Printf (printf)
import Web.Routes (Site, RouteT, showURL)
import Web.Routes.Boomerang (Router, (<>), (</>), rList, anyString, eos, boomerangSiteRouteT)
import Web.Routes.Happstack (implSite)
#if !MIN_VERSION_template_haskell(2,7,0)
import Language.Javascript.JMacro (JStat(..), JExpr(..), JVal(..), Ident(..))
#endif
data Sitemap
= ComboHandlerURL
| BundleURL [String]
| ConfigURL
| CSSComboURL
| SeedURL
derivePrinterParsers ''Sitemap
sitemap :: Router Sitemap
sitemap =
YUI_VERSION_STR </>
( rComboHandlerURL . "combo"
<> rCSSComboURL . "css"
<> rBundleURL . "bundle" </> rList (anyString . eos)
<> rConfigURL . "config"
<> rSeedURL
)
site :: Site Sitemap (ServerPartT IO Response)
site = boomerangSiteRouteT route sitemap
implYUISite :: T.Text
-> T.Text
-> ServerPartT IO Response
implYUISite domain approot = implSite domain approot site
mkConfig :: RouteT Sitemap (ServerPartT IO) JStat
mkConfig = do
comboURL <- showURL ComboHandlerURL
return [jmacro|
YUI.applyConfig { comboBase: `((T.unpack comboURL) ++ "?")`, root: "" }
|]
route :: Sitemap -> RouteT Sitemap (ServerPartT IO) 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
ComboHandlerURL ->
do qs <- liftM (map fst) lookPairs
exists <- liftIO $ mapM isYUIFile qs
if null qs || any (== False) 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 (== False) 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"
gridUnit :: Integer -> Integer -> T.Text
gridUnit n d =
T.concat [ "yui3-u-"
, T.pack . show . numerator $ n % d
, "-"
, T.pack . show . 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)