pandoc_rb 0.2.2

data/ext/pandoc_rb/stack.yaml

@@ -0,0 +1,70 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-8.19
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- '.'
+- location:
+    git: https://github.com/Authorea/pandoc.git
+    commit: 1303092cdfcc3b6f13ab8d2996b6d3c3465279f2
+  extra-dep: true
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.3"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

data/ext/pandoc_rb/test/DetailedSpec.hs

@@ -0,0 +1,173 @@
+{-# LANGUAGE PackageImports, NamedFieldPuns #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module DetailedSpec (tests) where
+
+import qualified Test.QuickCheck as Q
+import Distribution.TestSuite as TS
+
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Either
+import Data.Bifunctor
+import Data.Either
+import Distribution.TestSuite
+import Foreign.C.String
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import Test.QuickCheck
+import Text.Pandoc
+import Text.Pandoc.C
+import Text.Pandoc.C.Types
+import Text.Pandoc.C.Utils
+
+
+instance Show (Bool -> Maybe Int) where
+  show f = concat ["f False = ", show (f False), "; f True = ", show (f True)]
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (EitherT a Maybe b) where
+  arbitrary = oneof [ return . EitherT $ Nothing
+                    , (EitherT . Just . Left ) <$> arbitrary
+                    , (EitherT . Just . Right) <$> arbitrary
+                    ]
+
+
+
+testGotCReader :: String -> Property
+testGotCReader readerStr = ioProperty $ withCStringLen readerStr (fmap isRight . runEitherT . getCReader)
+
+testGotCWriter :: String -> Property
+testGotCWriter writerStr = ioProperty $ withCStringLen writerStr (fmap isRight . runEitherT . getCWriter)
+
+allProps :: (Functor t, Foldable t, Testable prop) => (a -> prop) -> t a -> Property
+allProps f = foldr (.&&.) (property True) . fmap f
+
+allPropsIO :: (Applicative t, Traversable t, Testable prop) => (a -> IO prop) -> t a -> Property
+allPropsIO f = ioProperty . fmap (foldr (.&&.) (property True)) . mapM f
+
+
+foreign import ccall "dynamic" freerFunc :: FunPtr (Ptr a -> IO ()) -> Ptr a -> IO ()
+
+
+prop_mapMLIgnoresRight0 :: Bool
+prop_mapMLIgnoresRight0 = mapML (const $ Just ()) (EitherT (Just (Right True))) == EitherT (Just (Right True))
+
+prop_mapMLIgnoresRight1 :: Bool
+prop_mapMLIgnoresRight1 = mapML (const $ Nothing) (EitherT (Just (Right True))) == (EitherT (Just (Right True)) :: EitherT () Maybe Bool)
+
+prop_mapMLAppliesFunction0 :: Bool
+prop_mapMLAppliesFunction0 = mapML (const $ Just ()) (EitherT (Just (Left 0))) == (EitherT (Just (Left ())) :: EitherT () Maybe Bool)
+
+prop_mapMLAppliesFunction1 :: Bool
+prop_mapMLAppliesFunction1 = mapML (const $ Nothing) (EitherT (Just (Left (0 :: Int)))) == (EitherT Nothing :: EitherT () Maybe Bool)
+
+prop_mapMRIgnoresRight0 :: Bool
+prop_mapMRIgnoresRight0 = mapMR (const $ Just ()) (EitherT (Just (Left True))) == EitherT (Just (Left True))
+
+prop_mapMRIgnoresRight1 :: Bool
+prop_mapMRIgnoresRight1 = mapMR (const $ Nothing) (EitherT (Just (Left True))) == (EitherT (Just (Left True)) :: EitherT Bool Maybe ())
+
+prop_mapMRAppliesFunction0 :: Bool
+prop_mapMRAppliesFunction0 = mapMR (const $ Just ()) (EitherT (Just (Right (0 :: Int)))) == (EitherT (Just (Right ())) :: EitherT Bool Maybe ())
+
+prop_mapMRAppliesFunction1 :: Bool
+prop_mapMRAppliesFunction1 = mapMR (const $ Nothing) (EitherT (Just (Right (0 :: Int)))) == (EitherT Nothing :: EitherT Bool Maybe ())
+
+-- prop_mapMLisSwappedMapMR :: (Bool -> Maybe Int) -> EitherT Bool Maybe () -> Bool
+-- prop_mapMLisSwappedMapMR f x = mapML f x == swapEitherT (mapMR f (swapEitherT x))
+
+prop_getCReaderGetsReaders :: Property
+prop_getCReaderGetsReaders = allProps testGotCReader (fst <$> readers)
+
+prop_getCWriterGetsWriters :: Property
+prop_getCWriterGetsWriters = allProps testGotCWriter (fst <$> writers)
+
+-- prop_convert_hsWorks :: Property
+-- prop_convert_hsWorks = ioProperty $ do
+--   readerCStr <- newCStringLen "markdown"
+--   writerCStr <- newCStringLen "latex"
+--   inputCStr  <- newCStringLen "hi there!"
+--   readerRStr <- malloc
+--   writerRStr <- malloc
+--   inputRStr <- malloc
+--   readerRStr `poke` second toEnum readerCStr
+--   writerRStr `poke` second toEnum writerCStr
+--   inputRStr  `poke` second toEnum inputCStr
+--   resultPtr <- convert_hs readerRStr writerRStr inputRStr
+--   peek readerRStr >>= free . fst
+--   peek writerRStr >>= free . fst
+--   peek inputRStr  >>= free . fst
+--   free readerRStr
+--   free writerRStr
+--   free inputRStr
+--   (success, freer, output) <- peek resultPtr
+--   if success == 0
+--      then return False
+--      else do
+--        (freerFunc freer) (castPtr resultPtr)
+--        return True
+
+
+testTimeoutEitherT :: Testable prop => Int -> (CStringLen -> IO prop) -> (a -> IO prop) -> EitherT CStringLen IO a -> Property
+testTimeoutEitherT us ifLeft ifRight = ioProperty . eitherT ifLeft ifRight . timeoutEitherT us
+
+
+prop_timeoutEitherT_times_out_on_0 :: Property
+prop_timeoutEitherT_times_out_on_0 = testTimeoutEitherT 0 (\(ptr, _) -> free ptr >> return True) (\_->return False) $ return ()
+
+prop_timeoutEitherT_times_out_on_loose_loop :: Property
+prop_timeoutEitherT_times_out_on_loose_loop = testTimeoutEitherT 1 (\(ptr, _) -> free ptr >> return True) return $ lift $ mapM_ putStr (repeat "") >> return False
+
+prop_timeoutEitherT_times_out_on_tight_loop :: Property
+prop_timeoutEitherT_times_out_on_tight_loop = testTimeoutEitherT 1 (\(ptr, _) -> free ptr >> return True) (return . (== 0)) . lift . mfix $ (return $!)
+
+prop_timeoutEitherT_does_not_time_out_on_result :: Property
+prop_timeoutEitherT_does_not_time_out_on_result = testTimeoutEitherT 100 (\(ptr, _) -> free ptr >> return False) return $ return True
+
+prop_timeoutEitherT_catches_exceptions :: Property
+prop_timeoutEitherT_catches_exceptions = testTimeoutEitherT 100 (\(ptr, _) -> free ptr >> return True) (\_->return False) . lift . print $ (div 1 0 :: Int)
+
+-- prop_timeoutEitherT_catches_errors :: Property
+-- prop_timeoutEitherT_catches_errors = testTimeoutEitherT 100 (\(ptr, _) -> free ptr >> return True) (\_->return False) $ EitherT undefined
+
+prop_timeoutEitherT_catches_lefts :: Property
+prop_timeoutEitherT_catches_lefts = testTimeoutEitherT 100 (\(ptr, _) -> free ptr >> return True) (\_->return False) (EitherT $ Left <$> (newCStringLen ""))
+
+
+toTSResult :: Q.Result -> TS.Result
+toTSResult Q.Success {} = TS.Pass
+toTSResult Q.GaveUp {} = TS.Fail "GaveUp"
+toTSResult Q.Failure {Q.reason} = TS.Fail reason
+
+runQuickCheck :: Q.Testable p => p -> IO TS.Progress
+runQuickCheck prop = do
+        qres <- Q.quickCheckWithResult Q.stdArgs {Q.maxSuccess = 30,
+                                                  Q.maxSize = 20} prop
+        return $ (Finished . toTSResult) qres
+
+tests :: IO [Test]
+tests = return [
+  Test $ TestInstance (runQuickCheck prop_mapMLIgnoresRight0) "prop_mapMLIgnoresRight0" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMLIgnoresRight1) "prop_mapMLIgnoresRight1" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMLAppliesFunction0) "prop_mapMLAppliesFunction0" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMLAppliesFunction1) "prop_mapMLAppliesFunction1" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMRIgnoresRight0) "prop_mapMRIgnoresRight0" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMRIgnoresRight1) "prop_mapMRIgnoresRight1" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMRAppliesFunction0) "prop_mapMRAppliesFunction0" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_mapMRAppliesFunction1) "prop_mapMRAppliesFunction1" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_getCReaderGetsReaders) "prop_getCReaderGetsReaders" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_getCWriterGetsWriters) "prop_getCWriterGetsWriters" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_timeoutEitherT_times_out_on_0) "prop_timeoutEitherT_times_out_on_0" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_timeoutEitherT_does_not_time_out_on_result) "prop_timeoutEitherT_does_not_time_out_on_result" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_timeoutEitherT_catches_exceptions) "prop_timeoutEitherT_catches_exceptions" ["tag"] [] undefined,
+  -- Test $ TestInstance (runQuickCheck prop_timeoutEitherT_catches_errors) "prop_timeoutEitherT_catches_errors" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_timeoutEitherT_catches_lefts) "prop_timeoutEitherT_catches_lefts" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_timeoutEitherT_times_out_on_loose_loop) "prop_timeoutEitherT_times_out_on_loose_loop" ["tag"] [] undefined,
+  Test $ TestInstance (runQuickCheck prop_timeoutEitherT_times_out_on_tight_loop) "prop_timeoutEitherT_times_out_on_tight_loop" ["tag"] [] undefined
+  ]
+
+
+
+

