Make it build with wasm backend

Author: TerrorJack

cabal.project

@@ -2,8 +2,147 @@ packages: .
           pandoc-lua-engine
           pandoc-server
           pandoc-cli
-tests: True
-flags: +embed_data_files
+
+tests: False
+
 constraints: skylighting-format-blaze-html >= 0.1.1.2,
              skylighting-format-context >= 0.1.0.2
 
+index-state: 2024-11-15T08:25:42Z
+
+allow-newer: all:zlib
+
+package aeson
+  flags: -ordered-keymap
+
+package crypton
+  ghc-options: -optc-DARGON2_NO_THREADS
+
+package digest
+  flags: -pkg-config
+
+package pandoc
+  flags: +embed_data_files
+
+package pandoc-cli
+  flags: -lua -server
+
+allow-newer:
+  all:Cabal,
+  all:Cabal-syntax,
+  all:array,
+  all:base,
+  all:binary,
+  all:bytestring,
+  all:containers,
+  all:deepseq,
+  all:directory,
+  all:exceptions,
+  all:filepath,
+  all:ghc,
+  all:ghc-bignum,
+  all:ghc-boot,
+  all:ghc-boot-th,
+  all:ghc-compact,
+  all:ghc-experimental,
+  all:ghc-heap,
+  all:ghc-internal,
+  all:ghc-platform,
+  all:ghc-prim,
+  all:ghc-toolchain,
+  all:ghci,
+  all:haskeline,
+  all:hpc,
+  all:integer-gmp,
+  all:mtl,
+  all:os-string,
+  all:parsec,
+  all:pretty,
+  all:process,
+  all:rts,
+  all:semaphore-compat,
+  all:stm,
+  all:system-cxx-std-lib,
+  all:template-haskell,
+  all:text,
+  all:time,
+  all:transformers,
+  all:unix,
+  all:xhtml
+
+constraints:
+  Cabal installed,
+  Cabal-syntax installed,
+  array installed,
+  base installed,
+  binary installed,
+  bytestring installed,
+  containers installed,
+  deepseq installed,
+  directory installed,
+  exceptions installed,
+  filepath installed,
+  ghc installed,
+  ghc-bignum installed,
+  ghc-boot installed,
+  ghc-boot-th installed,
+  ghc-compact installed,
+  ghc-experimental installed,
+  ghc-heap installed,
+  ghc-internal installed,
+  ghc-platform installed,
+  ghc-prim installed,
+  ghc-toolchain installed,
+  ghci installed,
+  haskeline installed,
+  hpc installed,
+  integer-gmp installed,
+  mtl installed,
+  os-string installed,
+  parsec installed,
+  pretty installed,
+  process installed,
+  rts installed,
+  semaphore-compat installed,
+  stm installed,
+  system-cxx-std-lib installed,
+  template-haskell installed,
+  text installed,
+  time installed,
+  transformers installed,
+  unix installed,
+  xhtml installed
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-wasm/conduit.git
+  tag: ff33329247f2ef321dcab836e98c1bcfaff2bd13
+  subdir: conduit-extra
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-wasm/foundation.git
+  tag: 8e6dd48527fb429c1922083a5030ef88e3d58dd3
+  subdir: basement
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-wasm/hs-memory.git
+  tag: a198a76c584dc2cfdcde6b431968de92a5fed65e
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-wasm/streaming-commons.git
+  tag: 7e9c38b2fd55ce50d3f74fe708ca47db8c9bb315
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-wasm/xml.git
+  tag: bc793dc9bc29c92245d3482a54d326abd3ae1403
+  subdir: xml-conduit
+
+-- https://github.com/haskellari/splitmix/pull/73
+source-repository-package
+  type: git
+  location: https://github.com/amesgen/splitmix
+  tag: 5f5b766d97dc735ac228215d240a3bb90bc2ff75

pandoc-cli/pandoc-cli.cabal

@@ -61,7 +61,7 @@ common common-options
 
 common common-executable
   import:           common-options
-  ghc-options:      -rtsopts -with-rtsopts=-A8m -threaded
+  ghc-options:      -rtsopts -with-rtsopts=-H64m
 
 executable pandoc
   import:          common-executable
@@ -74,6 +74,10 @@ executable pandoc
                    text
   other-modules:   PandocCLI.Lua
                  , PandocCLI.Server
