-- 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

module Main(main) where

import ChaseImports

import UserRulesHetCATS

import RuleUtils (commentLine,texts)

import DataP

import Pretty

import List (partition)

import qualified System

import IO

import RuleUtils(Rule,Tag)

import Version

import GenUtil

header = "Usage: DrIFT file"

main = do

argv <- System.getArgs

case argv of

[n] -> derive n

_ -> putErrDie $ "single input file must be specified.\n" ++ header

derive fname = do

body <- readFile fname

putStrLn $ "{- Generated by " ++ package ++

" (Automatic class derivations for Haskell) -}"

putStrLn $ "{-# LINE 1 \"" ++ fname ++ "\" #-}"

let (docs, _, todo) = process . parser $ body

moreDocs <- fmap ((\(x,_,_) -> x) . process) (chaseImports body todo)

putStr body

putStrLn "{- ? Generated by DrIFT : Look, but Don't Touch. ? -}"

putStr $ render . vsep $ docs ++ sepDoc:moreDocs

rules = map (\(a,b,_,_,_) -> (a,b)) $ hetcatsrules

vsep = vcat . map ($$ (text ""))

sepDoc = commentLine . text $ " Imported from other files :-"

-- 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 :: ToDo -> ([Doc],[Data],ToDo)

process i = (concatMap g dats ++ concatMap h moreDats,parsedData,imports)

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,imports) = resolve parsedData fors ([],[])

parsedData = map snd dats

find :: Tag -> [Rule] -> (Data -> Doc)

find t r = case filter ((==t) . fst) r of

[] -> const (commentLine warning)

x : _ -> snd x

where

warning = hsep . texts $ ["Warning : Rule",t,"not found."]