4 files changed, 73 insertions(+), 104 deletions(-)

M src/CExports.hs
M src/Input.hs
M src/Links.hs
M src/Render.hs

@@ 1,87 1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
-module CExports(c_newSession) where
+module CExports where
 
--- For c_newSession
-import Network.URI.Fetch (Session, newSession)
+import Types
+import Network.URI.Fetch (Session)
 
--- 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)
+import Render (c_renderDoc)
+import Links (c_extractLinks)
 
 -- 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)


@@ 104,32 33,7 @@ c_fetchURL c_session c_mimes c_referer c_uri = do
 --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)
-
+-- FIXME: Segfaults, was intended for the sake of easy concurrency.
 foreign export ccall c_docLinksAndRendering :: StablePtr Session -> StablePtr Page -> IO (CArray CString)
 
 c_docLinksAndRendering c_session c_page = do

@@ 15,6 15,13 @@ import System.IO
 import System.IO.Temp
 import Data.Default.Class
 
+-- For C API
+import Types
+import Data.HTML2CSS (html2css)
+import Data.Maybe (fromMaybe)
+import Foreign.StablePtr
+import Foreign.C.String
+
 -- FIXME segfaults when exposed to C.
 --fetchURLs session refererDoc refererURL srcs = forConcurrently srcs $ \(mime, url) -> do
 --    let u = relativeTo url refererURL


@@ 72,3 79,22 @@ docForText txt = XML.Document {
         },
         XML.documentEpilogue = []
     }
+
+-- C API
+foreign export ccall c_newSession :: IO (StablePtr Session)
+foreign export ccall c_freeSession :: StablePtr Session -> IO ()
+
+c_newSession = newSession >>= newStablePtr
+c_freeSession = 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'}

@@ 1,12 1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Links(extractLinks, linkToText, Link(..)) where
+module Links(extractLinks, linkToText, Link(..), c_extractLinks) where
 
 import Text.XML
 import qualified Data.Map as M
 import Network.URI
 import Data.Text (Text, unpack, append, pack, replace, strip)
+import qualified Data.Text.Foreign as FTxt
 import Data.Maybe
 
+import Types
+import Foreign.StablePtr
+import Foreign.C.String
+import Foreign.Marshal.Array
+import Control.Monad (forM)
+
 data Link = Link {
     label :: Text,
     title :: Text,


@@ 57,3 64,18 @@ nodesText (NodeElement (Element _ attrs children):nodes) = nodesText children ++
 nodesText (NodeContent text:nodes) = text +++ nodesText nodes
 nodesText (_:nodes) = nodesText nodes
 nodesText [] = ""
+
+-- C API
+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 = FTxt.withCStringLen txt $ \s -> (peekCStringLen s >>= newCString)

@@ 1,5 1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Render(retreiveStyles, renderDoc) where
+module Render(retreiveStyles, renderDoc, c_renderDoc) where
 
 import qualified Data.ByteString.Lazy as B
 import qualified Text.XML as XML


@@ 22,6 22,12 @@ import DefaultCSS
 import StyleTree
 import SSML
 
+-- C API
+import Types
+import Foreign.StablePtr
+import Foreign.C.String
+import Data.ByteString (useAsCString)
+
 renderDoc style html =
     renderElLBS $ styleToSSML $ applyCounters $ stylize style html
 


@@ 140,3 146,14 @@ applyCounters root = root {
             incrementCounters path (counterIncrement node) $
             instantiateCounters path (counterReset node) $
             inheritCounters path counterSource valueSource
+
+-- C API
+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
+    B.toStrict (renderDoc css' $ XML.documentRoot $ html page) `useAsCString` \cstr -> do
+        str <- peekCString cstr
+        newCString str