diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for transdoc + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2017 Marek Suchánek (marek.suchanek@fit.cvut.cz) + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,16 @@ +# FromHTML + +[![License](https://img.shields.io/github/license/MarekSuchanek/FromHTML.svg)](LICENSE) +[![Build Status](https://travis-ci.org/MarekSuchanek/FromHTML.svg?branch=master)](https://travis-ci.org/MarekSuchanek/FromHTML) +[![Hackage](https://img.shields.io/hackage/v/fromhtml.svg)](https://hackage.haskell.org/package/fromhtml) +[![Hackage-Deps](https://img.shields.io/hackage-deps/v/fromhtml.svg)](http://packdeps.haskellers.com/feed?needle=fromhtml) + +Simplified API for pure transformation of HTML to other formats with Pandoc in Haskell code. + +## Purpose + +Pandoc is awesome but using its Haskell API can be a little bit bothersome. This project aims to provide simpler API to transform documents without using monads or even some more advanced magic. + +## License + +This project is licensed under the MIT license - see the [LICENSE](LICENSE) file for more details. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,17 @@ +module Main where + +import Prelude hiding (writeFile) +import Data.ByteString (writeFile) +import System.Environment +import Text.FromHTML + +main :: IO () +main = do + args <- getArgs + let infile = head args + let outfile = args !! 1 + let format = (read $ args !! 2) :: ExportType + html <- readFile infile + case fromHTML format html of + Just bs -> writeFile outfile bs + Nothing -> putStrLn "Couldn't transform that document..." diff --git a/fromhtml.cabal b/fromhtml.cabal new file mode 100644 --- /dev/null +++ b/fromhtml.cabal @@ -0,0 +1,75 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 01ab3f45fcb9cf078d1bb2a7f16d75172b6c1717d1c87a4021123adbba039ce5 + +name: fromhtml +version: 0.1.0.0 +synopsis: Simple library for transformation of HTML to other formats +description: Please see the README on GitHub at +category: Text +homepage: https://github.com/MarekSuchanek/FromHTML#readme +bug-reports: https://github.com/MarekSuchanek/FromHTML/issues +author: Marek Suchánek +maintainer: marek.suchanek@fit.cvut.cz +copyright: 2018 Marek Suchánek +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/MarekSuchanek/FromHTML + +library + exposed-modules: + Text.FromHTML + other-modules: + Paths_fromhtml + hs-source-dirs: + src + default-extensions: OverloadedStrings + build-depends: + base >=4.7 && <5 + , bytestring + , pandoc >=2.2 + , process + , text + default-language: Haskell2010 + +executable fromhtml + main-is: Main.hs + other-modules: + Paths_fromhtml + hs-source-dirs: + app + build-depends: + base >=4.7 && <5 + , bytestring + , fromhtml + , pandoc >=2.2 + , process + , text + default-language: Haskell2010 + +test-suite transdoc-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_fromhtml + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , bytestring + , fromhtml + , pandoc >=2.2 + , process + , text + default-language: Haskell2010 diff --git a/src/Text/FromHTML.hs b/src/Text/FromHTML.hs new file mode 100644 --- /dev/null +++ b/src/Text/FromHTML.hs @@ -0,0 +1,124 @@ +{-| +Module : Text.FromHTML +Description : Simple library for transformation of HTML to other formats +Copyright : (c) Marek Suchánek, 2018 +License : MIT +Maintainer : marek.suchanek@fit.cvut.cz +Stability : experimental +Portability : POSIX + +Simplified API for transformation of HTML to other formats with Pandoc +and wkhtmltopdf in Haskell code. It requires @wkhtmltopdf@ installed +locally (see ). +-} +module Text.FromHTML + ( fromHTML + , ExportType(..) + ) where + +-- import Debug.Trace + +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL + +import qualified Text.Pandoc as Pandoc +import qualified Text.Pandoc.Writers as PandocWriters +import qualified Text.Pandoc.Error as PandocError +import qualified Text.Pandoc.PDF as PandocPDF + +import GHC.IO.Handle +import System.Process +import System.IO.Unsafe + +-- | Allowed export types +data ExportType = HTML + | LaTeX + | RTF + | RST + | Markdown + | AsciiDoc + | Docx + | ODT + | DokuWiki + | MediaWiki + | EPUB2 + | EPUB3 + | PDF + deriving (Show, Read, Enum, Bounded, Eq) + +-- | Type alias for Pure Pandoc writer +type Writer = (Pandoc.WriterOptions -> Pandoc.Pandoc -> Pandoc.PandocPure B.ByteString) + + +-- | Helper function to translate Either to Maybe +eitherToMaybe :: Show a => Either a b -> Maybe b +eitherToMaybe (Right x) = Just x +eitherToMaybe _ = Nothing + +-- Variant for debugging +-- eitherToMaybe :: Show a => Either a b -> Maybe b +-- eitherToMaybe (Right x) = Just x +-- eitherToMaybe (Left x) = traceShow x Nothing + +-- | Transform given HTML as String to selected format +fromHTML :: ExportType -> String -> Maybe B.ByteString +fromHTML HTML html = Just . E.encodeUtf8 . T.pack $ html -- HTML is already provided! +fromHTML PDF html = writerHTML2PDF html +fromHTML extp html = case html2pd html of + Just pd -> eitherToMaybe . Pandoc.runPure $ actwriter Pandoc.def pd + Nothing -> Nothing + where actwriter = writer extp + +html2pd :: String -> Maybe Pandoc.Pandoc +html2pd html = eitherToMaybe . Pandoc.runPure $ Pandoc.readHtml Pandoc.def (T.pack html) + +-- | Ugly PDF writer from HTML +-- writerHTML2PDF opts pd = fixError . unsafePerformIO . Pandoc.runIO $ PandocPDF.makePDF "wkhtmltopdf" ["--quiet"] PandocWriters.writeHtml5String opts pd +-- where +-- fixError (Left pderr) = Left pderr +-- fixError (Right (Left bserr)) = Left . PandocError.PandocSomeError . T.unpack . E.decodeUtf8 . BL.toStrict $ bserr +-- fixError (Right (Right x)) = Right (BL.toStrict x) + +-- | Wrapping HTML to PDF conversion which is unsafe +writerHTML2PDF :: String -> Maybe B.ByteString +writerHTML2PDF = Just . unsafePerformIO . html2pdf + +-- | Simple conversion of HTML to PDF using process wkhtmltopdf +html2pdf :: String -> IO B.ByteString +html2pdf html = do + (Just stdin, Just stdout, _, _) <- createProcess cprocess + hPutStr stdin html >> hClose stdin + B.hGetContents stdout + where + procWith p = p { std_out = CreatePipe + , std_in = CreatePipe + } + opts = ["--quiet", "--encoding", "utf-8", "-", "-"] + cprocess = procWith $ proc "wkhtmltopdf" opts + +-- | Select Writer based on given ExportType +writer :: ExportType -> Writer +writer = wrapWriter . pandocWriter + where + wrapWriter :: Pandoc.Writer Pandoc.PandocPure -> Writer + wrapWriter (Pandoc.TextWriter tw) = \opts pd -> E.encodeUtf8 <$> tw opts pd + wrapWriter (Pandoc.ByteStringWriter bsw) = \opts pd -> BL.toStrict <$> bsw opts pd + + +-- | Pick Pandoc writer for pure transformation +pandocWriter :: ExportType -> Pandoc.Writer Pandoc.PandocPure +pandocWriter HTML = Pandoc.TextWriter PandocWriters.writeHtml5String +pandocWriter LaTeX = Pandoc.TextWriter PandocWriters.writeLaTeX +pandocWriter RTF = Pandoc.TextWriter PandocWriters.writeRTF +pandocWriter RST = Pandoc.TextWriter PandocWriters.writeRST +pandocWriter Markdown = Pandoc.TextWriter PandocWriters.writeMarkdown +pandocWriter AsciiDoc = Pandoc.TextWriter PandocWriters.writeAsciiDoc +pandocWriter DokuWiki = Pandoc.TextWriter PandocWriters.writeDokuWiki +pandocWriter MediaWiki = Pandoc.TextWriter PandocWriters.writeMediaWiki +pandocWriter Docx = Pandoc.ByteStringWriter PandocWriters.writeDocx +pandocWriter ODT = Pandoc.ByteStringWriter PandocWriters.writeODT +pandocWriter EPUB2 = Pandoc.ByteStringWriter PandocWriters.writeEPUB2 +pandocWriter EPUB3 = Pandoc.ByteStringWriter PandocWriters.writeEPUB3 +pandocWriter PDF = pandocWriter HTML -- cannot be done as PandocPure diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"