module Panda.Helper.Helper where
import Panda.Helper.PreludeEnv
import Network.URI
import Network.CGI
import Text.XHtml.Strict hiding (p, meta)
import qualified Text.XHtml.Strict as Html
import Control.Monad hiding (join)
import Data.Maybe
import qualified Panda.Type.Pager as Pager
import Char
import Data.List hiding (length)
import qualified Data.List as L
import Panda.Type.Reader
import System.FilePath.Posix hiding ((<.>))
import System.Time
import qualified Prelude as P
import Data.Default
import Data.Map (Map)
import System.Directory
(/) :: FilePath -> FilePath -> FilePath
(/) = (</>)
infixl 5 /
gt = (P.>)
parse_config_io s = read_file s ^ (\x -> x.filter_comment.lines.map strip .map (split "\\s*=\\s*") .map fill_snd_blank .map tuple2)
where fill_snd_blank [x] = [x,""]
fill_snd_blank xs = xs
parse_config = parse_config_io > purify
write_config_io s xs = xs.map(\(x, y) -> x ++ " = " ++ y) .join "\n" .write_file s
take_extension = takeExtension
take_known_extension s
| ext.belongs_to exts = ext
| otherwise = ""
where
ext = s.take_extension
exts = readers.only_snd.join'
drop_known_extension s
| s.take_extension.belongs_to exts = dropExtension s
| otherwise = s
where exts = readers.only_snd.join'
meta = (++ ".meta")
image_extensions = ["jpg", "jpeg", "png", "gif"]
is_image x = image_extensions.any (suffix_of x)
suffix_of = flip isSuffixOf
raw_uri = requestURI ^ (uriPath > urlDecode > tail > remove_trailing_slash )
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
_ -> return []
inputs = getInputs ^ map_snd (strip > unescape_unicode_xml > b2u)
param_with_default s d = get_param s ^ fromMaybe d
input_with_default s d = get_input 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
full_paginate length total = liftM5 ( Pager.Pager length ) current has_next has_previous next previous where
current = param_with_default "page" "1" ^ read
has_next = current ^ ( (* length) > (< total.from_i) )
has_previous = current ^ (`gt` 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)
no_navigation = ""
home_nav = "Home"
default_content_type = "text/html; charset=UTF-8"
set_content_type = setHeader "Content-type"
set_header = set_content_type default_content_type
id = identifier
css_link l = itag "link" ! [rel "stylesheet", thetype "text/css", href l]
ie_tag x = ("<!--[if IE]>" ++ x.show ++ "<![endif]-->").primHtml
ie6_tag x = ("<!--[if lt IE 7]>" ++ x.show ++ "<![endif]-->").primHtml
ie7_tag x = ("<!--[if IE 7]>" ++ x.show ++ "<![endif]-->").primHtml
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 = Html.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]
xml_header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
output_html x = x.renderHtml.output
spaced_url = gsub "/" " / "
empty_html = toHtml ""
html_if p x = if p then x else empty_html
parse_list s = s.split "," .map strip .reject null
not_found = getVar "REQUEST_URI" >>= (fromMaybe "" > outputNotFound)
show_data = show > snake_case
ifM p t f = p >>= (\p' -> if p' then t else f)
parse_boolean = belongs_to ["true", "1", "y", "yes", "yeah"]
mkdir = u2b > createDirectory
class DataRenderer a where
render_data :: a -> Html
id_to_type x = x.split "/" .first
id_to_resource x = x.split "/" .tail.join "/"
class (Show a) => Resource a where
resource_title :: a -> String
resource_type :: a -> String
resource_type = show_data
class Markable a where
markup :: a -> Html
class Datable a where
date :: a -> CalendarTime
class Addressable a where
uri :: a -> String
class Gettable a where
get :: String -> IO a
type Assoc = [(String, String)]
class Mappable a where
from_assoc :: Assoc -> IO a
class Creatable a where
create :: a -> IO ()
class Listable a where
list :: IO [a]
list = return []
list_for :: String -> IO [a]
list_for = const list
cheat_list :: IO [a]
cheat_list = list
class FlatRead a where
flat_read :: String -> IO a