{-# 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 Data.Map (lookup, Map)
import Data.Time
import Text.Template
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad (mplus, MonadPlus)
import Data.Maybe
import System.IO
import System.Posix.Files
import System.Locale
import System.Directory
import Data.Time.Clock.POSIX
import System.FilePath ((</>))
import Data.Char (ord)
import Control.Category (Category)

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Codec.Compression.GZip as GZip
import Codec.Binary.Base64.String as C

-- import Date.Time

(>) :: (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 (<<<)

bytesize :: String -> Int
bytesize = 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 '<' = "<"
      fixChar '>' = ">"
      fixChar '&' = "&"
      fixChar '"' = "\""
      fixChar c | ord c < 0x80 = [c]
      fixChar c = "&#" ++ show (ord c) ++ ";"



show_status_code :: Int -> Maybe String
show_status_code x = status_code.lookup x

-- MPS candidate

now :: IO UTCTime
now = getCurrentTime

format_time :: String -> UTCTime -> String
format_time = formatTime 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)

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

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

file_size :: String -> IO Integer
file_size path = withFile (path.u2b) ReadMode hFileSize

file_mtime :: String -> IO UTCTime
file_mtime path = getFileStatus (path.u2b) 
                  ^ modificationTime ^ realToFrac ^ posixSecondsToUTCTime

read_binary_file :: String -> IO String
read_binary_file path = path.u2b.B.readFile ^ B.unpack

get_permissions :: String -> IO Permissions
get_permissions path = getPermissions (path.u2b) 

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

get_current_directory :: IO String
get_current_directory = getCurrentDirectory ^ b2u

zip64, unzip64 :: String -> String
zip64 = B.pack > GZip.compress > B.unpack > C.encode
unzip64 = C.decode > B.pack > GZip.decompress > B.unpack