{-# LANGUAGE OverloadedStrings #-}
module CExports where

import Types
import Network.URI.Fetch (Session)

import Render (c_renderDoc)
import Links (c_extractLinks)
import qualified Text.XML as XML
import qualified Data.Text as Txt
import qualified Data.Text.Lazy as Txt (fromStrict)
import qualified Data.Map as M

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

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

-- FIXME: Segfaults, was intended for the sake of easy concurrency.
foreign export ccall c_docLinksAndRendering :: StablePtr Session -> StablePtr Page -> Bool -> IO (CArray CString)

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

-- Since I have XML Conduit here...
ssmlHasMark :: Txt.Text -> XML.Element -> Bool
ssmlHasMark ident (XML.Element "mark" attrs _) = Just ident == M.lookup "name" attrs
ssmlHasMark ident (XML.Element _ _ childs) = or [ssmlHasMark ident el | XML.NodeElement el <- childs]

foreign export ccall c_ssmlHasMark :: CString -> CString -> IO Bool

c_ssmlHasMark c_ident c_ssml = do
    ident <- peekCString c_ident
    ssml <- peekCString c_ssml
    case XML.parseText XML.def $ Txt.fromStrict $ Txt.pack ssml of
        Left _ -> return False
        Right doc -> return $ ssmlHasMark (Txt.pack ident) $ XML.documentRoot doc