module Data.Graph.Analysis.Reporting.Pandoc
( PandocDocument,
pandocHtml,
pandocLaTeX,
pandocRtf,
pandocMarkdown
) where
import Data.Graph.Analysis.Reporting
import Text.Pandoc
import Data.List(intersperse)
import Data.Maybe(isNothing, fromJust)
import Control.Exception.Extensible(SomeException, try)
import System.Directory(removeDirectoryRecursive)
import System.FilePath((</>), (<.>))
pandocHtml :: PandocDocument
pandocHtml = pd { writer = writeHtmlString
, extension = "html"
, header = ""
, extGraphSize = Just DefaultSize
}
pandocLaTeX :: PandocDocument
pandocLaTeX = pd { writer = writeLaTeX
, extension = "tex"
, header = defaultLaTeXHeader
, graphSize = createSize 4.5
}
pandocRtf :: PandocDocument
pandocRtf = pd { writer = writeRTF
, extension = "rtf"
, header = defaultRTFHeader
}
pandocMarkdown :: PandocDocument
pandocMarkdown = pd { writer = writeMarkdown
, extension = "text"
, header = ""
}
data PandocDocument = PD {
writer :: WriterOptions -> Pandoc -> String,
extension :: FilePath,
header :: String,
graphSize :: GraphSize,
extGraphSize :: Maybe GraphSize
}
pd :: PandocDocument
pd = PD { writer = undefined,
extension = undefined,
header = undefined,
graphSize = defaultSize,
extGraphSize = Nothing
}
defaultWidth :: Double
defaultWidth = 10
defaultSize :: GraphSize
defaultSize = createSize defaultWidth
instance DocumentGenerator PandocDocument where
createDocument = createPandoc
docExtension = extension
writerOptions :: WriterOptions
writerOptions = defaultWriterOptions { writerStandalone = True
, writerTableOfContents = True
, writerNumberSections = True
}
data PandocProcess = PP { secLevel :: Int
, filedir :: FilePath
, graphdir :: FilePath
, grSize :: GraphSize
, eGSize :: Maybe GraphSize
}
defaultProcess :: PandocProcess
defaultProcess = PP { secLevel = 1
, graphdir = undefined
, filedir = undefined
, grSize = undefined
, eGSize = undefined
}
createPandoc :: PandocDocument -> Document -> IO (Maybe FilePath)
createPandoc p d = do created <- tryCreateDirectory dir
tryCreateDirectory $ dir </> gdir
if not created
then failDoc
else do elems <- multiElems pp (content d)
case elems of
Just es -> do let es' = htmlAuthDt : es
pnd = Pandoc meta es'
doc = convert 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 { filedir = dir
, graphdir = gdir
, grSize = graphSize p
, eGSize = extGraphSize p
}
opts = writerOptions { writerHeader = (header p) }
convert = writer p opts
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 t a = Meta (inlines t) [a]
htmlInfo :: String -> String -> Block
htmlInfo auth dt = RawHtml 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 (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 p (Definition x def) = do def' <- elements p def
let x' = inlines x
xdef = fmap (return . (,) x') def'
return (fmap (return . DefinitionList) xdef)
elements p (GraphImage dg) = do el <- createGraph (filedir p)
(graphdir p)
(grSize p)
(eGSize p) dg
case el of
Nothing -> return Nothing
Just img -> elements p img
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')