5 files changed, 107 insertions(+), 53 deletions(-)

M rhapsode.cabal
M src/CExports.hs
M src/Input.hs
A src/Stub.hs
A src/main.c

@@ 49,12 49,12 @@ extra-source-files:  ChangeLog.md, README.md
 cabal-version:       >=1.10
 
 
-executable rhapsode
+library
   -- .hs or .lhs file containing the Main module.
-  main-is:             Main.hs
+  exposed-modules: CExports
   
-  -- Modules included in this executable, other than Main.
-  -- other-modules:       
+  -- Modules included in this library.
+  other-modules:       DefaultCSS, Input, Links, Render, SSML, StyleTree
   
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:    


@@ 72,3 72,10 @@ executable rhapsode
   -- Base language which the package is written in.
   default-language:    Haskell2010
   
+executable rhapsode
+  main-is: main.c
+  ghc-options: -no-hs-main
+  build-depends:       base >=4.9 && <=4.12, rhapsode
+  other-modules: Stub
+  hs-source-dirs: src
+  default-language: Haskell2010

@@ 16,9 16,10 @@ 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 Data.Maybe (catMaybes, fromMaybe)
 
-import Input (fetchURLs)
+import Input (fetchURLs, fetchDocument, docForText)
+import Data.HTML2CSS (html2css)
 
 -- For c_renderDoc
 import Render (retreiveStyles, renderDoc)


@@ 48,76 49,87 @@ c_freeSession = freeStablePtr
 data Page = Page {url :: URI, css :: ConditionalStyles StyleTree, html :: Document}
 type PtrPage = Ptr ()
 
-foreign export ccall c_freePages :: CArray PtrPage -> IO ()
+foreign export ccall c_initialReferer :: IO (StablePtr Page)
 
-c_freePages c_pages = do
-    pages <- peekArray0 nullPtr c_pages
-    forM pages (freeStablePtr . castPtrToStablePtr)
-    free c_pages
+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 ()
 
-foreign export ccall c_fetchURLs :: StablePtr Session -> PtrPage -> CArray CString -> IO (CArray PtrPage)
+c_freePage = freeStablePtr
 
-c_fetchURLs c_session c_referer c_srcs = do
+
+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
-    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
+    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 $ castPtrToStablePtr c_page
+    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 :: PtrPage -> IO (CArray CString)
+foreign export ccall c_extractLinks :: StablePtr Page -> IO (CArray CString)
 
 c_extractLinks c_page = do
-    page <- deRefStablePtr $ castPtrToStablePtr c_page
+    page <- deRefStablePtr 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
+    nil <- newCString ""
+    newArray0 nil $ concat ret
 
 text2cstring txt = Txt.withCStringLen txt $ \s -> (peekCStringLen s >>= newCString)
 
-foreign export ccall c_docLinksAndRendering :: StablePtr Session -> PtrPage -> IO (CArray CString)
+foreign export ccall c_docLinksAndRendering :: StablePtr Session -> StablePtr Page -> IO (CArray CString)
 
 c_docLinksAndRendering c_session c_page = do
     (c_links, ssml) <- c_extractLinks c_page `concurrently` c_renderDoc c_session c_page

@@ 1,5 1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Input(parseArgs, ProgramCtl(..), fetchURLs) where
+module Input(parseArgs, ProgramCtl(..), fetchURLs, fetchDocument, docForText) where
 
 import           Data.Text.Lazy (fromStrict)
 import qualified Data.Text as Txt

@@ 0,0 1,1 @@
+module Stub where

@@ 0,0 1,34 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "HsFFI.h"
+
+struct session;
+struct session *c_newSession();
+void c_freeSession(struct session*);
+
+struct page;
+struct page *c_initialReferer();
+void *c_fetchURL(struct session*, char*, char*);
+//struct page **c_fetchURLs(struct session*, struct page*, char**);
+void c_freePage(struct page*);
+
+char *c_renderDoc(struct session*, struct page*);
+char **c_extractLinks(struct page*);
+char **c_docLinksAndRendering(struct session*, struct page*);
+
+int main(int argc, char **argv) {
+    hs_init(&argc, &argv);
+    struct session *session = c_newSession();
+
+    struct page *referer = c_initialReferer();
+    struct page *page = c_fetchURL(session, "text/xml text/html text/plain", argv[1]);
+    // char *ssml = c_renderDoc(session, page); // FIXME segfaults alongside extractLinks & the combined function.
+
+    printf("%i Hello, world!\n", argc);
+
+    c_freePage(page);
+    c_freePage(referer);
+    c_freeSession(session);
+    hs_exit();
+}