module Main where

import System.Console.GetOpt

import Data.Maybe

import System

import Parsec

import Common.Utils

import ParseFile

data Flag = Rule String | Exclude String | Header String | Output_Directory String

deriving Show

options :: [OptDescr Flag]

options = [

Option ['r'] ["rule"] (ReqArg Rule "RULE")

"rules are the actual DrIFT derivations",

Option ['x'] ["exclude"] (ReqArg Exclude "data[:data]")

"excludes the specified data-types",

Option ['h'] ["header"] (ReqArg Header "FILE[:FILE]")

"uses the header-file(s) for generation",

Option ['o'] ["output-directory"] (ReqArg Output_Directory "DIR")

"specifies the output-directory"

]

main :: IO ()

main = do args <- getArgs

case (getOpt RequireOrder options args) of

(m,n,[]) -> case n of

[] -> ioError $ userError ("no filename specified\n"

++ usageInfo header options)

[f] -> genRules m f

_ -> ioError $ userError ("too much filenames specified\n"

++ usageInfo header options)

(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))

where header = "Usage: genRules [OPTION...] file"

genRules :: [Flag] -> FilePath -> IO ()

genRules flags file = do inp <- readFile file

(name,ds,imports) <- case (parse inputFile "" inp) of

Left err -> do { putStr "parse error at";print err;return ([],[],[]) }

Right x -> return x

ds' <- exclude flags ds

fps <- getPaths flags

(rule,dir) <- getRuleAndDir flags

headers <- mapM readFile fps

writeFile (dir ++ "/" ++ fileWP ++ ".der.hs") $

fileHead ++ "\n\nmodule " ++ dir ++ "." ++ fileWP

++ " where\n\nimport " ++ name

++ "\nimport Common.ATerm.Lib\n" ++

concat (map (\x->"import " ++ x ++ "\nimport "++dir++ (cutModuleName x)++"\n") imports)

++ "\n" ++ concat headers ++ "\n" ++ rules rule ds'

where

fileHead = "{- Generated by 'genRules' (automatic rule generation for DrIFT). Don't touch!! -}"

fileWP = cutSuffix $ basename file

cutModuleName :: FilePath -> FilePath

cutModuleName xs'@('.':xs) = xs'

cutModuleName (x:xs) = cutModuleName xs

rules :: String -> [String] -> String

rules rule [] = []

rules rule (d:ds) = "{-! for " ++ d ++ " derive : " ++ rule ++ " !-}\n" ++ rules rule ds

exclude :: [Flag] -> [String] -> IO [String]

exclude [] ds = return ds

exclude ((Exclude s):fs) ds = case (parse (sepBy1 identifier (char ':')) "" s) of

Left err -> do{ putStr "can't parse exclude datatypes"; print err; return [] }

Right excs -> return [ d | d <- ds,not (elem d excs) ]

exclude (_:fs) ds = exclude fs ds

getPaths :: [Flag] -> IO [FilePath]

getPaths [] = return []

getPaths ((Header s):fs) = case (parse (sepBy1 path (char ':')) "" s) of

Left err -> do{ putStr "couldn't parse header-files";print err;return [] }

Right x -> return x

getPaths (_:fs) = getPaths fs

path :: Parser FilePath

path = many1 (noneOf ":*+?<>")

dirName :: Parser String

dirName = many1 (noneOf "/*+?<>")

getRuleAndDir :: [Flag] -> IO (String,String)

getRuleAndDir flags = return (getRule flags,getDir flags)

where

getRule ((Rule s):_) = s

getRule (_:xs) = getRule xs

getDir ((Output_Directory s):_) = s

getDir (_:xs) = getDir xs

cutSuffix :: String -> String

cutSuffix f = cutS "" f

where

cutS s ('.':_) = s

cutS s (x:xs) = cutS (s++ [x]) xs