data/lib/pandoc_rb.rb

@@ -0,0 +1,96 @@
+require 'pandoc_rb/pandoc_rb'
+require 'json'
+require 'pandoc_rb/error'
+require 'pandoc_rb/parse_failure'
+require 'pandoc_rb/parsec_error'
+require 'pandoc_rb/readers'
+require 'pandoc_rb/version'
+require 'pandoc_rb/writers'
+require 'timeout'
+
+
+module PandocRb
+  def self.raise_exception(result)
+    if    /^Unknown reader: / === result
+      raise ArgumentError, result
+    elsif /^Unknown writer: / === result
+      raise ArgumentError, result
+    elsif /^Pandoc timed out/ === result
+      raise Timeout::Error
+    elsif /^Pandoc internal / === result
+      raise PandocRb::Error, result.sub(/^Pandoc internal error: /, '')
+    end
+    result = JSON.parse result
+    if    result['tag'] == 'ParseFailure'
+      raise PandocRb::ParseFailure.new(result['contents'])
+    elsif result['tag'] == 'ParsecError'
+      raise PandocRb::ParsecError.new( result['contents'])
+    else
+      raise "Unknown error type returned from pandoc: #{result}"
+    end
+  end
+
+  def self.convert(in_format_str, out_format_str, input_str, extract_media_path='')
+    unless @PandocRb_loaded
+      self.convert_init
+      Kernel.at_exit do
+        PandocRb.convert_exit
+      end
+      @PandocRb_loaded = true
+    end
+
+    if in_format_str.to_s == 'docx'
+      input_str.force_encoding "UTF-8"
+    end
+
+    begin
+      in_format          = in_format_str.to_s.encode "UTF-8"
+      out_format         = out_format_str.to_s.encode "UTF-8"
+      input              = input_str.to_s.encode "UTF-8"
+      extract_media_path = extract_media_path.to_s.encode "UTF-8"
+      success, result    = PandocRb.convert_raw in_format, out_format, input, extract_media_path
+      self.raise_exception result if (success == false)
+      result
+    end
+  end
+
+  def self.reader_from_ext(extension)
+    {
+      ""          => "markdown",
+      ".tex"      => "latex",
+      ".latex"    => "latex",
+      ".ltx"      => "latex",
+      ".context"  => "context",
+      ".ctx"      => "context",
+      ".rtf"      => "rtf",
+      ".rst"      => "rst",
+      ".s5"       => "s5",
+      ".native"   => "native",
+      ".json"     => "json",
+      ".txt"      => "markdown",
+      ".text"     => "markdown",
+      ".md"       => "markdown",
+      ".markdown" => "markdown",
+      ".textile"  => "textile",
+      ".lhs"      => "markdown+lhs",
+      ".texi"     => "texinfo",
+      ".texinfo"  => "texinfo",
+      ".db"       => "docbook",
+      ".odt"      => "odt",
+      ".docx"     => "docx",
+      ".epub"     => "epub",
+      ".org"      => "org",
+      ".asciidoc" => "asciidoc",
+      ".adoc"     => "asciidoc",
+      ".pdf"      => "latex",
+      ".fb2"      => "fb2",
+      ".opml"     => "opml",
+      ".icml"     => "icml",
+      ".tei.xml"  => "tei",
+      ".tei"      => "tei",
+    }[extension&.downcase] || !!extension&.downcase&.match(/\.\d$/)
+  end
+
+
+end
+

