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

module Hack.Contrib.Utils where

import Hack
import Hack.Contrib.Constants

import MPSUTF8
import Prelude hiding ((.), (^), (>), lookup, (+), (/))

import Network.URI hiding (path)
import Data.Default

import Control.Arrow ((>>>), (<<<))
import qualified Data.Map as M
import Data.Time
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad (mplus, MonadPlus)
import Data.Maybe
import System.IO
import System.Locale
import System.FilePath ((</>))
import Control.Category (Category)
import Data.List (lookup)


-- hack input / output are all utf8 bytes
-- but sometimes we want to put unicode string directly
-- like when writing config and such
type UnicodeString = String

(>) :: (Control.Category.Category cat) => cat a b -> cat b c -> cat a c
(>) = (>>>)
infixl 8 >

(+) :: (MonadPlus m) => m a -> m a -> m a
(+) = mplus
infixl 8 +

(/) :: FilePath -> FilePath -> FilePath
(/) = (</>)
infixl 5 /

empty_app :: Application
empty_app = return def

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

-- use the get / put helper to deal with headers
put :: String -> String -> [(String, String)] -> [(String, String)]
put k v xs = (k,v) : xs.reject (fst > is k)

get :: String -> [(String, String)] -> Maybe String
get = lookup

-- | note when calling bytesize, you are sure that the string
--   is in [char8] format anyway. so just call length
bytesize :: String -> Int
bytesize = length -- B.pack > B.length > from_i

dummy_middleware :: Middleware
dummy_middleware = id

dummy_app :: Application
dummy_app _ = return $ def { status = 500 }

escape_html :: String -> String
escape_html = concatMap fixChar
    where
      fixChar '&' = "&amp;"
      fixChar '<' = "&lt;"
      fixChar '>' = "&gt;"
      fixChar '\'' = "&#39;"
      fixChar '"' = "&quot;"
      fixChar x = [x]

escape_uri :: String -> String
escape_uri = escapeURIString isAllowedInURI

unescape_uri :: String -> String
unescape_uri = unEscapeString

show_status_message :: Int -> Maybe String
show_status_message x = status_code.M.lookup x

httpdate :: UTCTime -> String
httpdate x = x.format_time rfc822DateFormat where

url2unicode :: String -> String
url2unicode s = s.unescape_uri.b2u

just_lookup :: (Ord k) => k -> M.Map k a -> a
just_lookup s xs = xs.M.lookup s .fromJust

-- MPS candidate