{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.BlogLiterately.Diagrams
-- Copyright   :  (c) Brent Yorgey 2012-2013
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  Brent Yorgey <byorgey@gmail.com>
--
-- Custom transformation passes for the @BlogLiterately@ blog-writing
-- tool (<http://hackage.haskell.org/package/BlogLiterately>),
-- allowing inclusion of inline code using the @diagrams@ framework
-- (<http://projects.haskell.org/diagrams>) which are compiled into
-- images.  See "Text.BlogLiterately.Run" for more information.
--
-- Note that this package provides an executable, @BlogLiteratelyD@,
-- which compiles embedded diagrams code as well as all the standard
-- transforms provided by BlogLiterately.
-----------------------------------------------------------------------------

module Text.BlogLiterately.Diagrams
    ( diagramsXF, diagramsInlineXF
    ) where

import           Safe                        (readMay)
import           System.Directory            (createDirectoryIfMissing)
import           System.FilePath
import           System.IO                   (hPutStrLn, stderr)

import qualified Codec.Picture               as J
import           Data.List                   (find, isPrefixOf)
import           Data.List.Split             (splitOn)
import           Data.Maybe                  (fromMaybe)
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import qualified Data.Text.IO                as T

import           Diagrams.Backend.Rasterific
import qualified Diagrams.Builder            as DB
import           Diagrams.Prelude            (SizeSpec, V2, centerXY, pad, zero,
                                              (&), (.~))
import           Diagrams.TwoD.Size          (mkSizeSpec2D)
import           Text.BlogLiterately
import           Text.Pandoc

-- | Transform a blog post by looking for code blocks with class
--   @dia@, and replacing them with images generated by evaluating the
--   identifier @dia@ and rendering the resulting diagram.  In
--   addition, blocks with class @dia-def@ are collected (and deleted
--   from the output) and provided as additional definitions that will
--   be in scope during evaluation of all @dia@ blocks.
--
--   Be sure to use this transform /before/ the standard
--   'Text.BlogLiterately.Transform.highlightXF' transform, /i.e./
--   with the 'Text.BlogLiterately.Run.blogLiteratelyCustom' function.
--   For example,
--
--   > main = blogLiteratelyCustom (diagramsXF : standardTransforms)
--
--   It also works well in conjunction with
--   'Text.BlogLiterately.Transform.centerImagesXF' (which, of course,
--   should be placed after @diagramsXF@ in the pipeline).  This
--   package provides an executable @BlogLiteratelyD@ which
--   includes @diagramsInlineXF@, @diagramsXF@, and @centerImagesXF@.
diagramsXF :: Transform
diagramsXF :: Transform
diagramsXF = (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform BlogLiterately -> Pandoc -> IO Pandoc
renderBlockDiagrams (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)

renderBlockDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc
renderBlockDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc
renderBlockDiagrams BlogLiterately
blOpts Pandoc
p = (Block -> IO Block) -> Pandoc -> IO Pandoc
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
bottomUpM (Maybe FilePath
-> Maybe (SizeSpec V2 Double) -> [Text] -> Block -> IO Block
renderBlockDiagram Maybe FilePath
imgDir Maybe (SizeSpec V2 Double)
imgSize [Text]
defs) Pandoc
p
  where
    defs :: [Text]
defs = (Block -> [Text]) -> Pandoc -> [Text]
forall a b c. (Data a, Monoid b, Data c) => (a -> b) -> c -> b
queryWith Block -> [Text]
extractDiaDef Pandoc
p

    imgDir  :: Maybe FilePath
    imgDir :: Maybe FilePath
imgDir = FilePath -> Maybe FilePath
field FilePath
"imgdir"
    imgSize :: Maybe (SizeSpec V2 Double)
    imgSize :: Maybe (SizeSpec V2 Double)
imgSize = FilePath -> Maybe FilePath
field FilePath
"imgsize" Maybe FilePath
-> (FilePath -> Maybe (SizeSpec V2 Double))
-> Maybe (SizeSpec V2 Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
s ->
      case FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"x" FilePath
s of
        [FilePath
w,FilePath
h] -> SizeSpec V2 Double -> Maybe (SizeSpec V2 Double)
forall a. a -> Maybe a
Just (SizeSpec V2 Double -> Maybe (SizeSpec V2 Double))
-> SizeSpec V2 Double -> Maybe (SizeSpec V2 Double)
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Maybe Double -> SizeSpec V2 Double
forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D (FilePath -> Maybe Double
forall a. Read a => FilePath -> Maybe a
readMay FilePath
w) (FilePath -> Maybe Double
forall a. Read a => FilePath -> Maybe a
readMay FilePath
h)
        [FilePath]
_     -> Maybe (SizeSpec V2 Double)
forall a. Maybe a
Nothing

    field :: FilePath -> Maybe FilePath
field FilePath
f = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath
fFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
":") FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (BlogLiterately -> [FilePath]
_xtra BlogLiterately
blOpts)

-- | Transform a blog post by looking for /inline/ code snippets with
--   class @dia@, and replacing them with images generated by
--   evaluating the contents of each code snippet as a Haskell
--   expression representing a diagram.  Any code blocks with class
--   @dia-def@ will be in scope for the evaluation of these
--   expressions (such code blocks are unaffected).
--
--   Because @diagramsXF@ and @diagramsInlineXF@ both use blocks with
--   class @dia-def@, but @diagramsInlineXF@ leaves them alone whereas
--   @diagramsXF@ deletes them, @diagramsInlineXF@ must be placed
--   before @diagramsXF@ in the pipeline.
diagramsInlineXF :: Transform
diagramsInlineXF :: Transform
diagramsInlineXF = (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform BlogLiterately -> Pandoc -> IO Pandoc
renderInlineDiagrams (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)

renderInlineDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc
renderInlineDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc
renderInlineDiagrams BlogLiterately
_ Pandoc
p = (Inline -> IO Inline) -> Pandoc -> IO Pandoc
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
bottomUpM ([Text] -> Inline -> IO Inline
renderInlineDiagram [Text]
defs) Pandoc
p
  where
    defs :: [Text]
defs = (Block -> [Text]) -> Pandoc -> [Text]
forall a b c. (Data a, Monoid b, Data c) => (a -> b) -> c -> b
queryWith Block -> [Text]
extractDiaDef Pandoc
p

extractDiaDef :: Block -> [Text]
extractDiaDef :: Block -> [Text]
extractDiaDef (CodeBlock (Text
_, [Text]
as, [(Text, Text)]
_) Text
s)
    = [Text
src | Text
"dia-def" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (([Text] -> [Text])
-> (Text -> [Text] -> [Text]) -> Maybe Text -> [Text] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text] -> [Text]
forall a. a -> a
id (:) Maybe Text
tag) [Text]
as]
  where
    (Maybe Text
tag, Text
src) = Text -> (Maybe Text, Text)
unTag Text
s

extractDiaDef Block
_ = []

-- | Given some code with declarations, some attributes, and an
--   expression to render, render it and return the filename of the
--   generated image (or an error message).
renderDiagram :: Bool               -- ^ Apply padding automatically?
              -> [Text]             -- ^ Declarations
              -> Text               -- ^ Expression to render
              -> SizeSpec V2 Double -- ^ Requested size
              -> Maybe FilePath     -- ^ Directory to save in ("diagrams" if unspecified)
              -> IO (Either Text FilePath)
renderDiagram :: Bool
-> [Text]
-> Text
-> SizeSpec V2 Double
-> Maybe FilePath
-> IO (Either Text FilePath)
renderDiagram Bool
shouldPad [Text]
decls Text
expr SizeSpec V2 Double
sz Maybe FilePath
mdir = do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
diaDir

    let bopts :: BuildOpts Rasterific V2 Double
bopts = Rasterific
-> V2 Double
-> Options Rasterific V2 Double
-> BuildOpts Rasterific V2 Double
forall b (v :: * -> *) n.
b -> v n -> Options b v n -> BuildOpts b v n
DB.mkBuildOpts Rasterific
Rasterific V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero (SizeSpec V2 Double -> Options Rasterific V2 Double
forall n. SizeSpec V2 n -> Options Rasterific V2 n
RasterificOptions SizeSpec V2 Double
sz)
                  BuildOpts Rasterific V2 Double
-> (BuildOpts Rasterific V2 Double
    -> BuildOpts Rasterific V2 Double)
-> BuildOpts Rasterific V2 Double
forall a b. a -> (a -> b) -> b
& ([FilePath] -> Identity [FilePath])
-> BuildOpts Rasterific V2 Double
-> Identity (BuildOpts Rasterific V2 Double)
forall b (v :: * -> *) n. Lens' (BuildOpts b v n) [FilePath]
DB.snippets (([FilePath] -> Identity [FilePath])
 -> BuildOpts Rasterific V2 Double
 -> Identity (BuildOpts Rasterific V2 Double))
-> [FilePath]
-> BuildOpts Rasterific V2 Double
-> BuildOpts Rasterific V2 Double
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack [Text]
decls
                  BuildOpts Rasterific V2 Double
-> (BuildOpts Rasterific V2 Double
    -> BuildOpts Rasterific V2 Double)
-> BuildOpts Rasterific V2 Double
forall a b. a -> (a -> b) -> b
& ([FilePath] -> Identity [FilePath])
-> BuildOpts Rasterific V2 Double
-> Identity (BuildOpts Rasterific V2 Double)
forall b (v :: * -> *) n. Lens' (BuildOpts b v n) [FilePath]
DB.imports  (([FilePath] -> Identity [FilePath])
 -> BuildOpts Rasterific V2 Double
 -> Identity (BuildOpts Rasterific V2 Double))
-> [FilePath]
-> BuildOpts Rasterific V2 Double
-> BuildOpts Rasterific V2 Double
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath
"Diagrams.Backend.Rasterific"]
                  BuildOpts Rasterific V2 Double
-> (BuildOpts Rasterific V2 Double
    -> BuildOpts Rasterific V2 Double)
-> BuildOpts Rasterific V2 Double
forall a b. a -> (a -> b) -> b
& (FilePath -> Identity FilePath)
-> BuildOpts Rasterific V2 Double
-> Identity (BuildOpts Rasterific V2 Double)
forall b (v :: * -> *) n. Lens' (BuildOpts b v n) FilePath
DB.diaExpr  ((FilePath -> Identity FilePath)
 -> BuildOpts Rasterific V2 Double
 -> Identity (BuildOpts Rasterific V2 Double))
-> FilePath
-> BuildOpts Rasterific V2 Double
-> BuildOpts Rasterific V2 Double
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> FilePath
T.unpack Text
expr
                  BuildOpts Rasterific V2 Double
-> (BuildOpts Rasterific V2 Double
    -> BuildOpts Rasterific V2 Double)
-> BuildOpts Rasterific V2 Double
forall a b. a -> (a -> b) -> b
& ((QDiagram Rasterific V2 Double Any
  -> QDiagram Rasterific V2 Double Any)
 -> Identity
      (QDiagram Rasterific V2 Double Any
       -> QDiagram Rasterific V2 Double Any))
-> BuildOpts Rasterific V2 Double
-> Identity (BuildOpts Rasterific V2 Double)
forall b (v :: * -> *) n.
Lens' (BuildOpts b v n) (QDiagram b v n Any -> QDiagram b v n Any)
DB.postProcess (((QDiagram Rasterific V2 Double Any
   -> QDiagram Rasterific V2 Double Any)
  -> Identity
       (QDiagram Rasterific V2 Double Any
        -> QDiagram Rasterific V2 Double Any))
 -> BuildOpts Rasterific V2 Double
 -> Identity (BuildOpts Rasterific V2 Double))
-> (QDiagram Rasterific V2 Double Any
    -> QDiagram Rasterific V2 Double Any)
-> BuildOpts Rasterific V2 Double
-> BuildOpts Rasterific V2 Double
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if Bool
shouldPad then Double
-> QDiagram Rasterific V2 Double Any
-> QDiagram Rasterific V2 Double Any
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
n -> QDiagram b v n m -> QDiagram b v n m
pad Double
1.1 (QDiagram Rasterific V2 Double Any
 -> QDiagram Rasterific V2 Double Any)
-> (QDiagram Rasterific V2 Double Any
    -> QDiagram Rasterific V2 Double Any)
-> QDiagram Rasterific V2 Double Any
-> QDiagram Rasterific V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram Rasterific V2 Double Any
-> QDiagram Rasterific V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY else QDiagram Rasterific V2 Double Any
-> QDiagram Rasterific V2 Double Any
forall a. a -> a
id)
                  BuildOpts Rasterific V2 Double
-> (BuildOpts Rasterific V2 Double
    -> BuildOpts Rasterific V2 Double)
-> BuildOpts Rasterific V2 Double
forall a b. a -> (a -> b) -> b
& ((Int
  -> IO
       (Maybe
          (Options Rasterific V2 Double -> Options Rasterific V2 Double)))
 -> Identity
      (Int
       -> IO
            (Maybe
               (Options Rasterific V2 Double -> Options Rasterific V2 Double))))
-> BuildOpts Rasterific V2 Double
-> Identity (BuildOpts Rasterific V2 Double)
forall b (v :: * -> *) n.
Lens'
  (BuildOpts b v n)
  (Int -> IO (Maybe (Options b v n -> Options b v n)))
DB.decideRegen (((Int
   -> IO
        (Maybe
           (Options Rasterific V2 Double -> Options Rasterific V2 Double)))
  -> Identity
       (Int
        -> IO
             (Maybe
                (Options Rasterific V2 Double -> Options Rasterific V2 Double))))
 -> BuildOpts Rasterific V2 Double
 -> Identity (BuildOpts Rasterific V2 Double))
-> (Int
    -> IO
         (Maybe
            (Options Rasterific V2 Double -> Options Rasterific V2 Double)))
-> BuildOpts Rasterific V2 Double
-> BuildOpts Rasterific V2 Double
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                      ((FilePath
 -> Options Rasterific V2 Double -> Options Rasterific V2 Double)
-> FilePath
-> Int
-> IO
     (Maybe
        (Options Rasterific V2 Double -> Options Rasterific V2 Double))
forall a.
(FilePath -> a -> a) -> FilePath -> Int -> IO (Maybe (a -> a))
DB.hashedRegenerate
                        (\FilePath
_ Options Rasterific V2 Double
opts -> Options Rasterific V2 Double
opts)
                        FilePath
diaDir
                      )

    BuildResult Rasterific V2 Double
res <- BuildOpts Rasterific V2 Double
-> IO (BuildResult Rasterific V2 Double)
forall b (v :: * -> *) n.
(Typeable b, Data (v n), Data n, Metric v, HasLinearMap v,
 Typeable v, OrderedField n, Backend b v n,
 Hashable (Options b v n)) =>
BuildOpts b v n -> IO (BuildResult b v n)
DB.buildDiagram BuildOpts Rasterific V2 Double
bopts

    case BuildResult Rasterific V2 Double
res of
      DB.ParseErr FilePath
err    -> do
        let errStr :: Text
errStr = Text -> Text -> Text
T.append Text
"\nParse error:\n" (FilePath -> Text
T.pack FilePath
err)
        Text -> IO ()
putErrLn Text
errStr
        Either Text FilePath -> IO (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text FilePath
forall a b. a -> Either a b
Left Text
errStr)
      DB.InterpErr InterpreterError
ierr  -> do
        let errStr :: Text
errStr = Text -> Text -> Text
T.append Text
"\nInterpreter error:\n" (FilePath -> Text
T.pack (InterpreterError -> FilePath
DB.ppInterpError InterpreterError
ierr))
        Text -> IO ()
putErrLn Text
errStr
        Either Text FilePath -> IO (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text FilePath
forall a b. a -> Either a b
Left Text
errStr)
      DB.Skipped Int
hash    -> Either Text FilePath -> IO (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right (FilePath -> Either Text FilePath)
-> FilePath -> Either Text FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
mkFile (Int -> FilePath
DB.hashToHexStr Int
hash))
      DB.OK Int
hash Result Rasterific V2 Double
img     -> do
        let imgFile :: FilePath
imgFile = FilePath -> FilePath
mkFile (Int -> FilePath
DB.hashToHexStr Int
hash)
        FilePath -> DynamicImage -> IO ()
J.savePngImage FilePath
imgFile (Image PixelRGBA8 -> DynamicImage
J.ImageRGBA8 Image PixelRGBA8
Result Rasterific V2 Double
img)
        Either Text FilePath -> IO (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
imgFile)

  where
    diaDir :: FilePath
diaDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"diagrams" Maybe FilePath
mdir
    mkFile :: FilePath -> FilePath
mkFile FilePath
base = FilePath
diaDir FilePath -> FilePath -> FilePath
</> FilePath
base FilePath -> FilePath -> FilePath
<.> FilePath
"png"

renderBlockDiagram :: Maybe FilePath -> Maybe (SizeSpec V2 Double) -> [Text] -> Block -> IO Block
renderBlockDiagram :: Maybe FilePath
-> Maybe (SizeSpec V2 Double) -> [Text] -> Block -> IO Block
renderBlockDiagram Maybe FilePath
ximgDir Maybe (SizeSpec V2 Double)
ximgSize [Text]
defs c :: Block
c@(CodeBlock attr :: (Text, [Text], [(Text, Text)])
attr@(Text
_, [Text]
cls, [(Text, Text)]
fields) Text
s)
    | Text
"dia-def" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classTags = Block -> IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
Null
    | Text
"dia"     Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classTags = do
        Either Text FilePath
res <- Bool
-> [Text]
-> Text
-> SizeSpec V2 Double
-> Maybe FilePath
-> IO (Either Text FilePath)
renderDiagram Bool
True (Text
src Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
defs) Text
"dia" ([(Text, Text)] -> SizeSpec V2 Double
attrToSize [(Text, Text)]
fields) Maybe FilePath
forall a. Maybe a
Nothing
        case Either Text FilePath
res of
          Left  Text
err      -> Block -> IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text, [Text], [(Text, Text)])
attr (Text -> Text -> Text
T.append Text
s Text
err))
          Right FilePath