+
+  if arch(wasm32)
+    ghc-options:    -optl-Wl,--export=__wasm_call_ctors,--export=hs_init_with_rtsopts,--export=malloc,--export=wasm_main
+
   if flag(nightly)
     cpp-options:    -DNIGHTLY
     build-depends:  template-haskell,

pandoc-cli/src/pandoc.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
+
 {- |
    Module      : Main
    Copyright   : Copyright (C) 2006-2024 John MacFarlane
@@ -34,6 +36,13 @@ import qualified Language.Haskell.TH as TH
 import Data.Time
 #endif
 
+#if defined(wasm32_HOST_ARCH)
+import Control.Exception
+import Foreign
+import Foreign.C
+import System.IO
+#endif
+
 #ifdef NIGHTLY
 versionSuffix :: String
 versionSuffix = "-nightly-" ++
@@ -44,6 +53,24 @@ versionSuffix :: String
 versionSuffix = ""
 #endif
 
+#if defined(wasm32_HOST_ARCH)
+
+foreign export ccall "wasm_main" wasm_main :: Ptr CChar -> Int -> IO ()
+
+wasm_main :: Ptr CChar -> Int -> IO ()
+wasm_main raw_args_ptr raw_args_len =
+  catch act (\(err :: SomeException) -> hPrint stderr err)
+  where
+    act = do
+      args <- words <$> peekCStringLen (raw_args_ptr, raw_args_len)
+      free raw_args_ptr
+      engine <- getEngine
+      res <- parseOptionsFromArgs options defaultOpts "pandoc.wasm" $ args <> ["/in", "-o", "/out"]
+      case res of
+        Left e -> handleOptInfo engine e
+        Right opts -> convertWithOpts engine opts
+#endif
+
 main :: IO ()
 main = E.handle (handleError . Left) $ do
   prg <- getProgName

pandoc.cabal

@@ -495,7 +495,6 @@ library
                  commonmark-pandoc     >= 0.2.2.2  && < 0.3,
                  containers            >= 0.6.0.1  && < 0.8,
                  crypton               >= 0.30     && < 1.1,
-                 crypton-connection    >= 0.3.1    && < 0.5,
                  data-default          >= 0.4      && < 0.8,
                  deepseq               >= 1.3      && < 1.6,
                  directory             >= 1.2.3    && < 1.4,
@@ -507,14 +506,11 @@ library
                  filepath              >= 1.1      && < 1.6,
                  gridtables            >= 0.1      && < 0.2,
                  haddock-library       >= 1.10     && < 1.12,
-                 http-client           >= 0.4.30   && < 0.8,
-                 http-client-tls       >= 0.2.4    && < 0.4,
                  http-types            >= 0.8      && < 0.13,
                  ipynb                 >= 0.2      && < 0.3,
                  jira-wiki-markup      >= 1.5.1    && < 1.6,
                  mime-types            >= 0.1.1    && < 0.2,
                  mtl                   >= 2.2      && < 2.4,
-                 network               >= 2.6      && < 3.3,
                  network-uri           >= 2.6      && < 2.8,
                  pandoc-types          >= 1.23.1   && < 1.24,
                  parsec                >= 3.1      && < 3.2,
@@ -542,9 +538,7 @@ library
                  xml                   >= 1.3.12   && < 1.4,
                  typst                 >= 0.6      && < 0.6.1,
                  vector                >= 0.12     && < 0.14,
-                 djot                  >= 0.1.2.2  && < 0.2,
-                 tls                   >= 2.0.1    && < 2.2,
-                 crypton-x509-system   >= 1.6.7    && < 1.7
+                 djot                  >= 0.1.2.2  && < 0.2
 
   if !os(windows)
     build-depends:  unix >= 2.4 && < 2.9

src/Text/Pandoc/Class/IO.hs

@@ -41,16 +41,7 @@ import Data.ByteString.Lazy (toChunks)
 import Data.Text (Text, pack, unpack)
 import Data.Time (TimeZone, UTCTime)
 import Data.Unique (hashUnique)
-import Network.Connection (TLSSettings(..))
-import qualified Network.TLS as TLS
-import qualified Network.TLS.Extra as TLS
-import Network.HTTP.Client
-       (httpLbs, responseBody, responseHeaders,
-        Request(port, host, requestHeaders), parseRequest, newManager)
-import Network.HTTP.Client.Internal (addProxy)
-import Network.HTTP.Client.TLS (mkManagerSettings)
 import Network.HTTP.Types.Header ( hContentType )
-import Network.Socket (withSocketsDo)
 import Network.URI (URI(..), parseURI, unEscapeString)
 import System.Directory (createDirectoryIfMissing)
 import System.Environment (getEnv)
@@ -83,7 +74,6 @@ import qualified System.FilePath.Glob
 import qualified System.Random
 import qualified Text.Pandoc.UTF8 as UTF8
 import Data.Default (def)
-import System.X509 (getSystemCertificateStore)
 #ifndef EMBED_DATA_FILES
 import qualified Paths_pandoc as Paths
 #endif
@@ -129,6 +119,9 @@ openURL u
  | Just (URI{ uriScheme = "data:",
               uriPath = upath }) <- parseURI (T.unpack u)
      = pure $ extractURIData upath
+#if defined(wasm32_HOST_ARCH)
+ | otherwise = error "Text.Pandoc.Class.IO.openURL"
+#else
  | otherwise = do
      let toReqHeader (n, v) = (CI.mk (UTF8.fromText n), UTF8.fromText v)
      customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders
@@ -168,6 +161,7 @@ openURL u
      case res of
           Right r -> return r
           Left e  -> throwError $ PandocHttpError u e
+#endif
 
 -- | Read the lazy ByteString contents from a file path, raising an error on
 -- failure.

src/Text/Pandoc/Class/PandocMonad.hs

@@ -491,11 +491,13 @@ fillMediaBag d = walkM handleImage d
                             "replacing image with description"
                   -- emit alt text
                   return $ replacementSpan attr src tit lab
+#if !defined(wasm32_HOST_ARCH)
                 PandocHttpError u er -> do
                   report $ CouldNotFetchResource u
                             (T.pack $ show er ++ "\rReplacing image with description.")
                   -- emit alt text
                   return $ replacementSpan attr src tit lab
+#endif
                 _ -> throwError e)
         handleImage x = return x
 

