CmdLine.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  UI.CmdLine
-- Copyright   :  (c) 2011 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Multifocal:
-- Bidirectional Two-level Transformation of XML Schemas
-- 
-- Main file for the multifocal tool.
--
-----------------------------------------------------------------------------

module Main where

import Data.Type
import Data.Equal
import Data.Transform.TwoLevel
import UI.GenHaskell
import Language.TLT.Tlt2Strat
import Language.XML.Type2Xsd
import Language.XML.Xsd2Type
import Transform.Rules.Lenses
import Language.XML.HaXmlAliases
import Language.TLT.TltParser
import Transform.Rewriting as R
import UI.Menu

import System.IO
import System.Environment
import System.Console.GetOpt
import System.Exit
import Control.Monad.State as ST

-----------------------------------------------------------------------------
-- * Command line options

-- | Record type to hold all program options.
data Options = Options
	{
		  optInputXsdFile	:: Maybe FilePath
		, optInput2LTFile       :: Maybe FilePath
		, optOutputXsdFile	:: Maybe FilePath
		, optOutputHsFile       :: Maybe FilePath
		, optOptimize           :: Bool
	}

-- | Default options.
startOpt :: Options
startOpt = Options
	{ optInputXsdFile		= Nothing
	, optInput2LTFile		= Nothing
	, optOutputXsdFile		= Nothing
	, optOutputHsFile		= Nothing
	, optOptimize                   = False
	}

-- | Description of all available program options.
options :: Opts Options
options =
   [ Option "h" ["help"]
        (NoArg (\opt -> exitHelp options))
        "Show usage info"
   , Option "i" ["input"]
        (ReqArg (\arg opt -> return opt { optInputXsdFile = Just arg }) "FILE")
        "Input XML Schema"
   , Option "t" ["2lt"]
        (ReqArg (\arg opt -> return opt { optInput2LTFile = Just arg }) "FILE")
        "Input 2LT Transformation File"
   , Option "o" ["output"]
        (ReqArg (\arg opt -> return opt { optOutputXsdFile = Just arg }) "FILE")
        "Output XML Schema (default: stdout)"
   , Option "c" ["haskell"]
        (ReqArg (\arg opt -> do return opt { optOutputHsFile = Just arg }) "FILE")
        "Output Haskell program with the corresponding bidirectional transformation."
   , Option "e" ["optimize"]
        (NoArg (\opt -> do return opt { optOptimize = True }))
        "Optimize the resulting bidirectional transformation."
   ]

main = menu
menu :: IO ()
menu = do
	argv <- getArgs
	opts <- parseOptions startOpt options argv
	i <- run "input XML Schema missing" $ optInputXsdFile opts
	-- parse Xml Schema
	xml <- readFile i
	schema <- run "Error parsing input XML Schema" $ parseXsd i xml
	-- parse input XSD into a type
	(DynT a,tops) <- run "error translating input XML Schema" $ xsd2toptype schema
	--putStrLn $ showDatas a
	t <- run "input Multifocal Transformation missing" $ optInput2LTFile opts
	-- parse 2LT transformation file
	tfile <- readFile t
	let tlt = parseTLT tfile
	--putStrLn $ show tlt
	-- translate the parsed 2LT transformation into Haskell
	RuleTRep rule <- run "Error translating 2LT transformation" $ evalStateT (tlt2strat tlt) tops
	-- evaluate the 2LT transformation
	(View lns b,news) <- run "Failed to apply 2LT transformation" $ transform a rule
	-- print output XML Schema
	--putStrLn $ showDatas b
	outputHandle <- maybe (return stdout) (\f -> openFile f WriteMode) (optOutputXsdFile opts)
	doc <- run "Error generating output XML Schema file" $ type2doc b
	hPutStrLn outputHandle $ renderXml doc
	hClose outputHandle
	-- generate output Haskell Lens File
	let srcSchema = maybe "" id (optInputXsdFile opts)
	    tgtSchema = maybe "" id (optOutputXsdFile opts)
	    rule :: Rule
	    rule = if optOptimize opts then optimise_all_lns else R.nop
	case optOutputHsFile opts of
		Nothing -> return ()
		Just hs -> generateHaskell' srcSchema tgtSchema [] hs a (View lns b) news rule