------------------------------------------------------------------
-- |
-- Program     :  idlconv          
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- Convert parsed IDL spec to WebBits Javascript expressions.
------------------------------------------------------------------

module Main where

import HSH
import Paths_idlconv
import Prelude hiding (putStrLn, putStr, getContents, catch, readFile)
import Control.Monad
import Data.List
import qualified Data.Map as M
import Data.DateTime
import System.FilePath
import System.Exit
import System.Environment.UTF8
import System.IO (hFlush, stdout, stderr, Handle)
import System.IO.UTF8

import IdlOptions
import IdlGlobal
import IdlConvert

import Language.WebIDL
import Language.WebIDL.PrettyPrint
import Paths_idlconv

-- Options grammar.

optgr = many optn >> sepopts "filename" addInputFile

optn = kw    "@pp" (\_ st -> Just st {runmode = ICSlavePP}) <|>
       kw    "@cv" (\_ st -> Just st {runmode = ICSlaveCV}) <|>
       noopt "filename" addInputFile <|>
       optparm 'o' "output_file" (\_ f st -> Just st {outfile = f}) <|>
       optparm 'c' "cpp_option" (\_ o st -> Just st {cppopt = cppopt st ++ [o]}) <|>
       optparm 'm' "module" (\_ m st -> Just st {modules = modules st ++ [m]}) <|>
       optparm 'n' "dom_namespace" (\_ s st -> Just st {domns = s}) <|>
       optparm 'I' "include_dir" (\_ i st -> Just st {incldirs = incldirs st ++ [i]}) <|>
       opt     'v' (\_ st -> Just st {verbose = True}) <|>
             optparm 'f' "nocpp|[no]comp|ppr" setFlag

-- User actions on options.

addInputFile f st = Just st {infiles = infiles st ++ [f]}

setFlag c flg st = case flg of
  "nocpp" -> Just st {runcpp = False, compconst = False}
  "nocomp" -> Just st {compconst = False}
  "comp" -> Just st {compconst = True}
  "ppr" -> Just st {ppronly = True}
  _ -> Nothing

-- Build cpphs command line parameter list out of the parsed command line.
-- If cpphs is not to be run, only input file names are included (since
-- cat will be used instead of cpphs). Otherwise incldirs and cppopts
-- are also involved

buildCpphsParms :: ICGlobal -> [String]

buildCpphsParms opts = incls ++ othopts ++ files where
  files = infiles opts
  incls = map ("-I" ++) (incldirs opts) `emptyifnot` runcpp opts
  othopts = cppopt opts `emptyifnot` runcpp opts
  emptyifnot x True = x
  emptyifnot x False = []

-- Determine which command we run on input files to read them in

inputCommand :: ICGlobal -> String

inputCommand x | runcpp x = "cpphs"
inputCommand _ = "cat"

-- Determine which command we run on the preprocessed input

slave :: String -> ICGlobal -> (String, [String])

slave p x | runmode x /= ICMaster = error "Should not get here"
slave p x | ppronly x = (p, ["@pp"])
slave p x = (p, ["@cv"] ++ o1 ++ o2 ++ o3 ++ o4) where
  o1 = if compconst x then ["-fcomp"] else ["-fnocomp"]
  o2 = if (not . null . domns) x then ["-n", domns x] else []
  o3 = if (not . null . modules) x then concat $ map (\s -> ["-m", s]) $ modules x else []
  o4 = if verbose x then  ["-v"] else []

-- Parse and pretty-print the standard input to standard output

pprOnly :: IO ()

pprOnly = do
  tks <- lexStdin
  let pp = parseIDL tks
  case pp of
    Right p -> putStrLn $ prettyPrint p
    Left e -> putStrLn $ show e

-- Main program.

main :: IO ()

main = do
  args <- getArgs
  ts <- getCurrentTime >>= return . toSeconds
  let x = parseArgs optgr icopt args
  case x of
    Left err -> do
      putStrLn $ show err
      exitWith (ExitFailure 1)
    Right opts -> case runmode opts of
      ICMaster -> procInput opts
      ICSlavePP -> pprOnly
      ICSlaveCV -> do
        tspc <- parseTagSpec
        idlToHs opts {timestamp = ts, tagspec = tspc}

-- Read in the "idltags.txt" file and create the tag-interface correspondence
-- map. In this map, interface name is a key, and tag name is a value.

parseTagSpec :: IO (M.Map String String)

parseTagSpec = do
  dd <- getDataDir
  tf <- readFile (dd </> "spec" </> "idltags.txt") >>= return . lines
  let onetag s = 
        let (vv, kk) = span (/= ':') s
        in  (delete ':' $ delete ' ' kk, vv)
  return $ M.fromList (map onetag tf)

procInput :: ICGlobal -> IO ()

procInput opts = do
  prog <- getProgName
  let cpcl = buildCpphsParms opts
      icmd = inputCommand opts
  x <- tryEC (runIO ((icmd, cpcl) -|- slave prog opts -|- (id :: String -> String)))
  case x of
    Right z -> exitSuccess
    Left e -> exitWith e