module Data.Graph.Analysis.Reporting.Pandoc
( PandocDocument,
pandocHtml,
pandocLaTeX,
pandocRtf,
pandocMarkdown,
alsoSaveDot
) where
import Data.Graph.Analysis.Reporting
import Data.GraphViz.Commands (GraphvizOutput (Png, Svg))
import Text.Pandoc
import qualified Text.Pandoc.Shared as P
import Control.Arrow ((***))
import Control.Exception (SomeException, try)
import Data.List (intersperse)
import Data.Maybe (fromJust, isNothing)
import System.Directory (removeDirectoryRecursive)
import System.FilePath ((<.>), (</>))
pandocHtml :: PandocDocument
pandocHtml = pd { writer = writeHtmlString
, extension = "html"
, templateName = "html"
, extGraphProps = Just VProps { size = DefaultSize
, format = Svg
}
}
pandocLaTeX :: PandocDocument
pandocLaTeX = pd { writer = writeLaTeX
, extension = "tex"
, templateName = "latex"
, graphProps = defaultProps { size = createSize 4.5 }
}
pandocRtf :: PandocDocument
pandocRtf = pd { writer = writeRTF
, extension = "rtf"
, templateName = "rtf"
}
pandocMarkdown :: PandocDocument
pandocMarkdown = pd { writer = writeMarkdown
, extension = "text"
, templateName = "markdown"
}
data PandocDocument = PD {
writer :: WriterOptions -> Pandoc -> String
, extension :: FilePath
, templateName :: String
, graphProps :: VisProperties
, extGraphProps :: Maybe VisProperties
, keepDot :: Bool
}
pd :: PandocDocument
pd = PD { writer = undefined
, extension = undefined
, templateName = undefined
, graphProps = defaultProps
, extGraphProps = Nothing
, keepDot = False
}
alsoSaveDot :: PandocDocument -> PandocDocument
alsoSaveDot p = p { keepDot = True }
defaultWidth :: Double
defaultWidth = 10
defaultProps :: VisProperties
defaultProps = VProps { size = createSize defaultWidth
, format = Png
}
instance DocumentGenerator PandocDocument where
createDocument = createPandoc
docExtension = extension
writerOptions :: WriterOptions
writerOptions = def { writerStandalone = True
, writerTableOfContents = True
, writerNumberSections = True
}
data PandocProcess = PP { secLevel :: Int
, visParams :: VisParams
}
deriving (Eq, Ord, Show, Read)
defaultProcess :: PandocProcess
defaultProcess = PP { secLevel = 1
, visParams = undefined
}
createPandoc :: PandocDocument -> Document -> IO (Maybe FilePath)
createPandoc p d = do Right template <- getDefaultTemplate Nothing (templateName p)
created <- tryCreateDirectory dir
_ <- tryCreateDirectory $ dir </> gdir
if not created
then failDoc
else do d' <- addLegend dir gdir (graphProps p) d
elems <- multiElems pp $ content d'
case elems of
Just es -> do let es' = htmlAuthDt : es
pnd = Pandoc meta es'
doc = convert template pnd
wr <- tryWrite doc
case wr of
(Right _) -> success
(Left _) -> failDoc
Nothing -> failDoc
where
dir = rootDirectory d
gdir = graphDirectory d
auth = author d
dt = date d
meta = makeMeta (title d) auth dt
htmlAuthDt = htmlInfo auth dt
pp = defaultProcess { visParams = vp }
vp = VParams { rootDir = dir
, graphDir = gdir
, defaultImage = graphProps p
, largeImage = extGraphProps p
, saveDot = keepDot p
}
convert t = writer p (writerOptions {writerTemplate = t})
file = dir </> fileFront d <.> extension p
tryWrite :: String -> IO (Either SomeException ())
tryWrite = try . writeFile file
success = return (Just file)
failDoc = removeDirectoryRecursive dir >> return Nothing
makeMeta :: DocInline -> String -> String -> Meta
makeMeta tle a t = P.makeMeta (inlines tle) [[Str a]] [Str t]
htmlInfo :: String -> String -> Block
htmlInfo auth dt = RawBlock (Format "html") html
where
heading = "<h1>Document Information</h1>"
html = unlines [heading, htmlize auth, htmlize dt]
htmlize str = "<blockquote><p><em>" ++ str ++ "</em></p></blockquote>"
loc2target :: Location -> Target
loc2target (Web url) = (url,"")
loc2target (File file) = (file,"")
inlines :: DocInline -> [Inline]
inlines (Text str) = [Str str]
inlines BlankSpace = [Space]
inlines (Grouping grp) = concat . intersperse [Space] $ map inlines grp
inlines (Bold inl) = [Strong (inlines inl)]
inlines (Emphasis inl) = [Emph (inlines inl)]
inlines (DocLink inl loc) = [Link (inlines inl) (loc2target loc)]
inlines (DocImage inl loc) = [Image (inlines inl) (loc2target loc)]
elements :: PandocProcess -> DocElement -> IO (Maybe [Block])
elements p (Section lbl elems) = do let n = secLevel p
p' = p { secLevel = n + 1}
sec = Header n nullAttr (inlines lbl)
elems' <- multiElems p' elems
return (fmap (sec:) elems')
elements _ (Paragraph inls) = return $ Just [Para (concatMap inlines inls)]
elements p (Enumeration elems) = do elems' <- multiElems' p elems
let attrs = (1,DefaultStyle,DefaultDelim)
list = fmap (OrderedList attrs) elems'
return (fmap return list)
elements p (Itemized elems) = do elems' <- multiElems' p elems
return (fmap (return . BulletList) elems')
elements _ (Definitions defs) = return . Just . return . DefinitionList
$ map (inlines *** ((:[]) . (:[])
. Plain . inlines))
defs
elements p (GraphImage dg) = elements p =<< createGraph (visParams p) dg
multiElems :: PandocProcess -> [DocElement] -> IO (Maybe [Block])
multiElems p elems = do elems' <- mapM (elements p) elems
if any isNothing elems'
then return Nothing
else return (Just $ concatMap fromJust elems')
multiElems' :: PandocProcess -> [DocElement] -> IO (Maybe [[Block]])
multiElems' p elems = do elems' <- mapM (elements p) elems
if any isNothing elems'
then return Nothing
else return (Just $ map fromJust elems')