fileName -> do
            case (Maybe FilePath
ximgDir, Maybe (SizeSpec V2 Double)
ximgSize) of
              (Just FilePath
_, Just SizeSpec V2 Double
sz) -> do
                Either Text FilePath
_ <- Bool
-> [Text]
-> Text
-> SizeSpec V2 Double
-> Maybe FilePath
-> IO (Either Text FilePath)
renderDiagram Bool
True (Text
src Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
defs) Text
"dia" SizeSpec V2 Double
sz Maybe FilePath
ximgDir
                () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              (Maybe FilePath, Maybe (SizeSpec V2 Double))
_                 -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Block -> IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> IO Block) -> Block -> IO Block
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [(Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
nullAttr [] (FilePath -> Text
T.pack FilePath
fileName, Text
"")]

    | Bool
otherwise = Block -> IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
c

  where
    (Maybe Text
tag, Text
src)        = Text -> (Maybe Text, Text)
unTag Text
s
    classTags :: [Text]
classTags         = (([Text] -> [Text])
-> (Text -> [Text] -> [Text]) -> Maybe Text -> [Text] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text] -> [Text]
forall a. a -> a
id (:) Maybe Text
tag) [Text]
cls


renderBlockDiagram Maybe FilePath
_ Maybe (SizeSpec V2 Double)
_ [Text]
_ Block
b = Block -> IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
b

