pandoc_rb 0.2.2

data/pandoc_rb.gemspec

@@ -0,0 +1,37 @@
+# coding: utf-8
+
+lib = File.expand_path("../lib", __FILE__)
+$LOAD_PATH.unshift(lib) unless $LOAD_PATH.include?(lib)
+require "pandoc_rb/version"
+
+$gem_spec = Gem::Specification.new do |spec|
+  spec.name          = "pandoc_rb"
+  spec.platform      = Gem::Platform::RUBY
+  spec.version       = PandocRb::VERSION
+  spec.authors       =  ["Michael Klein"]
+  spec.email         =  ['lambdamichael@gmail.com']
+
+  spec.summary       =  "FFI bindings to Pandoc"
+  spec.description   =  "Fast bindings to Pandoc through Ruby's C FFI gem and Haskell's C FFI"
+  spec.homepage      =  'http://rubygems.org/gems/pandoc_rb'
+  spec.license       =  'BSD-3-Clause'
+
+  spec.files         = `git ls-files -z`.split("\x0").reject do |f|
+    f.match(%r{^(test|spec|features)/}) || f.match(/\.(so|o)$/)
+  end
+  spec.bindir        = "bin"
+  spec.executables   = spec.files.grep(%r{^bin/}) { |f| File.basename(f) }
+  spec.require_paths = ["lib"]
+  spec.extensions    = ['ext/pandoc_rb/extconf.rb']
+
+  spec.add_development_dependency "bundler", "~> 1.15.1"
+  spec.add_development_dependency "rake", "~> 10.0"
+  spec.add_development_dependency "minitest", "~> 5.0"
+  spec.add_development_dependency "pry"
+  spec.add_development_dependency "pry-byebug"
+  spec.add_development_dependency "pandoc-ruby"
+  spec.add_development_dependency "rake-compiler"
+  spec.add_development_dependency "benchmark-ips"
+  spec.add_development_dependency "kalibera"
+end
+

data/src/Text/Pandoc/C.hs

