{-# OPTIONS_GHC -XEmptyDataDecls #-}
--
-- Based on Mondrian example in DDJ, at least originally.
--
module Http where

import NET
import System.IO.Unsafe ( unsafeInterleaveIO )


-- | @http url@ dumps out the response from issuing a HTTP GET
-- request to URL 'url'.
http :: String -> IO ()
http url = do
  req <- createURL url
  case isNullObj req of
    True -> putStrLn ("Unable to fetch "++ url)
    _ -> do
      rsp <- req # getResponse
      str <- rsp # getResponseStream
      ls  <- str # slurpString 
      putStrLn ls

-- 
-- Define the types representing the objects we're accessing here.
-- 
data WebRequest_ a
type WebRequest a = Object (WebRequest_ a)

data WebResponse_ a
type WebResponse a = Object (WebResponse_ a)

data Stream_ a
type Stream a = Object (Stream_ a)

data UTF8Encoding_ a
-- not correct (TextEncoding is the parent), but precise enough.
type UTF8Encoding a = Object (UTF8Encoding_ a)

--
-- Binding to the methods required.
--

createURL :: String -> IO (WebRequest ())
createURL u = invokeStatic "System.Net.WebRequest" "Create" u

getResponse :: WebRequest a -> IO (WebResponse ())
getResponse = invoke "GetResponse" ()

getResponseStream :: WebResponse () -> IO (Stream a)
getResponseStream = invoke "GetResponseStream" ()

readOffBytes :: Object a -> Int -> Int -> Stream this -> IO Int
readOffBytes a b c = invoke "Read" (a,b,c)

getString :: Object a -> Int -> Int -> UTF8Encoding this -> IO String
getString a b c = invoke "GetString" (a,b,c)

slurpString :: Stream a -> IO String
slurpString stream = do
  buf     <- mkByteVector 256
  encUTF8 <- invokeStatic "System.Text.Encoding" "GetEncoding" "utf-8"
  str     <- createObject "System.IO.StreamReader" (stream,encUTF8) -- :: Object()))
  let   
   bytesToUTF8 byteArr off sz = do
      encUTF8 # getString byteArr off sz

   go stream = do
     stat    <- stream # readOffBytes buf 0 200
     if (stat <= (0 :: Int))
	-- error of some sort, just break off.
      then return []
      else do
       ls <- bytesToUTF8 buf 0 stat
       rs <- unsafeInterleaveIO (go stream)
       return (ls ++ rs)
  go stream

mkByteVector :: Int -> IO (Vector ())
mkByteVector sz = do
   ip <- newVector (Dotnet_Int8) sz
   return ip