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 Char
import Data.List
import qualified Data.List as L 
import Panda.Type.Reader
import System.FilePath.Posix hiding ((<.>))

(/) = (</>)
infixl 5 /

(^) = (<.>)
infixl 9 ^

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

-- controller
raw_uri = requestURI ^ (uriPath >>> urlDecode >>> tail >>> remove_trailing_slash >>> from_utf8 )
remove_trailing_slash s = if s.last.is '/' then s.init else s

params = do
  query_string <- requestURI ^ uriQuery 
  case query_string of
    '?':s -> s.formDecode .map_snd unescape_unicode_xml.return
    otherwise -> return []

inputs = getInputs ^ trace' ^ map_snd (strip >>> gsub "\r\n" "\n" >>> unescape_unicode_xml) ^ trace'

param_with_default s d = params ^ (lookup s >>> fromMaybe d )
input_with_default s d = inputs ^ (lookup s >>> fromMaybe d )

get_param s = params ^ lookup s
get_input s = inputs ^ lookup s

just_param s = get_param s ^ fromJust
just_input s = get_input s ^ fromJust

paginate 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.split "/" .first
id_to_resource id = id.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]
js_src s         = tag "script" ! [thetype "text/javascript"] << s
rss_link l       = itag "link" ! [rel "alternate", thetype "application/rss+xml", href l, title "RSS 2.0"]
favicon_link l   = itag "link" ! [rel "icon", thetype "image/png", href l]
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

-- config
parse_config s = s.split "," .map strip .reject null


-- class
class DataRenderer a where
    render_data :: a -> Html

class FormRenderer a where
    render_form :: a -> Html

class Resource a where
    resource_title :: a -> String

class Markable a where
    markup :: a -> Html
    
spaced_url = gsub "/" " / "