Helper.hs

{-# 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 = 
  [ "<!-- [if IE]>"
  , s.show
  , "<![endif]-->"
  ] .join' .primHtml

rss_uri x = URI {
  uriScheme = "http://",
  uriAuthority = Nothing,
  uriPath = x / "rss.xml",
  uriQuery = "",
  uriFragment = ""
  }