{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Hack.Utils where

import Hack
import Network.CGI hiding (Html)
import Network.URI hiding (path)
import Data.Default
import Prelude hiding ((.), (^), (>), lookup, (+))
import MPS
import Control.Arrow ((>>>), (<<<))
import Data.Map (toList, lookup)
import System.Time
import System.Locale
import Text.Template
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad (mplus)

(>) = (>>>)
infixl 8 >

(+) = mplus
infixl 8 +

not_found :: String -> IO Response  
not_found x = return $ Response
  {  status  = 404
  ,  headers = [("Content-Type", "text/plain")]
  ,  body    = x
  }

empty_app :: Application
empty_app = return def

-- usage: app.use [content_type, cache]
use :: [MiddleWare] -> MiddleWare
use = reduce (<<<)

not_found_app :: Application
not_found_app = \env -> not_found [$here|Not Found: #{env.path_info}|]

header :: String -> Response -> Maybe String
header s r = r.headers.to_h.lookup s

set_header :: String -> String -> Response -> Response
set_header k v r = r 
  { headers = (r.headers ++ [(k,v)] ) .to_h .toList }

bytesize :: String -> Int
bytesize = u2b > length

-- MPS candidate

now :: IO CalendarTime
now = getClockTime >>= toCalendarTime

format_time :: String -> CalendarTime -> String
format_time = formatCalendarTime defaultTimeLocale

interpolate :: String -> [(String, String)] -> String
interpolate s params = B.unpack $ substitute (B.pack s) (context params)
  where 
    context = map packPair > to_h
    packPair (x, y) = (B.pack x, B.pack y)