-- 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 System.IO.UTF8 (readFile, writeFile)
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
import MPS hiding (date)
import Prelude hiding ((.), (/), (^), id, readFile, writeFile)
import Char
import Data.List
import qualified Data.List as L 
import Panda.Type.Reader
import System.FilePath.Posix hiding ((<.>))
import System.Time
import Data.Default


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

-- global
parse_config_io s = readFile 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" .writeFile s

-- 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 ^ map_snd (strip >>> unescape_unicode_xml)

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

full_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

spaced_url = gsub "/" " / "

empty_html = toHtml ""

-- config
parse_list s = s.split "," .map strip .reject null
not_found = getVar "REQUEST_URI" >>= (fromMaybe "" >>> outputNotFound)


-- generic
show_data = show >>> snake_case

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

class Resource a where
    resource_title :: a -> String

class Markable a where
    markup :: a -> Html
    
class Datable a where
    date :: a -> CalendarTime

class Addressable a where
    uri :: a -> String