call-plantuml 0.0.1 → 0.0.1.1
raw patch · 4 files changed
+70/−42 lines, 4 filesdep +asyncPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: async
API changes (from Hackage documentation)
+ Language.PlantUML.Call: drawPlantUmlDiagram :: DiagramType -> ByteString -> IO ByteString
Files
- ChangeLog.md +11/−1
- README.md +1/−1
- call-plantuml.cabal +8/−6
- src/Language/PlantUML/Call.hs +50/−34
ChangeLog.md view
@@ -1,5 +1,15 @@ # Change Log -## Version 0.0.1+## Unreleased changes++## Released changes++### Version 0.0.1.1++- assure proper shutdown of Java (PlantUML)+- make call truly headless+- use async library++### Version 0.0.1 - provide basic ability to call PlantUML
README.md view
@@ -1,4 +1,4 @@-# `call-plantuml` []+# `call-plantuml` [](https://github.com/marcellussiegburg/call-plantuml/workflows/Haskell%20CI/badge.svg) This is a simple library to call [PlantUML](https://plantuml.com) given a diagram specification. PlantUML is included (as JAR file) within this library.
call-plantuml.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: call-plantuml-version: 0.0.1+version: 0.0.1.1 synopsis: A simple library to call PlantUML given a diagram specification description: Please see the README on GitHub at <https://github.com/marcellussiegburg/call-plantuml#readme> category: Graphics, Language@@ -39,14 +39,15 @@ src ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Widentities -Wredundant-constraints build-depends:- base >=4.12 && <5+ async >=2.2.1 && <2.3+ , base >=4.12 && <5 , bytestring >=0.10.4 && <0.12 , filepath ==1.4.* , process ==1.6.*+ default-language: Haskell2010 if os(windows) cpp-options: -DWINDOWS else- default-language: Haskell2010 test-suite call-plantuml-test type: exitcode-stdio-1.0@@ -58,13 +59,14 @@ test ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Widentities -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends:- base >=4.12 && <5+ async >=2.2.1 && <2.3+ , base >=4.12 && <5 , bytestring >=0.10.4 && <0.12 , call-plantuml , filepath ==1.4.* , hspec , process ==1.6.*+ default-language: Haskell2010 if os(windows) cpp-options: -DWINDOWS else- default-language: Haskell2010
src/Language/PlantUML/Call.hs view
@@ -12,6 +12,7 @@ -} module Language.PlantUML.Call ( DiagramType (..),+ drawPlantUmlDiagram, drawPlantUMLDiagram, ) where @@ -25,9 +26,8 @@ tail, ) -import Control.Concurrent (- forkIO, killThread, newEmptyMVar, putMVar, takeMVar,- )+import Control.Concurrent.Async (concurrently)+import Control.Exception (bracket) import Control.Monad (unless, when) import Data.ByteString (ByteString, hGetContents, hPutStr) import Data.ByteString.Char8 (unpack)@@ -35,6 +35,7 @@ import System.FilePath ((</>), (<.>)) import System.IO (+ Handle, hClose, hFlush, #ifndef mingw32_HOST_OS@@ -43,8 +44,13 @@ #endif ) import System.Process (- CreateProcess (..), StdStream (..),- createProcess, proc, waitForProcess,+ CreateProcess (..),+ ProcessHandle,+ StdStream (..),+ cleanupProcess,+ createProcess,+ proc,+ waitForProcess, ) {-|@@ -73,54 +79,64 @@ VDX -> "vdx" {-|+Calls PlantUml (Java) using the given 'DiagramType'.+Assures proper closing of the processes.+-}+callPlantUml+ :: DiagramType+ -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a)+ -> IO a+callPlantUml what = flip bracket cleanupProcess $ do+ dataDir <- getDataDir+ let callPlantUML = proc "java" [+ "-Djava.awt.headless=true",+ "-jar", dataDir </> "plantuml" <.> "jar",+ "-p", "-t" ++ typeShortName what, "-nometadata", "-noerror"+ ]+ createProcess callPlantUML {+ std_out = CreatePipe,+ std_in = CreatePipe,+ std_err = CreatePipe+ }++{-|+A synonym for 'drawPlantUmlDiagram'.+-}+drawPlantUMLDiagram :: DiagramType -> ByteString -> IO ByteString+drawPlantUMLDiagram = drawPlantUmlDiagram++{-| This function may be used to draw a PlantUML diagram given a valid specification and a return type. It calls PlantUML via Java. -}-drawPlantUMLDiagram+drawPlantUmlDiagram :: DiagramType -- ^ The return type of diagram to return -> ByteString -- ^ The PlantUML diagram specification which should be loaded -> IO ByteString-drawPlantUMLDiagram what content = do- dataDir <- getDataDir- let callPlantUML = proc "java" [- "-jar", dataDir </> "plantuml" <.> "jar",- "-p", "-t" ++ typeShortName what, "-nometadata", "-noerror"- ]- (Just hin, Just hout, Just herr, ph) <-- createProcess callPlantUML {- std_out = CreatePipe,- std_in = CreatePipe,- std_err = CreatePipe- }- pout <- listenForOutput hout- perr <- listenForOutput herr+drawPlantUmlDiagram what content = callPlantUml what $ \p -> do+ (Just hin, Just hout, Just herr, ph) <- return p #ifndef mingw32_HOST_OS hSetBuffering hin NoBuffering #endif- hPutStr hin content- hFlush hin- hClose hin- out <- getOutput pout- err <- getOutput perr+ let evaluatePlantUml = do+ hPutStr hin content+ hFlush hin+ hClose hin+ waitForProcess ph+ (out, err) <- fst <$> concurrently+ (concurrently (hGetContents hout) (hGetContents herr))+ evaluatePlantUml printContentOnError ph out unless (BS.null err) $ fail $ unpack err return out where printContentOnError ph out = do code <- waitForProcess ph- when (code == ExitFailure 1 || isError out)+ when (code /= ExitSuccess || isError out) $ BS.putStrLn $ "Error on calling PlantUML with:\n" <> content- listenForOutput h = do- mvar <- newEmptyMVar- pid <- forkIO $ hGetContents h >>= putMVar mvar- return (pid, mvar)- getOutput (pid, mvar) = do- output <- takeMVar mvar- killThread pid- return output isError :: ByteString -> Bool isError xs =