module AuxFile (readAuxFiles,writeAuxFile) where

import Flags(Flags,sIncludes,sPreludes,sDbgTrusted)
import Environment(Environment,Entity,HxEntity,exports,imports,hxEnvironmentToList,listToHxEnvironment)
import Relation(unionRelations)
import Language.Haskell.Exts
  (Module(..),ModuleHead(..),ExportSpecList(..),ExportSpec(..)
  ,ImportDecl(..),ModuleName(..),QName(..),SrcSpanInfo)
import SynHelp (mkQName,Id(getId),getModuleNameFromModule)
import System.FilePath (FilePath,addExtension,pathSeparator,(</>))
import System.IO (stderr,hPutStr)
import System.Exit (exitFailure)
import qualified Control.Exception(catch,IOException)
import Data.List (isPrefixOf)

-- Create environment for all imports.
-- Exception if hx-file of an imported module is not found.
readAuxFiles :: Flags -> Module SrcSpanInfo -> IO Environment
readAuxFiles flags mod@(Module l maybeModuleHead _ importDecls decls) = do
  importEnvs <- mapM (importEnv flags) (filter notNotHat importDecls)
  return (unionRelations importEnvs)

notNotHat :: ImportDecl l -> Bool
notNotHat importDecl = not ("NotHat" `isPrefixOf` getId (importModule importDecl))

importEnv :: Flags -> ImportDecl SrcSpanInfo -> IO Environment
importEnv flags importDecl = do
  entities <- readAuxFile flags (importModule importDecl)
  return (imports (listToHxEnvironment entities) importDecl)


-- Read whole content of .hx file of given module, using search paths in flags.
-- Aborts with error if no such .hx file is found.
readAuxFile :: Flags -> ModuleName l -> IO [HxEntity]
readAuxFile flags (ModuleName l moduleStr) = do
  let filePaths = potentialFilePaths flags moduleStr
  (filePath,contents) <- readFirst moduleStr filePaths filePaths
  return (map (myRead filePath) . tail . lines $ contents)

-- read function with better error message
myRead :: (Read a) => String -> String -> a
myRead file s =  
  case [x | (x,t) <- reads s, ("","") <- lex t] of
    [x] -> x
    []  -> error ("Interface file: Cannot parse in .hx file " ++ file ++ " line " ++ s)
    y   -> error ("Interface file: Ambiguous parse of .hx file " ++ file)

-- For given module name (String) and search paths in flags produce all file paths that .hx file may have.
potentialFilePaths :: Flags -> String -> [FilePath]
potentialFilePaths flags moduleStr = map (</> modPath) paths
  where
  modPath = addExtension (replaceBy '.' pathSeparator moduleStr) "hx"
  paths = sIncludes flags ++ sPreludes flags
  replaceBy :: Char -> Char -> String -> String
  replaceBy c1 c2 = map (\c -> if c==c1 then c2 else c)

  Given a list of filenames , return filename and its content of first file
-- that was read successfully (intention: other files may not exist)

readFirst :: String -> [FilePath] -> [FilePath] -> IO (FilePath,String)
readFirst modStr [] paths = do
  hPutStr stderr ("Fail: .hx file for module `" ++ modStr ++ "' not found in " ++ show paths ++ 
                  ". Give path with -I or -P.\n") 
  exitFailure
readFirst modStr (x:xs) paths =
  Control.Exception.catch (do finput <- readFile x
                              return (x,finput))
        (\ y -> (y :: Control.Exception.IOException) `seq` readFirst modStr xs paths)

-- `writeAuxFile' writes out the .hx file given this module's complete
-- parse tree.  The .hx file has an entry for every exported identifier, whether
-- defined in this module or reexported from imports.
-- Note that an entry may also contain names that are not exported, e.g. for a type its data constructors
-- or for a method its class.
writeAuxFile :: Flags -> FilePath -> Environment -> Module SrcSpanInfo -> IO ()
writeAuxFile flags filePath env mod = 
  writeFile filePath 
    ((showString "module " . (getId (getModuleNameFromModule mod) ++) . showChar '\n' .
     showLines (hxEnvironmentToList (exports (not (sDbgTrusted flags)) mod env))) "")
  where
  showLines :: Show a => [a] -> ShowS
  showLines = foldr (\x y-> shows x . showChar '\n' . y) id

 Create environment for all imports.
 Exception if hx-file of an imported module is not found.
 Read whole content of .hx file of given module, using search paths in flags.
 Aborts with error if no such .hx file is found.
 read function with better error message
 For given module name (String) and search paths in flags produce all file paths that .hx file may have.
 that was read successfully (intention: other files may not exist)
 `writeAuxFile' writes out the .hx file given this module's complete
 parse tree.  The .hx file has an entry for every exported identifier, whether
 defined in this module or reexported from imports.
 Note that an entry may also contain names that are not exported, e.g. for a type its data constructors
 or for a method its class.
