1--------------------------------------------------------------------------------
2{-# LANGUAGE OverloadedStrings #-}
3module Main
4    ( main
5    ) where
6
7
8--------------------------------------------------------------------------------
9import qualified Data.Aeson                 as Aeson
10import qualified Data.ByteString.Char8      as BC8
11import qualified Data.ByteString.Lazy       as BL
12import qualified Data.Text                  as T
13import qualified Data.Text.Encoding         as T
14import qualified Data.Text.Lazy.IO          as TL
15import           Data.Version               (showVersion)
16import           System.Environment         (getArgs, getProgName)
17import           System.Exit                (exitFailure)
18import           System.FilePath            (takeBaseName)
19import qualified System.IO                  as IO
20
21
22--------------------------------------------------------------------------------
23import           Paths_profiteur            (version)
24import           Profiteur.Core
25import           Profiteur.Parser
26import           Profiteur.DataFile
27
28
29--------------------------------------------------------------------------------
30writeReport :: IO.Handle -> String -> NodeMap -> IO ()
31writeReport h profFile prof = do
32    BC8.hPutStrLn h $
33        "<!DOCTYPE html>\n\
34        \<html>\n\
35        \  <head>\n\
36        \    <meta charset=\"UTF-8\">\n\
37        \    <title>" `mappend` T.encodeUtf8 title `mappend` "</title>"
38
39    BC8.hPutStr h "<script type=\"text/javascript\">var $prof = "
40    BL.hPutStr h $ Aeson.encode prof
41    BC8.hPutStrLn h ";</script>"
42
43    BC8.hPutStrLn h "<style>"
44    includeFile h "data/css/main.css"
45    BC8.hPutStrLn h "</style>"
46
47    includeJs JQueryFile
48    includeJs "data/js/unicode.js"
49    includeJs "data/js/model.js"
50    includeJs "data/js/resizing-canvas.js"
51    includeJs "data/js/node.js"
52    includeJs "data/js/selection.js"
53    includeJs "data/js/zoom.js"
54    includeJs "data/js/details.js"
55    includeJs "data/js/sorting.js"
56    includeJs "data/js/tree-map.js"
57    includeJs "data/js/tree-browser.js"
58    includeJs "data/js/main.js"
59
60    BC8.hPutStrLn h
61        "  </head>\n\
62        \  <body>"
63    includeFile h "data/html/body.html"
64    BC8.hPutStrLn h
65        "  </body>\
66        \</html>"
67  where
68    title    = T.pack $ takeBaseName profFile
69
70    includeJs file = do
71        BC8.hPutStrLn h "<script type=\"text/javascript\">"
72        includeFile h file
73        BC8.hPutStrLn h "</script>"
74
75--------------------------------------------------------------------------------
76makeReport :: IO.Handle -> FilePath -> IO ()
77makeReport h profFile = do
78    profOrErr <- decode <$> TL.readFile profFile
79    case profOrErr of
80        Right prof ->
81            writeReport h profFile $ nodeMapFromCostCentre prof
82        Left err   -> do
83            putStrLnErr $ profFile ++ ": " ++ err
84            exitFailure
85
86--------------------------------------------------------------------------------
87putStrLnErr :: String -> IO ()
88putStrLnErr = IO.hPutStrLn IO.stderr
89
90--------------------------------------------------------------------------------
91main :: IO ()
92main = do
93    progName <- getProgName
94    args     <- getArgs
95    case args of
96        _ | "--version" `elem` args ->
97            putStrLnErr (showVersion version)
98        [profFile] ->
99            let htmlFile = profFile ++ ".html"
100            in IO.withBinaryFile htmlFile IO.WriteMode $ \h ->
101                  makeReport h profFile
102        [profFile, "-"] ->
103            makeReport IO.stdout profFile
104        [profFile, htmlFile] ->
105            IO.withBinaryFile htmlFile IO.WriteMode $ \h ->
106                makeReport h profFile
107        _ -> do
108            putStrLnErr $ "Usage: " ++ progName ++ " <prof file> [<output file>]"
109            putStrLnErr   "   <output file> \"-\" means STDOUT"
110            exitFailure
111