-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- CurryBuilder - Generates Curry representations for a Curry source file
--                including all imported modules.
--
-- September 2005,
-- Martin Engelke (men@informatik.uni-kiel.de)
-- March 2007, extensions by Sebastian Fischer (sebf@informatik.uni-kiel.de)
--
module CurryBuilder (buildCurry, smake) where

import System.Exit
import System.Time
import Control.Monad
import qualified Data.Map as Map
import Data.Maybe
import Data.List 
import System.IO

import Curry.Base.Ident

import Modules (compileModule)
import CurryCompilerOpts 
import CurryDeps
import Filenames
import PathUtils

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

-- Compiles the Curry program 'file' including all imported modules, depending
-- on the options 'options'. The compilation was successful, if the returned
-- list is empty, otherwise it contains error messages.
buildCurry :: Options -> FilePath -> IO ()
buildCurry options file
   = do let paths = importPaths options
	file'          <- getCurryPath paths file
	(cfile, errs1) <- return (maybe ("", [missingModule file])
			                (\f -> (f,[]))
				        file')
	unless (null errs1) (abortWith errs1)
	(deps, errs2) <- genDeps paths cfile
	unless (null errs2) (abortWith errs2)
	makeCurry options deps cfile


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

makeCurry :: Options -> [(ModuleIdent,Source)] -> FilePath -> IO ()
makeCurry options deps file
   = mapM compile (map snd deps) >> return ()
 where
 compile (Source file' mods)
    | dropExtension file == dropExtension file'
      = do 
           flatIntfExists <- doesModuleExist (flatIntName file')
	   if flatIntfExists && not (force options) && null (dump options)
	    then smake (targetNames file')
                       (file':(catMaybes (map flatInterface mods)))
		       (generateFile file')
		       (skipFile file')
	    else generateFile file'
    | otherwise
      = do 
           flatIntfExists <- doesModuleExist (flatIntName file')
	   if flatIntfExists
            then  smake [flatName file'] --[flatName file', flatIntName file']
	                (file':(catMaybes (map flatInterface mods)))
			(compileFile file')
			(skipFile file')
	    else compileFile file'
 compile _ = return ()

 compileFile file
    = do unless (noVerb options) (putStrLn ("compiling " ++ file ++ " ..."))
	 compileModule (compOpts True) file
	 return ()

 skipFile file
    = do unless (noVerb options)
		(putStrLn ("skipping " ++ file ++ " ..."))

 generateFile file
    = do unless (noVerb options) 
		(putStrLn ("generating "  
			   ++ (head (targetNames file))               
			   ++ " ..."))
	 compileModule (compOpts False) file
	 return ()

 targetNames fn         
        | flat options            = [flatName fn] -- , flatIntName fn]
		| flatXml options         = [xmlName fn]
		| abstract options        = [acyName fn]
		| untypedAbstract options = [uacyName fn]
		| parseOnly options       = [maybe (sourceRepName fn) id (output options)]
		| otherwise               = [flatName fn] -- , flatIntName fn]

 flatInterface mod 
    = case (lookup mod deps) of
        Just (Source file _)  -> Just (flatIntName (dropExtension file))
	Just (Interface file) -> Just (flatIntName (dropExtension file))
	_                     -> Nothing

 compOpts isImport
    | isImport 
      = options 
	   { flat = True,
	     flatXml = False,
	     abstract = False,
	     untypedAbstract = False,
	     parseOnly = False,
	     dump = []
	   }
    | otherwise = options

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

-- Computes a dependency list for the Curry file 'file' (such a list
-- usualy starts with the prelude and ends with 'file'). The result 
-- is a tuple containing an association list (type [(ModuleIdent,Source)]; 
-- see module "CurryDeps") and a list of error messages.
genDeps :: [FilePath] -> FilePath
	   -> IO ([(ModuleIdent,Source)], [String])
genDeps paths file
   = fmap flattenDeps (deps paths [] Map.empty file)


-------------------------------------------------------------------------------
-- A simple make function

-- smake <destination files>
--       <dependencies> 
--       <io action, if dependencies are newer than destination files>
--       <io action, if destination files are newer than dependencies>
smake :: [FilePath] -> [FilePath] -> IO a -> IO a -> IO a
smake dests deps cmd alt
   = do destTimes <- getDestTimes dests
	depTimes  <- getDepTimes deps
	make destTimes depTimes
 where
 make destTimes depTimes
    | (length destTimes) < (length dests) 
      = catch cmd (\err -> abortWith [show err]) 
    | null depTimes 
      = abortWith ["unknown dependencies"]
    | outOfDate destTimes depTimes
      = catch cmd (\err -> abortWith [show err])
    | otherwise
      = alt

--
getDestTimes :: [FilePath] -> IO [ClockTime]
getDestTimes [] = return []
getDestTimes (file:files)
   = catch (do time  <- getModuleModTime file
	       times <- getDestTimes files
	       return (time:times))
           (const (getDestTimes files))

--
getDepTimes :: [String] -> IO [ClockTime]
getDepTimes [] = return []
getDepTimes (file:files)
   = catch (do time  <- getModuleModTime file
	       times <- getDepTimes files
	       return (time:times))
           (\err -> abortWith [show err])

--
outOfDate :: [ClockTime] -> [ClockTime] -> Bool
outOfDate tgtimes dptimes = or (map (\t -> or (map ((<) t) dptimes)) tgtimes)

-------------------------------------------------------------------------------
-- Error handling

-- Prints an error message on 'stderr'
putErrLn :: String -> IO ()
putErrLn = hPutStrLn stderr

-- Prints a list of error messages on 'stderr'
putErrsLn :: [String] -> IO ()
putErrsLn = mapM_ putErrLn

-- Prints a list of error messages on 'stderr' and aborts the program
abortWith :: [String] -> IO a
abortWith errs = putErrsLn errs >> exitWith (ExitFailure 1)


-- Error messages

missingModule :: FilePath -> String
missingModule file = "Error: missing module \"" ++ file ++ "\""

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