@@ -0,0 +1,217 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Text.Pandoc.C where
+
+import Control.Monad.Trans.Class  (lift)
+import Control.Monad.Trans.Either (EitherT(..))
+import Data.Aeson                 (ToJSON(..), genericToEncoding, defaultOptions, genericToJSON, encode)
+import Data.Bifunctor             (bimap, second)
+import Data.ByteString.Lazy       (toStrict, fromStrict)
+import Data.ByteString            (useAsCStringLen)
+import Data.ByteString.Unsafe     (unsafePackMallocCStringLen, unsafeFinalize)
+import Data.Monoid                ((<>))
+import Foreign.C.String           (CStringLen, peekCStringLen, newCStringLen)
+import Foreign.C.Types            (CChar, CLong, CInt(..))
+import Foreign.Marshal.Alloc      (malloc)
+import Foreign.Ptr                (Ptr)
+import Foreign.Storable           (peek, poke)
+import Foreign.Storable.Tuple     ()
+import GHC.Generics               (Generic)
+import Prelude hiding             (log)
+import Text.Pandoc                (ReaderOptions, Pandoc, WriterOptions(..), PandocError(..), Reader(..), Writer(..), HTMLMathMethod(..), writerMediaBag, getReader, getWriter, def)
+import Text.Pandoc.MediaBag       (MediaBag, extractMediaBag)
+import Text.Parsec.Error          (ParseError, Message(..), errorPos, errorMessages)
+import Text.Parsec.Pos            (SourcePos, SourceName, Line, Column, sourceName, sourceLine, sourceColumn)
+import System.Timeout             (timeout)
+import Control.Concurrent
+
+
+
+
+-- | The `Reader` type modified for foreign C exports
+type CReader = ReaderOptions -> CStringLen -> EitherT CStringLen IO (Pandoc, MediaBag)
+
+-- | The `Writer` type modified for foreign C exports
+type CWriter = WriterOptions -> Pandoc -> EitherT CStringLen IO CStringLen
+
+
+-- | Apply a monadic action to the left of an `EitherT`
+mapML :: Monad m => (a -> m b) -> EitherT a m c -> EitherT b m c
+mapML f (EitherT m) = EitherT $ do
+  m' <- m
+  case m' of
+    ( Left  x) ->     Left  <$> f x
+    ~(Right y) -> return $ Right     y
+
+-- | Apply a monadic action to the right of an `EitherT`
+mapMR :: Monad m => (b -> m c) -> EitherT a m b -> EitherT a m c
+mapMR f (EitherT m) = EitherT $ do
+  m' <- m
+  case m' of
+    ( Left  x) -> return $ Left      x
+    ~(Right y) ->     Right <$> f y
+
+
+-- | This function forks a thread to both catch exceptions and better kill infinite loops that can't be caught with `timeout` alone.
+-- For example, @timeout 10 (forever $ return ())@ will never time out, but @timeoutEitherT 10 (lift $ forever $ return ())@ will.
+--
+-- timeoutEitherT is strict within the created thread
+timeoutEitherT :: Int -> EitherT CStringLen IO b -> EitherT CStringLen IO b
+timeoutEitherT us (EitherT io) = EitherT $ do
+  mvar   <- newEmptyMVar
+  tid    <- io `forkFinally` (putMVar mvar $!)
+  result <- timeout us (takeMVar mvar)
+  case result of
+    ( Nothing       )                          -> killThread tid >> Left <$> newCStringLen ("Pandoc timed out after " ++ show us ++ "microseconds")
+    ~(Just noTimeout) -> case noTimeout of
+                           ( Right successful) -> return successful
+                           ~(Left  err       ) -> Left <$> newCStringLen ("Pandoc internal error: " ++ show err)
+
+
+
+-- | A clone of `SourcePos`, to allow deriving `Generic`
+data SourcePos' = SourcePos' SourceName !Line !Column deriving (Eq, Ord, Show, Generic)
+
+instance ToJSON SourcePos' where
+  toEncoding = genericToEncoding defaultOptions
+
+deriving instance Generic Message
+
+instance ToJSON Message where
+  toEncoding = genericToEncoding defaultOptions
+
+-- | A clone of `ParseError`, to allow deriving `Generic`
+data ParseError' = ParseError' !SourcePos' [Message] deriving (Generic)
+
+-- | Convert to our clone of `SourcePos`
+sourcePos' :: SourcePos -> SourcePos'
+sourcePos' !sp = SourcePos' (sourceName sp) (sourceLine sp) (sourceColumn sp)
+
+-- | Convert to our clone of `ParseError`
+parseError' :: ParseError -> ParseError'
+parseError' !pe = ParseError' (sourcePos' (errorPos pe)) (errorMessages pe)
+
+
+instance ToJSON ParseError where
+  toJSON = genericToJSON defaultOptions . parseError'
+  toEncoding = genericToEncoding defaultOptions . parseError'
+
+instance ToJSON PandocError where
+    toEncoding = genericToEncoding defaultOptions
+
+-- | Convert a `PandocError` to JSON
+showPandocError :: PandocError -> IO CStringLen
+showPandocError = flip useAsCStringLen return . toStrict . encode
+
+
+-- | Convert a `Reader` to a `CReader`
+mkCReader :: Reader -> CReader
+mkCReader  (StringReader     reader) opts cstr = mapML showPandocError . EitherT $ do
+  str          <- peekCStringLen cstr
+  readerResult <- reader opts str
+  return $ second (, mempty) $! readerResult
+mkCReader ~(ByteStringReader reader) opts  str = mapML showPandocError . EitherT $ do
+  bs           <- unsafePackMallocCStringLen str
+  readerResult <- reader opts $! fromStrict bs
+  readerResult `seq` unsafeFinalize bs
+  return readerResult
+
+
+-- | Convert a `Writer` to a `CWriter`
+mkCWriter :: Writer -> CWriter
+mkCWriter  (PureStringWriter   writer) opts pandoc = lift $ newCStringLen $ writer opts pandoc
+mkCWriter  (IOStringWriter     writer) opts pandoc = lift $ writer opts pandoc >>= newCStringLen
+mkCWriter ~(IOByteStringWriter writer) opts pandoc = lift $ writer opts pandoc >>= flip useAsCStringLen return . toStrict
+
+-- | `getReader` for foreign C exports. Retrieve reader based on formatSpec (format+extensions).
+getCReader :: CStringLen -> EitherT CStringLen IO CReader
+getCReader cstr = do
+  str <- lift . peekCStringLen $ cstr
+  EitherT $ case getReader str of
+    ( Left  err   ) ->     Left  <$> newCStringLen err
+    ~(Right reader) -> return . Right $ mkCReader reader
+
+-- | `getWriter` for foreign C exports. Retrieve writer based on formatSpec (format+extensions).
+getCWriter :: CStringLen -> EitherT CStringLen IO CWriter
+getCWriter cstr = do
+  str <- lift . peekCStringLen $ cstr
+  EitherT $ case getWriter str of
+    ( Left  err   ) ->      Left <$> newCStringLen err
+    ~(Right writer) -> return . Right $ mkCWriter writer
+
+extractCMediabag :: Bool -> CStringLen -> MediaBag -> EitherT CStringLen IO ()
+extractCMediabag verbose cPath mediaBag = do
+  path <- lift . peekCStringLen $ cPath
+  case path of
+    []           -> return ()
+    nonEmptyPath -> lift $ extractMediaBag verbose nonEmptyPath mediaBag
+
+-- | The main conversion function.
+-- Takes `ReaderOptions`, `WriterOptions`, reader's formatSpec,
+-- writer's formatSpec, input and returns either an error string
+-- or the output
+convert :: ReaderOptions
+        -> WriterOptions
+        -> CStringLen                       -- ^ Reader specification
+        -> CStringLen                       -- ^ Writer specification
+        -> CStringLen                       -- ^ Input
+        -> CStringLen                       -- ^ Extract media dir
+        -> EitherT CStringLen IO CStringLen -- ^ Either an error string or the output
+convert readerOpts writerOpts readerStr writerStr input mediaBagStr = do
+  reader             <- getCReader readerStr
+  (pandoc, mediaBag) <- reader readerOpts input
+  extractCMediabag False mediaBagStr mediaBag
+  writer             <- getCWriter writerStr
+  let writerOpts'    = writerOpts { writerMediaBag = writerMediaBag writerOpts <> mediaBag }
+  writer writerOpts' pandoc
+
+-- | The `ReaderOptions` wired into the foreign export
+readerOptions :: ReaderOptions
+readerOptions = def
+
+-- | The `WriterOptions` wired into the foreign export
+writerOptions :: WriterOptions
+writerOptions = def { writerHTMLMathMethod = MathJax "https://fail.cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" }
+
+-- | `CStringLen` for use by Ruby
+type RStringLen = (Ptr CChar, CLong)
+
+-- -- | Free the resulting type of `convert_hs`
+-- freeResult :: Ptr () -> IO ()
+-- freeResult !addr = do
+--   (_, strAddr, _) <- peek (castPtr addr :: Ptr (CInt, Ptr CChar, CLong))
+--   free strAddr
+--   free addr
+
+-- foreign export ccall freeResult :: Ptr () -> IO ()
+
+-- | Takes: reader, writer, input and returns (isSuccess, output pointer, output length)
+convert_hs :: Ptr RStringLen -> Ptr RStringLen -> Ptr RStringLen -> Ptr RStringLen -> IO (Ptr (CInt, Ptr CChar, CLong))
+convert_hs readerStr writerStr input mediaBagStr = do
+  readerStr'                        <- second fromEnum <$> peek readerStr
+  writerStr'                        <- second fromEnum <$> peek writerStr
+  input'                            <- second fromEnum <$> peek input
+  mediaBagStr'                      <- second fromEnum <$> peek mediaBagStr
+  let converted                     =  convert readerOptions writerOptions readerStr' writerStr' input' mediaBagStr'
+  let EitherT safeConverted         =  timeoutEitherT (10 * {- minutes -} 60000000) converted
+  result                            <- bimap (second toEnum) (second toEnum) <$> safeConverted
+  let (success, (rstrPtr, rstrLen)) =  either (0,) (1,) result
+  addr                              <- malloc
+  addr `poke` (success, rstrPtr, rstrLen)
+  return addr
+
+foreign export ccall convert_hs :: Ptr RStringLen -> Ptr RStringLen -> Ptr RStringLen -> Ptr RStringLen -> IO (Ptr (CInt, Ptr CChar, CLong))
+
+-- -- | Dummy main to dissuade the compiler from warning a lack of @_main@
+-- main :: IO CInt
+-- main = print "hi there! I'm main. you probably shouldn't see me." >> return 0
+
+-- foreign export ccall main :: IO CInt
+

data/src/Text/Pandoc/C_stub.h

@@ -0,0 +1,9 @@
+#include "HsFFI.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern HsPtr convert_hs(HsPtr a1, HsPtr a2, HsPtr a3, HsPtr a4);
+#ifdef __cplusplus
+}
+#endif
+

