{-# LANGUAGE OverloadedStrings #-}
-- | Module : Text.Pandoc.PlantUML.Filter.OutputBlock
-- Renders an image file name and some attributes into a Pandoc
-- block, like so:
--
-- @
-- Para
--   Image src=picture.jpg
--   "{#fig:id}"
-- @
module Text.Pandoc.PlantUML.Filter.OutputBlock(resultBlock) where

import Text.Pandoc.JSON
import Text.Pandoc.PlantUML.Filter.Types
import Data.Maybe
import qualified Data.Text as T

-- | The result block, as specified in the module header.
resultBlock :: ImageFileName -> Attr -> Block
resultBlock :: ImageFileName -> Attr -> Block
resultBlock ImageFileName
imageFileName Attr
attr = [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ ((ImageFileName -> Attr -> Inline) -> Inline)
-> [ImageFileName -> Attr -> Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map (\ImageFileName -> Attr -> Inline
p -> ImageFileName -> Attr -> Inline
p ImageFileName
imageFileName Attr
attr) [ImageFileName -> Attr -> Inline
imageTag, ImageFileName -> Attr -> Inline
idTag]

imageTag :: ImageFileName -> Attr -> Inline
imageTag :: ImageFileName -> Attr -> Inline
imageTag ImageFileName
imageFileName Attr
attr    = Attr -> [Inline] -> Target -> Inline
Image Attr
nullAttr (Attr -> [Inline]
altTagInline Attr
attr) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ImageFileName -> String
forall a. Show a => a -> String
show ImageFileName
imageFileName, Text
"fig:")

idTag :: ImageFileName -> Attr -> Inline
idTag :: ImageFileName -> Attr -> Inline
idTag ImageFileName
_ (Text
id, [Text]
_, [Target]
_)             = Text -> Inline
Str (Text
"{#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")

altTagInline :: Attr -> [Inline]
altTagInline :: Attr -> [Inline]
altTagInline (Text
_, [Text]
_, [Target]
keyValues)
  | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
altText             = [Text -> Inline
Str (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
altText)]
  | Bool
otherwise                  = []
  where altText :: Maybe Text
altText = Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"caption" [Target]
keyValues