src/Text/Pandoc/Error.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE OverloadedStrings  #-}
@@ -25,7 +26,9 @@ import Data.Word (Word8)
 import Data.Text (Text)
 import qualified Data.Text as T
 import GHC.Generics (Generic)
+#if !defined(wasm32_HOST_ARCH)
 import Network.HTTP.Client (HttpException)
+#endif
 import System.Exit (ExitCode (..), exitWith)
 import System.IO (stderr)
 import qualified Text.Pandoc.UTF8 as UTF8
@@ -34,7 +37,9 @@ import Text.Pandoc.Shared (tshow)
 import Citeproc (CiteprocError, prettyCiteprocError)
 
 data PandocError = PandocIOError Text IOError
+#if !defined(wasm32_HOST_ARCH)
                  | PandocHttpError Text HttpException
+#endif
                  | PandocShouldNeverHappenError Text
                  | PandocSomeError Text
                  | PandocParseError Text
@@ -73,8 +78,10 @@ renderError :: PandocError -> Text
 renderError e =
   case e of
     PandocIOError _ err' -> T.pack $ displayException err'
+#if !defined(wasm32_HOST_ARCH)
     PandocHttpError u err' ->
       "Could not fetch " <> u <> "\n" <> tshow err'
+#endif
     PandocShouldNeverHappenError s ->
       "Something we thought was impossible happened!\n" <>
       "Please report this to pandoc's developers: " <> s
@@ -169,7 +176,9 @@ handleError (Left e) =
       PandocPDFError{} -> 43
       PandocXMLError{} -> 44
       PandocPDFProgramNotFoundError{} -> 47
+#if !defined(wasm32_HOST_ARCH)
       PandocHttpError{} -> 61
+#endif
       PandocShouldNeverHappenError{} -> 62
       PandocSomeError{} -> 63
       PandocParseError{} -> 64

src/Text/Pandoc/SelfContained.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase        #-}
@@ -422,9 +423,11 @@ getData mimetype src
                  PandocResourceNotFound r -> do
                    report $ CouldNotFetchResource r ""
                    return $ CouldNotFetch e
+#if !defined(wasm32_HOST_ARCH)
                  PandocHttpError u er -> do
                    report $ CouldNotFetchResource u (tshow er)
                    return $ CouldNotFetch e
+#endif
                  _ -> throwError e