module AuxFile (readAuxFiles,writeAuxFile) where

import Flags(Flags,sIncludes,sPreludes,sDbgTrusted)
import Environment(Environment,Entity,HxEntity,exports,imports,hxEnvironmentToList,listToHxEnvironment)
import Relation(unionRelations)
import Language.Haskell.Exts
  (Module(..),ModuleHead(..),ExportSpecList(..),ExportSpec(..)
  ,ImportDecl(..),ModuleName(..),QName(..),SrcSpanInfo)
import SynHelp (mkQName,Id(getId),getModuleNameFromModule)
import System.FilePath (FilePath,addExtension,pathSeparator,(</>))
import System.IO (stderr,hPutStr)
import System.Exit (exitFailure)
import qualified Control.Exception(catch,IOException)
import Data.List (isPrefixOf)

readAuxFiles :: Flags -> Module SrcSpanInfo -> IO Environment
readAuxFiles flags mod@(Module l maybeModuleHead _ importDecls decls) = do
  importEnvs <- mapM (importEnv flags) (filter notNotHat importDecls)
  return (unionRelations importEnvs)

notNotHat :: ImportDecl l -> Bool
notNotHat importDecl = not ("NotHat" `isPrefixOf` getId (importModule importDecl))

importEnv :: Flags -> ImportDecl SrcSpanInfo -> IO Environment
importEnv flags importDecl = do
  entities <- readAuxFile flags (importModule importDecl)
  return (imports (listToHxEnvironment entities) importDecl)


readAuxFile :: Flags -> ModuleName l -> IO [HxEntity]
readAuxFile flags (ModuleName l moduleStr) = do
  let filePaths = potentialFilePaths flags moduleStr
  (filePath,contents) <- readFirst moduleStr filePaths filePaths
  return (map (myRead filePath) . tail . lines $ contents)

myRead :: (Read a) => String -> String -> a
myRead file s =  
  case [x | (x,t) <- reads s, ("","") <- lex t] of
    [x] -> x
    []  -> error ("Interface file: Cannot parse in .hx file " ++ file ++ " line " ++ s)
    y   -> error ("Interface file: Ambiguous parse of .hx file " ++ file)

potentialFilePaths :: Flags -> String -> [FilePath]
potentialFilePaths flags moduleStr = map (</> modPath) paths
  where
  modPath = addExtension (replaceBy '.' pathSeparator moduleStr) "hx"
  paths = sIncludes flags ++ sPreludes flags
  replaceBy :: Char -> Char -> String -> String
  replaceBy c1 c2 = map (\c -> if c==c1 then c2 else c)

  Given a list of filenames , return filename and its content of first file

readFirst :: String -> [FilePath] -> [FilePath] -> IO (FilePath,String)
readFirst modStr [] paths = do
  hPutStr stderr ("Fail: .hx file for module `" ++ modStr ++ "' not found in " ++ show paths ++ 
                  ". Give path with -I or -P.\n") 
  exitFailure
readFirst modStr (x:xs) paths =
  Control.Exception.catch (do finput <- readFile x
                              return (x,finput))
        (\ y -> (y :: Control.Exception.IOException) `seq` readFirst modStr xs paths)

writeAuxFile :: Flags -> FilePath -> Environment -> Module SrcSpanInfo -> IO ()
writeAuxFile flags filePath env mod = 
  writeFile filePath 
    ((showString "module " . (getId (getModuleNameFromModule mod) ++) . showChar '\n' .
     showLines (hxEnvironmentToList (exports (not (sDbgTrusted flags)) mod env))) "")
  where
  showLines :: Show a => [a] -> ShowS
  showLines = foldr (\x y-> shows x . showChar '\n' . y) id
