    {-# LANGUAGE CPP #-}
    module Distribution.Simple.UUAGC.UUAGC(uuagcUserHook,
                                           uuagcUserHook',
                                           uuagc,
                                           uuagcLibUserHook,
                                           uuagcFromString
                                          ) where

    import Distribution.Simple.BuildPaths (autogenModulesDir)
    import Debug.Trace
    import Distribution.Simple
    import Distribution.Simple.PreProcess
    import Distribution.Simple.LocalBuildInfo
    import Distribution.Simple.Utils
    import Distribution.Simple.Setup
    import Distribution.PackageDescription hiding (Flag)
    import Distribution.Simple.UUAGC.AbsSyn( AGFileOption(..)
                                             , AGFileOptions
                                             , AGOptionsClass(..)
                                             , lookupFileOptions
                                             , fileClasses
                                             )
    import Distribution.Simple.UUAGC.Parser
    import Options hiding (verbose)
    import Distribution.Verbosity
    import System.Process( readProcessWithExitCode )
    import System.Directory(getModificationTime
                           ,doesFileExist
                           ,removeFile)
    import System.FilePath(pathSeparators,
                           (</>),
                           takeFileName,
                           normalise,
                           joinPath,
                           dropFileName,
                           addExtension,
                           dropExtension,
                           replaceExtension,
                           splitDirectories)

    import System.Exit (ExitCode(..))
    import System.IO( openFile, IOMode(..),
                      hFileSize,
                      hSetFileSize,
                      hClose,
                      hGetContents,
                      hFlush,
                      Handle(..), stderr, hPutStr, hPutStrLn)
    import System.Exit(exitFailure)
    import Control.Exception (throwIO)
    import Control.Monad (liftM, when, guard, forM_, forM)
    import Control.Arrow ((&&&), second)
    import Data.Maybe (maybeToList)
    import Data.Either (partitionEithers)
    import Data.List (nub,intersperse)
    import Data.Map (Map)
    import qualified Data.Map as Map

    {-# DEPRECATED uuagcUserHook, uuagcUserHook', uuagc "Use uuagcLibUserHook instead" #-}

    -- | 'uuagc' returns the name of the uuagc compiler
    uuagcn = "uuagc"

    -- | 'defUUAGCOptions' returns the default names of the uuagc options
    defUUAGCOptions :: String
    defUUAGCOptions = "uuagc_options"

    -- | File used to store de classes defined in the cabal file.
    agClassesFile :: String
    agClassesFile = "ag_file_options"

    -- | The prefix used for the cabal file optionsw
    agModule :: String
    agModule = "x-agmodule"

    -- | The prefix used for the cabal file options used for defining classes
    agClass :: String
    agClass  = "x-agclass"

    -- | Deprecated userhook
    uuagcUserHook :: UserHooks
    uuagcUserHook = uuagcUserHook' uuagcn

    -- | Deprecated userhook
    uuagcUserHook' :: String -> UserHooks
    uuagcUserHook' uuagcPath = uuagcLibUserHook (uuagcFromString uuagcPath)

    -- | Create uuagc function using shell (old method)
    uuagcFromString :: String -> [String] -> FilePath -> IO (ExitCode, [FilePath])
    uuagcFromString uuagcPath args file = do
      (ec,out,err) <- readProcessWithExitCode uuagcPath (args ++ [file]) ""
      case ec of
        ExitSuccess ->
          do hPutStr stderr err
             return (ExitSuccess, words out)
        (ExitFailure exc) ->
          do hPutStrLn stderr (uuagcPath ++ ": " ++ show exc)
             hPutStr stderr out
             hPutStr stderr err
             return (ExitFailure exc, [])

    -- | Main hook, argument should be uuagc function
    uuagcLibUserHook :: ([String] -> FilePath -> IO (ExitCode, [FilePath])) -> UserHooks
    uuagcLibUserHook uuagc = hooks where
      hooks = simpleUserHooks { hookedPreProcessors = ("ag", ag):("lag",ag):knownSuffixHandlers
                              , buildHook = uuagcBuildHook uuagc
                              , sDistHook = uuagcSDistHook uuagc
                              }
      ag = uuagc' uuagc

    originalPreBuild  = preBuild simpleUserHooks
    originalBuildHook = buildHook simpleUserHooks
    originalSDistHook = sDistHook simpleUserHooks

    putErrorInfo :: Handle -> IO ()
    putErrorInfo h = hGetContents h >>= hPutStr stderr

    -- | 'updateAGFile' search into the uuagc options file for a list of all
    -- AG Files and theirs file dependencies in order to see if the latters
    -- are more updated that the formers, and if this is the case to
    -- update the AG File
    updateAGFile :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
                 -> Map FilePath (Options, Maybe (FilePath, [String]))
                 -> (FilePath, (Options, Maybe (FilePath, [String])))
                 -> IO ()
    updateAGFile _ _ (_,(_,Nothing)) = return ()
    updateAGFile uuagc newOptions (file,(opts,Just (gen,sp))) = do
      hasGen <- doesFileExist gen
      when hasGen $ do
        (ec, files) <- uuagc (optionsToString $ opts { genFileDeps = True, searchPath = sp }) file
        case ec of
          ExitSuccess -> do
            let newOpts :: Options
                newOpts = maybe noOptions fst $ Map.lookup file newOptions
                optRebuild = optionsToString newOpts /= optionsToString opts
            modRebuild <-
              if null files
              then return False
              else do
                flsmt <- mapM getModificationTime files
                let maxModified = maximum flsmt
                fmt <- getModificationTime gen
                return $ maxModified > fmt
            -- When some dependency is newer or options have changed, we should regenerate
            when (optRebuild || modRebuild) $ removeFile gen
          ex@(ExitFailure _) -> throwIO ex

    getAGFileOptions :: [(String, String)] -> IO AGFileOptions
    getAGFileOptions extra = do
      cabalOpts <- mapM (parseOptionAG . snd) $ filter ((== agModule) . fst) extra
      usesOptionsFile <- doesFileExist defUUAGCOptions
      if usesOptionsFile
           then do r <- parserAG' defUUAGCOptions
                   case r of
                     Left e -> dieNoVerbosity (show e)
                     Right a -> return $ cabalOpts ++ a
           else return cabalOpts

    getAGClasses :: [(String, String)] -> IO [AGOptionsClass]
    getAGClasses = mapM (parseClassAG . snd) . filter ((== agClass) . fst)

    writeFileOptions :: FilePath -> Map FilePath (Options, Maybe (FilePath,[String])) -> IO ()
    writeFileOptions classesPath opts  = do
      hClasses <- openFile classesPath WriteMode
      hPutStr hClasses $ show $ Map.map (\(opt,gen) -> (optionsToString opt, gen)) opts
      hFlush  hClasses
      hClose  hClasses

    readFileOptions :: FilePath -> IO (Map FilePath (Options, Maybe (FilePath,[String])))
    readFileOptions classesPath = do
      isFile <- doesFileExist classesPath
      if isFile
        then do hClasses <- openFile classesPath ReadMode
                sClasses <- hGetContents hClasses
                classes <- readIO sClasses :: IO (Map FilePath ([String], Maybe (FilePath,[String])))
                hClose hClasses
                return $ Map.map (\(opt,gen) -> let (opt',_,_) = getOptions opt in (opt', gen)) classes
        else    return Map.empty

    getOptionsFromClass :: [(String, Options)] -> AGFileOption -> ([String], Options)
    getOptionsFromClass classes fOpt =
        second (foldl combineOptions (opts fOpt))
        . partitionEithers $ do
                           fClass <- fileClasses fOpt
                           case fClass `lookup` classes of
                             Just x  -> return $ Right x
                             Nothing -> return $ Left $ "Warning: The class "
                                                       ++ show fClass
                                                       ++ " is not defined."

    uuagcSDistHook :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
         -> PackageDescription
         -> Maybe LocalBuildInfo
         -> UserHooks
         -> SDistFlags
         -> IO ()
    uuagcSDistHook uuagc pd mbLbi uh df = do
      {-
      case mbLbi of
        Nothing -> warn normal "sdist: the local buildinfo was not present. Skipping AG initialization. Dist may fail."
        Just lbi -> let classesPath = buildDir lbi </> agClassesFile
                    in commonHook uuagc classesPath pd lbi (sDistVerbosity df)
      originalSDistHook pd mbLbi uh df
      -}
      originalSDistHook pd mbLbi (uh { hookedPreProcessors = ("ag", nouuagc):("lag",nouuagc):knownSuffixHandlers }) df  -- bypass preprocessors

    uuagcBuildHook
      :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
         -> PackageDescription
         -> LocalBuildInfo
         -> UserHooks
         -> BuildFlags
         -> IO ()
    uuagcBuildHook uuagc pd lbi uh bf = do
      let classesPath = buildDir lbi </> agClassesFile
      commonHook uuagc classesPath pd lbi (buildVerbosity bf)
      originalBuildHook pd lbi uh bf

    commonHook :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
         -> FilePath
         -> PackageDescription
         -> LocalBuildInfo
         -> Flag Verbosity
         -> IO ()
    commonHook uuagc classesPath pd lbi fl = do
      let verbosity = fromFlagOrDefault normal fl
      info verbosity $ "commonHook: Assuming AG classesPath: " ++ classesPath
      createDirectoryIfMissingVerbose verbosity True (buildDir lbi)
      -- Read already existing options
      -- Map FilePath (Options, Maybe (FilePath,[String]))
      oldOptions <- readFileOptions classesPath
      -- Read options from cabal and settings file
      let lib    = library pd
          exes   = executables pd
          bis    = map libBuildInfo (maybeToList lib) ++ map buildInfo exes
      classes <- map (className &&& opts') `fmap` (getAGClasses . customFieldsPD $ pd)
      configOptions <- getAGFileOptions (bis >>= customFieldsBI)
      -- Construct new options map
      newOptionsL <- forM configOptions (\ opt ->
          let (notFound, opts) = getOptionsFromClass classes $ opt
              file = normalise $ filename opt
              gen = maybe Nothing snd $ Map.lookup file oldOptions
          in do info verbosity $ "options for " ++ file ++ ": " ++ unwords (optionsToString opts)
                forM_ notFound (hPutStrLn stderr)
                return (file, (opts, gen)))
      let newOptions = Map.fromList newOptionsL
      writeFileOptions classesPath newOptions
      -- Check if files should be regenerated
      mapM_ (updateAGFile uuagc newOptions) $ Map.toList oldOptions

    getAGFileList :: AGFileOptions -> [FilePath]
    getAGFileList = map (normalise . filename)

    uuagc :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
    uuagc = uuagc' (uuagcFromString uuagcn)

    uuagc' :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
            -> BuildInfo
            -> LocalBuildInfo
            -> ComponentLocalBuildInfo
            -> PreProcessor
    uuagc' uuagc build lbi _ =
       PreProcessor {
         platformIndependent = True,
         runPreProcessor = mkSimplePreProcessor $ \ inFile outFile verbosity ->
                           do notice verbosity $ "[UUAGC] processing: " ++ inFile ++ " generating: " ++ outFile
                              let classesPath = buildDir lbi </> agClassesFile
                              info verbosity $ "uuagc-preprocessor: Assuming AG classesPath: " ++ classesPath
                              fileOpts <- readFileOptions classesPath
                              opts <- case Map.lookup inFile fileOpts of
                                           Nothing        -> do warn verbosity $ "No options found for " ++ inFile
                                                                return noOptions
                                           Just (opt,gen) -> return opt
                              let search  = dropFileName inFile
                                  options = opts { searchPath = search : hsSourceDirs build ++ searchPath opts
                                                 , outputFiles = outFile : (outputFiles opts) }
                              (eCode,_) <- uuagc (optionsToString options) inFile
                              case eCode of
                                ExitSuccess   -> writeFileOptions classesPath (Map.insert inFile (opts, Just (outFile, searchPath options)) fileOpts)
                                ex@(ExitFailure _) -> throwIO ex
                    }

    nouuagc :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
    nouuagc build lbi _ =
      PreProcessor {
        platformIndependent = True,
        runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do
          info verbosity ("skipping: " ++ outFile)
      }