data/lib/pandoc_rb/error.rb

@@ -0,0 +1,6 @@
+
+module PandocRb
+  class Error < Exception
+  end
+end
+

data/lib/pandoc_rb/parse_failure.rb

@@ -0,0 +1,11 @@
+
+module PandocRb
+  class ParseFailure < PandocRb::Error
+    attr_accessor :json
+
+    def initialize(json)
+      self.json = json
+    end
+  end
+end
+

data/lib/pandoc_rb/parsec_error.rb

@@ -0,0 +1,13 @@
+
+module PandocRb
+  class ParsecError < PandocRb::Error
+    attr_accessor :input, :source_name, :line, :column, :messages
+
+    def initialize(json)
+      self.input, parse_error = json
+      source_pos, self.messages = parse_error
+      self.source_name, self.line, self.column = source_pos
+    end
+  end
+end
+

data/lib/pandoc_rb/readers.rb

@@ -0,0 +1,27 @@
+
+module PandocRb
+  Readers = [ "commonmark",
+              "docbook",
+              "docx",
+              "epub",
+              "haddock",
+              "html",
+              "json",
+              "latex",
+              "markdown",
+              "markdown_github",
+              "markdown_mmd",
+              "markdown_phpextra",
+              "markdown_strict",
+              "mediawiki",
+              "native",
+              "odt",
+              "opml",
+              "org",
+              "rst",
+              "t2t",
+              "textile",
+              "twiki"
+            ]
+end
+

data/lib/pandoc_rb/version.rb

@@ -0,0 +1,5 @@
+
+module PandocRb
+  VERSION = "0.2.2"
+end
+

data/lib/pandoc_rb/writers.rb

@@ -0,0 +1,46 @@
+
+module PandocRb
+  Writers = [ "asciidoc",
+              "beamer",
+              "commonmark",
+              "context",
+              "docbook",
+              "docbook5",
+              "docx",
+              "dokuwiki",
+              "dzslides",
+              "epub",
+              "epub3",
+              "fb2",
+              "haddock",
+              "html",
+              "html5",
+              "icml",
+              "json",
+              "latex",
+              "man",
+              "markdown",
+              "markdown_github",
+              "markdown_mmd",
+              "markdown_phpextra",
+              "markdown_strict",
+              "mediawiki",
+              "native",
+              "odt",
+              "opendocument",
+              "opml",
+              "org",
+              "plain",
+              "revealjs",
+              "rst",
+              "rtf",
+              "s5",
+              "slideous",
+              "slidy",
+              "tei",
+              "texinfo",
+              "textile",
+              "zimwiki"
+            ]
+end
+