--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module 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 h profFile prof = do
BC8.hPutStrLn h $
"\n\
\\n\
\ \n\
\ \n\
\ " `mappend` T.encodeUtf8 title `mappend` ""
BC8.hPutStr h ""
BC8.hPutStrLn h ""
includeJs JQueryFile
includeJs "data/js/unicode.js"
includeJs "data/js/model.js"
includeJs "data/js/resizing-canvas.js"
includeJs "data/js/node.js"
includeJs "data/js/selection.js"
includeJs "data/js/zoom.js"
includeJs "data/js/details.js"
includeJs "data/js/sorting.js"
includeJs "data/js/tree-map.js"
includeJs "data/js/tree-browser.js"
includeJs "data/js/main.js"
BC8.hPutStrLn h
" \n\
\ "
includeFile h "data/html/body.html"
BC8.hPutStrLn h
" \
\"
where
title = T.pack $ takeBaseName profFile
includeJs file = do
BC8.hPutStrLn h ""
--------------------------------------------------------------------------------
makeReport :: IO.Handle -> FilePath -> IO ()
makeReport h profFile = do
profOrErr <- decode <$> TL.readFile profFile
case profOrErr of
Right prof ->
writeReport h profFile $ nodeMapFromCostCentre prof
Left err -> do
putStrLnErr $ profFile ++ ": " ++ err
exitFailure
--------------------------------------------------------------------------------
putStrLnErr :: String -> IO ()
putStrLnErr = IO.hPutStrLn IO.stderr
--------------------------------------------------------------------------------
main :: IO ()
main = do
progName <- getProgName
args <- getArgs
case args of
_ | "--version" `elem` args ->
putStrLnErr (showVersion version)
[profFile] ->
let htmlFile = profFile ++ ".html"
in IO.withBinaryFile htmlFile IO.WriteMode $ \h ->
makeReport h profFile
[profFile, "-"] ->
makeReport IO.stdout profFile
[profFile, htmlFile] ->
IO.withBinaryFile htmlFile IO.WriteMode $ \h ->
makeReport h profFile
_ -> do
putStrLnErr $ "Usage: " ++ progName ++ " [