{-# OPTIONS -fno-monomorphism-restriction #-} module Panda.Helper.Helper where import Network.URI import Network.CGI import System.FilePath.Posix (()) import Kibro import Control.Arrow ((>>>), (&&&)) import Text.XHtml.Strict import Control.Monad hiding (join) import Panda.Type.Pager as Pager import MPS import Prelude hiding ((.), (/), id) (/) = () -- controller uri = do uri <- requestURI uri.uriPath.urlDecode.tail.return markdown_link l s = ["[", s, "]", "(", l, ")"] .join' params = do query_string <- requestURI <.> uriQuery case query_string of '?':s -> s.split "&" .map (split "=" >>> tuple2) .return otherwise -> return [] param_with_default s d = do ps <- params return $ case ps.lookup s of Nothing -> d Just x -> x.read pager length total = liftM5 ( Pager length ) current has_next has_previous next previous where current = param_with_default "page" 1 has_next = current <.> ( (* length) >>> (< total.fromIntegral) ) has_previous = current <.> (> 1) next = current <.> (+ 1) previous = current <.> (+ (-1) ) for_current_page p xs = xs.drop ((p.Pager.current - 1) * p.Pager.length) .take (p.Pager.length) -- view id = identifier css_link l = itag "link" ! [rel "stylesheet", thetype "text/css", href ("/css/" ++ l ++ ".css") ] js_link l = itag "script" ! [thetype "text/javascript", src ("/js/" ++ l ++ ".js" )] svg s a w h = image ! [src ("/svg/" ++ s), height (h.show), width (w.show), alt a] meta_tag = meta ! [httpequiv "Content-Type", content "text/html; charset=utf-8"] div_id s = thediv ! [id s] div_class s = thediv ! [theclass s] space = hr ! [theclass "space"] sep_by _ [] = toHtml "" sep_by _ [x] = toHtmlFromList [x] sep_by x xs = ( init >>> map (+++ x) ) &&& last >>> splash (+++) $ xs output_html = output ... renderHtml ie s = [ "" ] .join' .primHtml rss_uri x = URI { uriScheme = "http://", uriAuthority = Nothing, uriPath = x / "rss.xml", uriQuery = "", uriFragment = "" }