metadata

@@ -0,0 +1,206 @@
+--- !ruby/object:Gem::Specification
+name: pandoc_rb
+version: !ruby/object:Gem::Version
+  version: 0.2.2
+platform: ruby
+authors:
+- Michael Klein
+autorequire: 
+bindir: bin
+cert_chain: []
+date: 2018-02-10 00:00:00.000000000 Z
+dependencies:
+- !ruby/object:Gem::Dependency
+  name: bundler
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - "~>"
+      - !ruby/object:Gem::Version
+        version: 1.15.1
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - "~>"
+      - !ruby/object:Gem::Version
+        version: 1.15.1
+- !ruby/object:Gem::Dependency
+  name: rake
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - "~>"
+      - !ruby/object:Gem::Version
+        version: '10.0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - "~>"
+      - !ruby/object:Gem::Version
+        version: '10.0'
+- !ruby/object:Gem::Dependency
+  name: minitest
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - "~>"
+      - !ruby/object:Gem::Version
+        version: '5.0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - "~>"
+      - !ruby/object:Gem::Version
+        version: '5.0'
+- !ruby/object:Gem::Dependency
+  name: pry
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+- !ruby/object:Gem::Dependency
+  name: pry-byebug
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+- !ruby/object:Gem::Dependency
+  name: pandoc-ruby
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+- !ruby/object:Gem::Dependency
+  name: rake-compiler
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+- !ruby/object:Gem::Dependency
+  name: benchmark-ips
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+- !ruby/object:Gem::Dependency
+  name: kalibera
+  requirement: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+  type: :development
+  prerelease: false
+  version_requirements: !ruby/object:Gem::Requirement
+    requirements:
+    - - ">="
+      - !ruby/object:Gem::Version
+        version: '0'
+description: Fast bindings to Pandoc through Ruby's C FFI gem and Haskell's C FFI
+email:
+- lambdamichael@gmail.com
+executables:
+- console
+- setup
+extensions:
+- ext/pandoc_rb/extconf.rb
+extra_rdoc_files: []
+files:
+- ".gitignore"
+- ".ruby-gemset"
+- ".ruby-version"
+- ".travis.yml"
+- Gemfile
+- Gemfile.lock
+- LICENSE
+- LICENSE.txt
+- README.md
+- Rakefile
+- Setup.hs
+- bench/bench.rb
+- bin/console
+- bin/setup
+- ext/pandoc_rb/extconf.rb
+- ext/pandoc_rb/pandoc-rb.cabal
+- ext/pandoc_rb/pandoc_rb.c
+- ext/pandoc_rb/src/PandocRb.hs
+- ext/pandoc_rb/src/Text/Pandoc/C.hs
+- ext/pandoc_rb/src/Text/Pandoc/C/Types.hs
+- ext/pandoc_rb/src/Text/Pandoc/C/Utils.hs
+- ext/pandoc_rb/stack.yaml
+- ext/pandoc_rb/test/DetailedSpec.hs
+- lib/pandoc_rb.rb
+- lib/pandoc_rb/error.rb
+- lib/pandoc_rb/parse_failure.rb
+- lib/pandoc_rb/parsec_error.rb
+- lib/pandoc_rb/readers.rb
+- lib/pandoc_rb/version.rb
+- lib/pandoc_rb/writers.rb
+- pandoc_rb.gemspec
+- src/Text/Pandoc/C.hs
+- src/Text/Pandoc/C_stub.h
+homepage: http://rubygems.org/gems/pandoc_rb
+licenses:
+- BSD-3-Clause
+metadata: {}
+post_install_message: 
+rdoc_options: []
+require_paths:
+- lib
+required_ruby_version: !ruby/object:Gem::Requirement
+  requirements:
+  - - ">="
+    - !ruby/object:Gem::Version
+      version: '0'
+required_rubygems_version: !ruby/object:Gem::Requirement
+  requirements:
+  - - ">="
+    - !ruby/object:Gem::Version
+      version: '0'
+requirements: []
+rubyforge_project: 
+rubygems_version: 2.6.12
+signing_key: 
+specification_version: 4
+summary: FFI bindings to Pandoc
+test_files: []