module Data.Graph.Analysis.Reporting.Pandoc
( PandocDocument,
pandocHtml,
pandocLaTeX,
pandocRtf,
pandocMarkdown
) where
import Data.Graph.Analysis.Reporting
import Data.List
import Data.Maybe
import Text.Pandoc
import Control.Monad
import Control.Exception
import System.Directory
import System.FilePath
pandocHtml :: PandocDocument
pandocHtml = PD { writer = writeHtmlString
, extension = "html"
, header = ""
}
pandocLaTeX :: PandocDocument
pandocLaTeX = PD { writer = writeLaTeX
, extension = "tex"
, header = defaultLaTeXHeader
}
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
}
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
}
defaultProcess :: PandocProcess
defaultProcess = PP { secLevel = 1
, filedir = ""
}
createPandoc :: PandocDocument -> Document -> IO (Maybe FilePath)
createPandoc p d = do created <- tryCreateDirectory dir
if (not created)
then failDoc
else do elems <- multiElems pp (content d)
case elems of
Just es -> do let es' = htmlAuthDt : es
pd = Pandoc meta es'
doc = convert pd
wr <- tryWrite doc
case wr of
(Right _) -> success
(Left _) -> failDoc
Nothing -> failDoc
where
dir = rootDirectory d
auth = author d
dt = date d
meta = makeMeta (title d) auth dt
htmlAuthDt = htmlInfo auth dt
pp = defaultProcess { filedir = dir }
opts = writerOptions { writerHeader = (header p) }
convert = (writer p) opts
file = dir </> (fileFront d) <.> (extension p)
tryWrite = try . writeFile file
success = return (Just file)
failDoc = removeDirectoryRecursive dir >> return Nothing
makeMeta :: DocInline -> String -> String -> Meta
makeMeta t a d = Meta (inlines t) [a] d
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 (URL url) = (url,"")
loc2target (File file) = (file,"")
inlines :: DocInline -> [Inline]
inlines (Text str) = intersperse Space $ map Str (words 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)]
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 _ (DocImage inl loc) = do let img = Image (inlines inl)
(loc2target loc)
return $ Just [Plain [img]]
elements p (GraphImage dg) = do el <- createGraph (filedir 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')