{-# LANGUAGE OverloadedStrings #-}
module CExports(c_newSession) where

-- For c_newSession
import Network.URI.Fetch (Session, newSession)

-- For data Page
import StyleTree (StyleTree)
import Data.CSS.Preprocessor.Conditions (ConditionalStyles, conditionalStyles)
import Text.XML
import qualified Data.Map.Strict as M
import Network.URI

import Control.Monad (forM)

-- For c_fetchURLs
import System.Directory (getCurrentDirectory) -- default referer URI
import Control.Concurrent.Async (forConcurrently, concurrently)
import Data.Maybe (catMaybes)

import Input (fetchURLs)

-- For c_renderDoc
import Render (retreiveStyles, renderDoc)
import Data.ByteString.Lazy (toStrict)
import Data.ByteString (useAsCString)

-- For c_extractLinks
import Links (Link(..), extractLinks)
import qualified Data.Text.Foreign as Txt

-- Types I can export to C
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc

type CArray a = Ptr a

foreign export ccall c_newSession :: IO (StablePtr Session)
foreign export ccall c_freeSession :: StablePtr Session -> IO ()

c_newSession = newSession >>= newStablePtr
c_freeSession = freeStablePtr


data Page = Page {url :: URI, css :: ConditionalStyles StyleTree, html :: Document}
type PtrPage = Ptr ()

foreign export ccall c_freePages :: CArray PtrPage -> IO ()

c_freePages c_pages = do
    pages <- peekArray0 nullPtr c_pages
    forM pages (freeStablePtr . castPtrToStablePtr)
    free c_pages


foreign export ccall c_fetchURLs :: StablePtr Session -> PtrPage -> CArray CString -> IO (CArray PtrPage)

c_fetchURLs c_session c_referer c_srcs = do
    session <- deRefStablePtr c_session
    referer <- if c_referer == nullPtr -- Can't check for NULL
        then deRefStablePtr $ castPtrToStablePtr c_referer
        else do
            cwd <- getCurrentDirectory
            return $ Page {
                -- Default to URIs being relative to CWD.
                url = URI {uriScheme = "file:", uriPath = cwd,
                    uriAuthority = Nothing, uriQuery = "", uriFragment = ""},
                -- Blank values:
                css = conditionalStyles nullURI "temp",
                html = Document {
                    documentPrologue = Prologue [] Nothing [],
                    documentRoot = Element "temp" M.empty [],
                    documentEpilogue = []
                }
            }
    emptyCStr <- newCString ""
    srcCStrs <- peekArray0 emptyCStr c_srcs
    srcs <- forConcurrently (pairs srcCStrs) $ \(c_mime, c_uri) -> do
        mime <- peekCString c_mime
        uri <- peekCString c_uri
        return $ pair (words mime) <$> parseURIReference uri
    ret <- fetchURLs session (html referer) (url referer) $ catMaybes srcs
    c_ret <- forM ret $ \(url, html, css) ->
        newStablePtr $ Page url css html
    newArray0 nullPtr $ map castStablePtrToPtr c_ret

pairs (a:b:c) = (a, b):pairs c
pairs _ = []
pair a b = (a, b)


foreign export ccall c_renderDoc :: StablePtr Session -> PtrPage -> IO CString -- Hard to C bindings without IO

c_renderDoc c_session c_page = do
    session <- deRefStablePtr c_session
    page <- deRefStablePtr $ castPtrToStablePtr c_page
    css' <- retreiveStyles session $ css page
    toStrict (renderDoc css' $ documentRoot $ html page) `useAsCString` \cstr -> do
        str <- peekCString cstr
        newCString str


foreign export ccall c_extractLinks :: PtrPage -> IO (CArray CString)

c_extractLinks c_page = do
    page <- deRefStablePtr $ castPtrToStablePtr c_page
    ret <- forM (extractLinks $ html page) $ \link -> do
        c_label <- text2cstring $ label link
        c_title <- text2cstring $ title link
        c_href <- newCString $ uriToString id (href link) ""
        return [c_label, c_title, c_href]
    emptyCStr <- newCString ""
    newArray0 emptyCStr $ concat ret

text2cstring txt = Txt.withCStringLen txt $ \s -> (peekCStringLen s >>= newCString)

foreign export ccall c_docLinksAndRendering :: StablePtr Session -> PtrPage -> IO (CArray CString)

c_docLinksAndRendering c_session c_page = do
    (c_links, ssml) <- c_extractLinks c_page `concurrently` c_renderDoc c_session c_page
    nil <- newCString ""
    links <- peekArray0 nil c_links
    newArray0 nil (ssml : links)