{-# 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, fromMaybe)

import Input (fetchDocument, docForText)
import Data.HTML2CSS (html2css)

-- 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
import Data.Text (strip)

-- 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_initialReferer :: IO (StablePtr Page)

c_initialReferer = do
    cwd <- getCurrentDirectory
    newStablePtr $ 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 = []
        }
    }

foreign export ccall c_freePage :: StablePtr Page -> IO ()

c_freePage = freeStablePtr


foreign export ccall c_fetchURL :: StablePtr Session -> CString -> StablePtr Page -> CString -> IO (StablePtr Page)

c_fetchURL c_session c_mimes c_referer c_uri = do
    session <- deRefStablePtr c_session
    mimes <- peekCString c_mimes
    referer <- deRefStablePtr c_referer
    uri <- peekCString c_uri
    let uri' = nullURI `fromMaybe` parseURIReference uri `relativeTo` url referer
    doc <- fetchDocument session (words mimes) uri'
    newStablePtr $ Page {url = uri', html = doc, css = html2css doc uri'}

-- FIXME: Segfaults, was intended for a playlist feature
--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 <- deRefStablePtr $ castPtrToStablePtr c_referer
--    nil <- newCString ""
--    srcCStrs <- peekArray0 nil 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 -> StablePtr Page -> IO CString -- Hard to C bindings without IO

c_renderDoc c_session c_page = do
    session <- deRefStablePtr c_session
    page <- deRefStablePtr 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 :: StablePtr Page -> IO (CArray CString)

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

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

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

c_docLinksAndRendering c_session c_page = do
    c_links <- c_extractLinks c_page
    ssml <- c_renderDoc c_session c_page
    -- (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)