module Data.Graph.Analysis.Reporting
(
Document(..),
DocumentGenerator(..),
Location(..),
DocElement(..),
DocInline(..),
GraphSize(..),
DocGraph(..),
VisParams(..),
VisProperties(..),
addLegend,
today,
tryCreateDirectory,
createGraph,
createSize,
unDotPath
) where
import Data.Graph.Inductive (Node)
import Data.GraphViz
import qualified Data.GraphViz.Attributes.Complete as AC
import Data.GraphViz.Commands.IO (writeDotFile)
import Data.GraphViz.Exception
import Control.Exception (SomeException (..), tryJust)
import Control.Monad (liftM, when)
import Data.Time (formatTime, getZonedTime, zonedTimeToLocalTime)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (makeRelative)
import System.FilePath.Posix ((<.>), (</>))
#if MIN_VERSION_time (1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
data Document = Doc {
rootDirectory :: FilePath
, fileFront :: String
, graphDirectory :: FilePath
, title :: DocInline
, author :: String
, date :: String
, legend :: [(Either DocGraph DocInline, DocInline)]
, content :: [DocElement]
}
deriving (Eq, Ord, Show, Read)
class DocumentGenerator dg where
createDocument :: dg -> Document -> IO (Maybe FilePath)
docExtension :: dg -> String
data Location = Web String
| File FilePath
deriving (Eq, Ord, Show, Read)
data DocElement = Section DocInline [DocElement]
| Paragraph [DocInline]
| Enumeration [DocElement]
| Itemized [DocElement]
| Definitions [(DocInline, DocInline)]
| GraphImage DocGraph
deriving (Eq, Ord, Show, Read)
data DocInline = Text String
| BlankSpace
| Grouping [DocInline]
| Bold DocInline
| Emphasis DocInline
| DocLink DocInline Location
| DocImage DocInline Location
deriving (Eq, Ord, Show, Read)
data DocGraph = DG {
imageFile :: FilePath
, description :: DocInline
, dotGraph :: DotGraph Node
}
deriving (Eq, Ord, Show, Read)
data VisParams = VParams {
rootDir :: FilePath
, graphDir :: FilePath
, defaultImage :: VisProperties
, largeImage :: Maybe VisProperties
, saveDot :: Bool
}
deriving (Eq, Ord, Show, Read)
data VisProperties = VProps { size :: GraphSize
, format :: GraphvizOutput
}
deriving (Eq, Ord, Show, Read)
data GraphSize = GivenSize AC.GraphSize
| DefaultSize
deriving (Eq, Ord, Show, Read)
addLegend :: FilePath -> FilePath -> VisProperties
-> Document -> IO Document
addLegend fp gfp vp d = do mLg <- legendToElement fp gfp vp $ legend d
let es = content d
es' = maybe es (flip (:) es) mLg
return $ d { legend = []
, content = es'
}
legendToElement :: FilePath -> FilePath -> VisProperties
-> [(Either DocGraph DocInline, DocInline)]
-> IO (Maybe DocElement)
legendToElement _ _ _ [] = return Nothing
legendToElement fp gfp vp ls = do defs <- mapM (uncurry (legToDef fp gfp vp)) ls
let df = Definitions defs
return $ Just $ Section (Text "Legend") [df]
legToDef :: FilePath -> FilePath -> VisProperties
-> Either DocGraph DocInline -> DocInline
-> IO (DocInline, DocInline)
legToDef fp gfp vp (Left dg) def = liftM ((,) def)
$ graphImage' fp gfp vp' dg
where
vp' = vp { size = DefaultSize }
legToDef _ _ _ (Right di) def = return (def,di)
today :: IO String
today = do zoneT <- getZonedTime
let localT = zonedTimeToLocalTime zoneT
return $ formatTime locale fmt localT
where
locale = defaultTimeLocale
fmt = "%A %e %B, %Y"
tryCreateDirectory :: FilePath -> IO Bool
tryCreateDirectory fp = do r <- tryJust (\(SomeException _) -> return ())
$ mkDir fp
return (isRight r)
where
mkDir = createDirectoryIfMissing True
isRight (Right _) = True
isRight _ = False
createGraph :: VisParams
-> DocGraph
-> IO DocElement
createGraph params dg
= do when (saveDot params) (writeDotFile dotFP $ dotGraph dg)
dl <- graphImage' rDir gDir vp dg'
dl' <- maybe return tryImg mvp dl
return $ Paragraph [dl']
where
rDir = rootDir params
gDir = graphDir params
vp = defaultImage params
mvp = largeImage params
dg' = dg { imageFile = unDotPath $ imageFile dg }
dgL = checkLargeFilename vp mvp dg'
tryImg vp' di = liftM (either (const di) (DocLink di))
$ graphImage rDir gDir vp' dgL
dotFP = rDir </> gDir </> imageFile dg <.> "dot"
checkLargeFilename :: VisProperties -> Maybe VisProperties
-> DocGraph -> DocGraph
checkLargeFilename _ Nothing dg = dg
checkLargeFilename vp1 (Just vp2) dg = checkFilename vp1 vp2 "large" dg
checkFilename :: VisProperties -> VisProperties -> String
-> DocGraph -> DocGraph
checkFilename vp1 vp2 s dg
| format vp1 == format vp2 = dg { imageFile = imageFile dg ++ '-' : s }
| otherwise = dg
graphImage :: FilePath -> FilePath -> VisProperties -> DocGraph
-> IO (Either DocInline Location)
graphImage rDir gDir vp dg = handle getErr
. liftM (Right . File . fixPath)
$ addExtension (runGraphviz dot)
(format vp)
filename
where
dot = setSize vp $ dotGraph dg
filename = rDir </> gDir </> imageFile dg
fixPath = makeRelative rDir
getErr :: GraphvizException -> IO (Either DocInline Location)
getErr = return . Left. Text . show
graphImage' :: FilePath -> FilePath -> VisProperties -> DocGraph
-> IO DocInline
graphImage' rDir gDir vp dg = liftM (either id f)
$ graphImage rDir gDir vp dg
where
f = DocImage (description dg)
setSize :: VisProperties -> DotGraph a -> DotGraph a
setSize vp g = case size vp of
DefaultSize -> g
(GivenSize s) -> g { graphStatements = setS s}
where
setS s = stmts { attrStmts = sizeA s : attrStmts stmts }
stmts = graphStatements g
sizeA s = GraphAttrs [AC.Size s]
createSize :: Double -> GraphSize
createSize w = GivenSize $ AC.GSize w (Just $ w*4/6) False
unDotPath :: FilePath -> FilePath
unDotPath = map replace
where
replace '.' = '-'
replace c = c