~alcinnz/rhapsode

ref: 86729618330cab4ab7aca5cc758c6f36f859d7a7 rhapsode/src/CExports.hs -rw-r--r-- 1.6 KiB
86729618 — Adrian Cochrane Localize CSS into Dutch 4 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
module CExports where

import Types
import Network.URI.Fetch (Session)

import Render (c_renderDoc)
import Links (c_extractLinks)

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