{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module    : Text.Pandoc.PlantUML.Filter
--
-- pandoc-plantuml-diagrams is a filter for Pandoc that automatically
-- renders UML diagrams with PlantUML.
module Text.Pandoc.PlantUML.Filter (processBlocks) where

import Text.Pandoc.JSON
import Control.Monad
import qualified Data.Text as T

import Text.Pandoc.PlantUML.Filter.Types
import Text.Pandoc.PlantUML.Filter.FileNameGenerator
import Text.Pandoc.PlantUML.Filter.Formats
import Text.Pandoc.PlantUML.Filter.OutputBlock

-- | Processes a block in the context of the give format.
-- The call syntax is compatible with the json filter provided
-- by Pandoc.
--
processBlocks :: ImageIO m => Maybe Format -> Block -> m Block
processBlocks :: Maybe Format -> Block -> m Block
processBlocks (Just Format
format) block :: Block
block@(CodeBlock attr :: Attr
attr@(Text
_, [Text]
classes, [(Text, Text)]
_) Text
contents)
  | Text
"uml" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes       = do
    ImageFileName -> DiagramSource -> m ()
forall (m :: * -> *).
ImageIO m =>
ImageFileName -> DiagramSource -> m ()
ensureRendered ImageFileName
imageFileName (Text -> DiagramSource
DiagramSource Text
contents)
    Block -> m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> m Block) -> Block -> m Block
forall a b. (a -> b) -> a -> b
$ ImageFileName -> Attr -> Block
resultBlock ImageFileName
imageFileName Attr
attr
  | Bool
otherwise                  = Block -> m Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
block
  where imageFileName :: ImageFileName
imageFileName = ImageName -> Text -> ImageFileName
ImageFileName (DiagramSource -> ImageName
fileNameForSource (Text -> DiagramSource
DiagramSource Text
contents)) (Format -> Text
imageFormatTypeFor Format
format)
processBlocks Maybe Format
_ Block
x              = Block -> m Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x

ensureRendered :: ImageIO m => ImageFileName -> DiagramSource -> m ()
ensureRendered :: ImageFileName -> DiagramSource -> m ()
ensureRendered ImageFileName
imageFileName DiagramSource
source = ImageFileName -> m () -> m ()
forall (m :: * -> *). ImageIO m => ImageFileName -> m () -> m ()
inCaseNotExists ImageFileName
imageFileName (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ImageFileName -> DiagramSource -> m ()
forall (m :: * -> *).
ImageIO m =>
ImageFileName -> DiagramSource -> m ()
renderImage ImageFileName
imageFileName DiagramSource
source

inCaseNotExists :: ImageIO m => ImageFileName -> m () -> m ()
inCaseNotExists :: ImageFileName -> m () -> m ()
inCaseNotExists ImageFileName
fileName m ()
action = ImageFileName -> m Bool
forall (m :: * -> *). ImageIO m => ImageFileName -> m Bool
doesImageExist ImageFileName
fileName m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()) -> m () -> Bool -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless m ()
action