content: {- | Based on DrIFT 1.0 by Noel Winstanley,
       hacked for Haskell 98 by Malcolm Wallace, University of York, Feb 1999,
       modified by various people, now maintained by John Meacham,
       adapted version for hets by Christian Maeder.
  -}
  
  module Main (main) where
  
  import ChaseImports
  import UserRulesHetCATS
  import RuleUtils (commentLine, texts, Rule, Tag)
  import DataP
  import CommandP
  import ParseLib2
  import Text.PrettyPrint.HughesPJ
  import Data.List (partition)
  import System.Environment
  import qualified System.Exit as System
  import qualified System.IO as IO
  
  usage :: String
  usage = "Usage: DrIFT file\n"
  
  main :: IO ()
  main = do
      argv <- getArgs
      case argv of
          [n] -> derive n
          _ -> do
            IO.hPutStr IO.stderr
                  $ "single input file must be specified.\n" ++ usage
            System.exitFailure
  
  derive :: FilePath -> IO ()
  derive fname = do
          fbody <- readFile fname
          let modname = case papply (parse (symbol "module" >> cap))
                        (0, -1) ((0, 0), fbody) of
                        [(m, _)] -> m
                        _ -> error "module name not recognized"
          let (docs, _, todo) = process modname . parser $ fbody
          moreDocs <- fmap ((\ (x, _, _) -> x) . process modname)
                      (chaseImports fbody todo)
          putStr fbody
          putStrLn "\n-- Generated by DrIFT, look but don't touch!\n"
          putStr . render . vsep $ docs ++ moreDocs
  
  rules :: [(Tag, Data -> Doc)]
  rules = map (\ (a, b, _, _, _) -> (a, b)) hetcatsrules
  
  vsep :: [Doc] -> Doc
  vsep = vcat . map ($$ text "")
  
  {- Main Pass - Takes parsed data and rules and combines to create instances...
  Returns all parsed data, ande commands calling for files to be imported if
  datatypes aren't located in this module. -}
  
  process :: String -> ToDo -> ([Doc], [Data], ToDo)
  process modname i =
      (concatMap g dats ++ concatMap h moreDats, parsedData, fimports)
         where
          g (tags, d) = [find t rules d | t <- tags ++ directives]
          h (tags, d) = [find t rules d | t <- tags]
          directives = concatMap fst globals
          (dats, commands) = partition (isData . snd) i
          (globals, fors) = partition (\ (_, d) -> d == Directive) commands
          (moreDats, fimports) = resolve modname parsedData fors ([], [])
          parsedData = map snd dats
  
  find :: Tag -> [Rule] -> Data -> Doc
  find t r = case filter ((== t) . fst) r of
    x : _ -> snd x
    [] -> const $ commentLine
      $ hsep . texts $ ["Warning : Rule", t, "not found."]
  