renderInlineDiagram :: [Text] -> Inline -> IO Inline
renderInlineDiagram :: [Text] -> Inline -> IO Inline
renderInlineDiagram [Text]
defs c :: Inline
c@(Code attr :: (Text, [Text], [(Text, Text)])
attr@(Text
_, [Text]
cls, [(Text, Text)]
fields) Text
expr)
    | Text
"dia" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls = do
        Either Text FilePath
res <- Bool
-> [Text]
-> Text
-> SizeSpec V2 Double
-> Maybe FilePath
-> IO (Either Text FilePath)
renderDiagram Bool
False [Text]
defs Text
expr ([(Text, Text)] -> SizeSpec V2 Double
attrToSize [(Text, Text)]
fields) Maybe FilePath
forall a. Maybe a
Nothing
        case Either Text FilePath
res of
          Left Text
err       -> Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
attr (Text -> Text -> Text
T.append Text
expr Text
err))
          Right FilePath
fileName -> Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> IO Inline) -> Inline -> IO Inline
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
nullAttr [] (FilePath -> Text
T.pack FilePath
fileName, Text
"")
    | Bool
otherwise = Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
c

renderInlineDiagram [Text]
_ Inline
i = Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
i

attrToSize :: [(Text, Text)] -> SizeSpec V2 Double
attrToSize :: [(Text, Text)] -> SizeSpec V2 Double
attrToSize [(Text, Text)]
fields
  = Maybe Double -> Maybe Double -> SizeSpec V2 Double
forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D
    (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
fields Maybe Text -> (Text -> Maybe Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Maybe Double
forall a. Read a => FilePath -> Maybe a
readMay (FilePath -> Maybe Double)
-> (Text -> FilePath) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack))
    (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" [(Text, Text)]
fields Maybe Text -> (Text -> Maybe Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Maybe Double
forall a. Read a => FilePath -> Maybe a
readMay (FilePath -> Maybe Double)
-> (Text -> FilePath) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack))


putErrLn :: Text -> IO ()
putErrLn :: Text -> IO ()
putErrLn = Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr