{-# OPTIONS -fglasgow-exts #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Text.XML.Schema.ModuleGen
-- Copyright   :  (c) Simon Foster 2004
-- License     :  GPL version 2 (see COPYING)
-- 
-- Maintainer  :  aca01sdf@shef.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (ghc >= 6 only)
--
-- A Module which generates modules and module sections.
--
-- @This file is part of HAIFA.@
--
-- @HAIFA is free software; you can redistribute it and\/or modify it under the terms of the 
-- GNU General Public License as published by the Free Software Foundation; either version 2 
-- of the License, or (at your option) any later version.@
--
-- @HAIFA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without 
-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.@
--
-- @You should have received a copy of the GNU General Public License along with HAIFA; if not, 
-- write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA@
----------------------------------------------------------------------------
module Text.XML.Schema.ModuleGen where

import Text.XML.HXT.Aliases
import Utils
import Text.Regex
import GHC.Handle
import GHC.IO
import Data.List
import System.Directory
import Data.Maybe
--import Control.Exception

hierarchyPrefix = "Text.XML.Schema."

{-$ BEGIN-IMPORT-SECTION $-}

createModule :: String -> FilePath -> IO ()
createModule n f = do let 
                          p = if ((last f)=='/') then init f else f
                          m = (delimit n '.')
                          fn = (p ++ "/" ++ (map (\x -> if (x=='.') then '/' else x) n) ++ ".hs")
                      d <- doesFileExist fn
                      if d
                          then return ()
                          else do doDirLoop p (init m)
                                  h <- openFile fn WriteMode
                                  let {-(hd, tl) = sectionHeaders "IMPORT"-}
                                      hed = "{-# OPTIONS -fglasgow-exts #-}\n"
                                      imp = "import Data.Typeable\nimport Data.Generics\nimport Data.Array\nimport Text.XML.Serializer\n\n"
                                  hPutStr h $ hed++"module " ++ n ++ " where\n\n" ++ imp
                                  hClose h 
				  setSection "" "NS_IMPORT" n f
                                  setSection "" "IMPORT" n f
				  setSection "" "HEADER" n f

sectionBeginRegex x = mkRegex $ "^\\{-\\$[ ]*BEGIN-"++x++"-SECTION[ ]*\\$-\\}$"
sectionEndRegex   x = mkRegex $ "^\\{-\\$[ ]*END-"++x++"-SECTION[ ]*\\$-\\}$"
                                  
sectionHeaders :: String -> (String, String)
sectionHeaders s = ("{-$ BEGIN-"++s++"-SECTION $-}", "{-$ END-"++s++"-SECTION $-}")

getSection :: String -> String -> FilePath -> IO (Maybe [String])
getSection s m f = do 
                      x <- readFile' (modulePath m f)
                      return $ sectB $ lines x
    where
    sectB (h:t)   = if (isJust $ matchRegex (sectionBeginRegex s) h)
                        then sectE t []
                        else sectB t
    sectB []      = Nothing
    sectE (h:t) l = if (isJust $ matchRegex (sectionEndRegex s) h)
                        then Just l
                        else sectE t (l++[h])
    sectE []    _ = Nothing

readFile' :: String -> IO String
readFile' f = do h <- openFile f ReadMode
                 x <- r h
                 hClose h
                 return x
    where
    r g =   do h <- hGetChar g
               t <- catch (r g) (\_ -> return [])
               return (h:t)
               

            
getByRegex :: Regex -> String -> FilePath -> IO [String]
getByRegex r m f = do x <- readFile' (modulePath m f)
		      return $ filter (\x -> isJust $ matchRegex r x) (lines x) 
                     
setByRegex :: Regex -> String -> String -> FilePath -> IO ()
setByRegex r v m f = do x <- readFile' (modulePath m f)
			writeFile (modulePath m f) $ concat $ intersperse "\n" $ map (\x -> case (matchRegex r x) of
										                Just _  -> v
                                                                                                Nothing -> x) (lines x)
                        
setSection :: String -> String -> String -> FilePath -> IO ()
setSection c s m f = do 
                        x <- readFile' (modulePath m f)
                        
                        
                        writeFile (modulePath m f) $! (concat $ intersperse "\n" $! sectB (lines x) [])
                        
                        return ()
    where
    sectB (h:t) l = if (isJust $ matchRegex (sectionBeginRegex s) h)
                        then (l++[h]++(lines c)++sectE t)
                        else sectB t (l++[h])
    sectB []    l = let (hd, tl) = sectionHeaders s in l++["\n",hd]++(lines c)++[tl]
    sectE (h:t) = if (isJust $ matchRegex (sectionEndRegex s) h)
                      then (h:t)
                      else sectE t
    sectE [] = let (hd, tl) = sectionHeaders s in [tl]
    
importRegex = mkRegex "^[ ]*import (qualified )?([[:alnum:]._]+)( as ([[:alnum:]._]*))?$"
    
getImportNST :: String -> FilePath -> IO [(String, String)]
getImportNST m f = do s <- getSection "IMPORT" m f
                      if (isNothing s)
                          then return []
                          else return $ map (\x -> (x!!3, x!!1)) $ catMaybes $ map (matchRegex importRegex) $ fromJust s
                      

{-    outImports ((p, ns):t) = if (ns==m) then outImports t else concat ["import ", ns, " as ", p, "\n", outImports t]
   outImports [] = ""-}
    
    
{-addImportSection :: [(String, String)] -> String -> FilePath -> IO ()
addImportSection l m f = do let p  = if ((last f)=='/') then init f else f
                                fn = (p ++ "/" ++ (map (\x -> if (x=='.') then '/' else x) n) ++ ".hs")
                                (hd, ft) = sectionHeaders "IMPORT"
                                is = concat [hd, (concat $ map (\(p, ns) -> 
                                                concat ["import ", ns, (null p) ? ("", "as "++p), "\n"]) l), ft]
                            --h <- openFile fn
                            
                            
                          
-}                            
modulePath :: String -> FilePath -> FilePath
modulePath m f = let p  = if ((last f)=='/') then init f else f
                         in (p ++ "/" ++ (map (\x -> if (x=='.') then '/' else x) m) ++ ".hs")