{-# LANGUAGE OverloadedStrings #-}
module Profiteur.Main
( main
) where
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy.IO as TL
import Data.Version (showVersion)
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)
import System.FilePath (takeBaseName)
import qualified System.IO as IO
import Paths_profiteur (version)
import Profiteur.Core
import Profiteur.Parser
import Profiteur.DataFile
writeReport :: IO.Handle -> String -> NodeMap -> IO ()
writeReport :: Handle -> [Char] -> NodeMap -> IO ()
writeReport Handle
h [Char]
profFile NodeMap
prof = do
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$
ByteString
"<!DOCTYPE html>\n\
\<html>\n\
\ <head>\n\
\ <meta charset=\"UTF-8\">\n\
\ <title>" forall a. Monoid a => a -> a -> a
`mappend` Text -> ByteString
T.encodeUtf8 Text
title forall a. Monoid a => a -> a -> a
`mappend` ByteString
"</title>"
Handle -> ByteString -> IO ()
BC8.hPutStr Handle
h ByteString
"<script type=\"text/javascript\">var $prof = "
Handle -> ByteString -> IO ()
BL.hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Aeson.encode NodeMap
prof
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h ByteString
";</script>"
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h ByteString
"<style>"
Handle -> DataType -> IO ()
includeFile Handle
h DataType
"data/css/main.css"
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h ByteString
"</style>"
DataType -> IO ()
includeJs DataType
JQueryFile
DataType -> IO ()
includeJs DataType
"data/js/unicode.js"
DataType -> IO ()
includeJs DataType
"data/js/model.js"
DataType -> IO ()
includeJs DataType
"data/js/resizing-canvas.js"
DataType -> IO ()
includeJs DataType
"data/js/node.js"
DataType -> IO ()
includeJs DataType
"data/js/selection.js"
DataType -> IO ()
includeJs DataType
"data/js/zoom.js"
DataType -> IO ()
includeJs DataType
"data/js/details.js"
DataType -> IO ()
includeJs DataType
"data/js/sorting.js"
DataType -> IO ()
includeJs DataType
"data/js/tree-map.js"
DataType -> IO ()
includeJs DataType
"data/js/tree-browser.js"
DataType -> IO ()
includeJs DataType
"data/js/main.js"
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h
ByteString
" </head>\n\
\ <body>"
Handle -> DataType -> IO ()
includeFile Handle
h DataType
"data/html/body.html"
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h
ByteString
" </body>\
\</html>"
where
title :: Text
title = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeBaseName [Char]
profFile
includeJs :: DataType -> IO ()
includeJs DataType
file = do
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h ByteString
"<script type=\"text/javascript\">"
Handle -> DataType -> IO ()
includeFile Handle
h DataType
file
Handle -> ByteString -> IO ()
BC8.hPutStrLn Handle
h ByteString
"</script>"
makeReport :: IO.Handle -> FilePath -> IO ()
makeReport :: Handle -> [Char] -> IO ()
makeReport Handle
h [Char]
profFile = do
Either [Char] CostCentre
profOrErr <- Text -> Either [Char] CostCentre
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
TL.readFile [Char]
profFile
case Either [Char] CostCentre
profOrErr of
Right CostCentre
prof ->
Handle -> [Char] -> NodeMap -> IO ()
writeReport Handle
h [Char]
profFile forall a b. (a -> b) -> a -> b
$ CostCentre -> NodeMap
nodeMapFromCostCentre CostCentre
prof
Left [Char]
err -> do
[Char] -> IO ()
putStrLnErr forall a b. (a -> b) -> a -> b
$ [Char]
profFile forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
err
forall a. IO a
exitFailure
putStrLnErr :: String -> IO ()
putStrLnErr :: [Char] -> IO ()
putStrLnErr = Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr
main :: IO ()
main :: IO ()
main = do
[Char]
progName <- IO [Char]
getProgName
[[Char]]
args <- IO [[Char]]
getArgs
case [[Char]]
args of
[[Char]]
_ | [Char]
"--version" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
args ->
[Char] -> IO ()
putStrLnErr (Version -> [Char]
showVersion Version
version)
[[Char]
profFile] ->
let htmlFile :: [Char]
htmlFile = [Char]
profFile forall a. [a] -> [a] -> [a]
++ [Char]
".html"
in forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile [Char]
htmlFile IOMode
IO.WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
Handle -> [Char] -> IO ()
makeReport Handle
h [Char]
profFile
[[Char]
profFile, [Char]
"-"] ->
Handle -> [Char] -> IO ()
makeReport Handle
IO.stdout [Char]
profFile
[[Char]
profFile, [Char]
htmlFile] ->
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile [Char]
htmlFile IOMode
IO.WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
Handle -> [Char] -> IO ()
makeReport Handle
h [Char]
profFile
[[Char]]
_ -> do
[Char] -> IO ()
putStrLnErr forall a b. (a -> b) -> a -> b
$ [Char]
"Usage: " forall a. [a] -> [a] -> [a]
++ [Char]
progName forall a. [a] -> [a] -> [a]
++ [Char]
" <prof file> [<output file>]"
[Char] -> IO ()
putStrLnErr [Char]
" <output file> \"-\" means STDOUT"
forall a. IO a
exitFailure