Helper.hs

-- helper module is a central place for reusable functions
-- for this project, more general helpers are usually moved
-- to MPS package, for multi-project usage

{-# OPTIONS -fno-monomorphism-restriction #-}

module Panda.Helper.Helper where

import Network.URI
import Network.CGI
import System.FilePath.Posix ((</>))
import Control.Arrow ((>>>), (&&&))
import Text.XHtml.Strict
import Control.Monad hiding (join)
import Data.Maybe

import Panda.Type.Pager as Pager hiding (empty)
import MPS
import Prelude hiding ((.), (/), id)
import Panda.Helper.Escape
import Char
import Data.List
import Panda.Type.Reader
import System.FilePath.Posix hiding ((<.>))

(/) = (</>)

-- model
take_extension = takeExtension >>> split "\\." >>> last

-- controller
uri = requestURI <.> (uriPath >>> urlDecode >>> tail)
  
params = do
  query_string <- requestURI <.> uriQuery
  case query_string of
    '?':s -> s.formDecode .return
    otherwise -> return []

param_with_default s d = params <.> (lookup s >>> fromMaybe d >>> unescape >>> strip)

input_with_default s d = getInput s <.> (fromMaybe d >>> unescape >>> strip)

pager length total = liftM5 ( Pager length ) current has_next has_previous next previous where
  current      = param_with_default "page" "1" <.> read
  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)

-- id: /type/resoruce
id_to_type id = id.from_utf8.split "/" .first
id_to_resource id = id.from_utf8.split "/" .tail.join "/"
no_navigation = ""
home_nav      = "Home"

-- view
id               = identifier

css_link l       = itag "link" ! [rel "stylesheet", thetype "text/css", href l]
js_link l        = itag "script" ! [thetype "text/javascript", src l]
rss_link l       = itag "link" ! [rel "alternate", thetype "application/rss+xml", href l, title "RSS 2.0"]
meta_tag         = meta ! [httpequiv "Content-Type", content "text/html; charset=utf-8"]


div_id s         = thediv ! [id s]
div_class s      = thediv ! [theclass s]
div_class_id x y = thediv ! [theclass x, id y]

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  = ""
  }