------------------------------------------------------------------------------ 
-- | 
-- Maintainer	: Ralf Laemmel, Joost Visser
-- Stability	: experimental
-- Portability	: portable
--
-- This module is part of 'Sdf2Haskell', a tool for generating Haskell
-- code from an SDF grammar. This module contains the main program.

------------------------------------------------------------------------------

module Main where

import SyntaxATermConvertibleInstances
import Language.Haskell.Pretty (prettyPrint, Pretty)
import SdfMetrics (putSdfMetricsLns)
import Data.ATerm.Lib (ATermConvertible,toATermString,toSharedATermString)

import System.Environment (getArgs,getProgName)
import System.IO

import SGLR (sglr)

import SdfLib (SDF)
import HaskellLib (HsModule)
import Sdf2Syntax (generateSyntaxModule)
import Sdf2Pretty (generatePrettyModule)

import Sdf2Cfg (genCfgDecl,CfgProd)
import Cfg
------------------------------------------------------------------------------

-- * Main program

-- | Main program
main :: IO ()
main = sdf2hsWrap worker
    where 
      worker :: (String,OutputKind) -> SDF -> IO (Either HsModule [CfgProd])
      worker (name,outputKind) sdf 
        = do analyzeSdf sdf
	     case outputKind of
               Pretty ->
	           do let modName = name++"PP"
                      putErrLn $ ">>> Generating Haskell module "++modName++" <<<"
                      putErrLn $ ">>> containing pretty-print support code <<<"
                      return $ Left (generatePrettyModule name modName sdf)
               Syntax ->
	           do putErrLn $ ">>> Generating Haskell module "++name++" <<<"
                      putErrLn $ ">>> containing syntax representation code <<<"
                      return $ Left (generateSyntaxModule name sdf)
               CFG ->
	           do putErrLn $ ">>> Generating Cfg  productions  <<<"
		      return $ Right (genCfgDecl sdf)

-- | Show some metrics about the incoming SDF grammar.
analyzeSdf :: SDF -> IO ()
analyzeSdf sdf
  = do putErrLn ">>> Analyzing Sdf grammar <<<"
       putSdfMetricsLns sdf
       
putErrLn = hPutStrLn stderr

------------------------------------------------------------------------------
-- * IO wrapper and option handling

-- | IO wrapper.
sdf2hsWrap :: (ATermConvertible a, ATermConvertible b, Pretty b)
           => ((String,OutputKind) -> a -> IO (Either b [CfgProd])) -> IO ()
sdf2hsWrap mtransform
  = do args <- getArgs
       progName <- getProgName
       opts <- return $ parseOptions progName args
       tin <- sglr ("./Sdf.tbl") (fin opts) "SDF"
       tout <- mtransform (mod_name opts, outputKind opts) $ tin
       sout <- return . toString progName (format opts) $ tout
       writeStream (fout opts) sout 
    where
      writeStream "#stdout#"	= putStrLn
      writeStream f		= writeFile f
      toString progName format 
        = case format of 
            "HASKELL" -> either prettyPrint show
            "TEXT"    -> either toATermString toATermString 
	    "TAF"     -> either toSharedATermString toSharedATermString
	    _      -> error $ "format unknown: "++"\n"++sdf2hsUsage progName

-- | Turn generated Haskell module into a string.
printModule :: HsModule -> String
printModule m
  = "-- | Generated by Sdf2Haskell. Look, but don't touch!"
    ++ (prettyPrint m)
	
-- | Record to hold the various options.
data OptionsSdf2Hs
  = OptionsSdf2Hs { fin :: String, fout :: String, 
                    format :: String, mod_name :: String,
		    outputKind :: OutputKind }

data OutputKind = Syntax | Pretty | CFG

-- | Default options.
defaultOptionsSdf2Hs :: OptionsSdf2Hs		    
defaultOptionsSdf2Hs
  = OptionsSdf2Hs { fin = "#stdin#", fout = "#stdout#", 
                    format = "HASKELL", mod_name = "Main",
		    outputKind = Syntax }

-- | Parse the supplied options.
parseOptions :: String -> [String] -> OptionsSdf2Hs
parseOptions programName args
  = p args
    where 
      p []		  = defaultOptionsSdf2Hs
      p ("-t":args)	  = (p args){ format = "TEXT" }
      p ("-s":args)	  = (p args){ format = "TAF" }
      p ("-h":args)	  = (p args){ format = "HASKELL" }
      p ("-b":args)	  = err "BAF format not supported!"
      p ("-i":fname:args) = (p args){ fin = fname }
      p ("-o":fname:args) = (p args){ fout = fname }
      p ("-m":name:args)  = (p args){ mod_name = name }
      p ("-p":args)       = (p args){ outputKind = Pretty }
      p ("-c":args)       = (p args){ outputKind = CFG }
      p args		  = err $ "Can't parse options: "++concat args
      err msg = error $ msg++"\n"++sdf2hsUsage programName

-- | Synthesize usage message.
sdf2hsUsage :: String -> String
sdf2hsUsage programName
  = unlines 
      [ "Sdf2Haskell generates Haskell code from Sdf grammars.",
        "",
        "A Haskell module is generated, either with data types to",
	"represent abstract syntax trees, or, if the -p option is",
	"supplied, with customizable pretty-printing functions.", 
        "",
        "Usage",
	"",
        "  "++programName++
	" -i <fname> [ -o <fname> ] [ -m <name> ] [-p|-c] [-t|-s]",
        "",
        "Options","",
        "  -i <fname>    name of input file  (default: stdin)",
        "  -o <fname>    name of output file (default: stdout)",
        "  -m <name>     name of generated module (default: Main)",
	"",
	"  -p            generate pretty-print support rather than syntax",
	"  -c            generate list of productions for HaGLR rather than syntax",
	"",
        "  -t            ATerm output, format is TEXT (plain text)",
        "  -s            ATerm output, format is TAF  (textual sharing)",
        "  -h            Haskell output (default)"
      ]
	    
-------------------------------------------------------------------------------