-- |
-- Module          : Text.Pandoc.PlantUML.Filter.Types
-- Description     : Defines the common types used in this package
-- Copyright       : (c) Jonas Weber, 2015
-- License         : ISC
--
module Text.Pandoc.PlantUML.Filter.Types where

import           Data.Text(Text)
import qualified Data.Text as T

-- | The name of an image, without extension, usually a hash
type ImageName = String

-- | The source of a diagram
newtype DiagramSource = DiagramSource Text deriving (DiagramSource -> DiagramSource -> Bool
(DiagramSource -> DiagramSource -> Bool)
-> (DiagramSource -> DiagramSource -> Bool) -> Eq DiagramSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiagramSource -> DiagramSource -> Bool
$c/= :: DiagramSource -> DiagramSource -> Bool
== :: DiagramSource -> DiagramSource -> Bool
$c== :: DiagramSource -> DiagramSource -> Bool
Eq, Int -> DiagramSource -> ShowS
[DiagramSource] -> ShowS
DiagramSource -> String
(Int -> DiagramSource -> ShowS)
-> (DiagramSource -> String)
-> ([DiagramSource] -> ShowS)
-> Show DiagramSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiagramSource] -> ShowS
$cshowList :: [DiagramSource] -> ShowS
show :: DiagramSource -> String
$cshow :: DiagramSource -> String
showsPrec :: Int -> DiagramSource -> ShowS
$cshowsPrec :: Int -> DiagramSource -> ShowS
Show)

-- | An image format, e.g. "eps"
type ImageFormat = Text

-- | A filename of an image. It contains the basename (myawesomepicture) and
-- the extension (jpg). It can be shown, which is basically
-- "myawesomepicture.jpg"
data ImageFileName = ImageFileName ImageName ImageFormat deriving ImageFileName -> ImageFileName -> Bool
(ImageFileName -> ImageFileName -> Bool)
-> (ImageFileName -> ImageFileName -> Bool) -> Eq ImageFileName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageFileName -> ImageFileName -> Bool
$c/= :: ImageFileName -> ImageFileName -> Bool
== :: ImageFileName -> ImageFileName -> Bool
$c== :: ImageFileName -> ImageFileName -> Bool
Eq

-- | Show the image file name by joining basename and extension with
-- a dot, yielding picture.jpg
instance Show ImageFileName where
  show :: ImageFileName -> String
show (ImageFileName String
name ImageFormat
format) = String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ImageFormat -> String
T.unpack ImageFormat
format

-- | External impure actions are encapsulated in this monad.
class Monad m => ImageIO m where
  -- | Tells whether an image with the given file name
  -- is already present in the store (e.g., the filesystem).
  doesImageExist     :: ImageFileName -> m Bool
  -- | Calls out to an external diagram processor (PlantUML)
  -- to render the source to the given image file name.
  renderImage        :: ImageFileName -> DiagramSource -> m ()