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

{- |
   Module     : Text.XML.HXT.IO.GetFILE
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   The GET method for file protocol

-}

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

module Text.XML.HXT.IO.GetFILE
    ( getStdinCont
    , getCont
    )

where

import qualified Data.ByteString        as B
import qualified Data.ByteString.Char8  as C

import		 Network.URI		( unEscapeString
					)

import           System.IO		( IOMode(..)
					, openBinaryFile
					  -- , getContents  is defined in the prelude
					, hGetContents
					)

import           System.IO.Error	( ioeGetErrorString
					, try
					)

import           System.Directory	( doesFileExist
					, getPermissions
					, readable
					)
import 		 Text.XML.HXT.DOM.XmlKeywords

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

getStdinCont		:: Bool -> IO (Either ([(String, String)], String)
				              String)
getStdinCont strictInput
    = do
      c <- try ( if strictInput
		 then do
		      cb <- B.getContents
		      return  (C.unpack cb)
		 else getContents
	       )
      return (either readErr Right c)
    where
    readErr e
	= Left ( [ (transferStatus,  "999")
		 , (transferMessage, msg)
		 ]
	       , msg
	       )
	  where
	  msg = "stdin read error: " ++ es
	  es  = ioeGetErrorString e

getCont		:: Bool -> String -> IO (Either ([(String, String)], String)
					        String)
getCont strictInput source
    = do			-- preliminary
      source'' <- checkFile source'
      case source'' of
           Nothing -> return $ fileErr "file not found"
	   Just fn -> do
		      perm <- getPermissions fn
		      if not (readable perm)
			 then return $ fileErr "file not readable"
			 else do
			      c <- try $
				   if strictInput
				      then do
					   cb <- B.readFile fn
					   return (C.unpack cb)
				      else do
					   h <- openBinaryFile fn ReadMode
					   hGetContents h
			      return (either readErr Right c)
    where
    source' = drivePath $ source
    readErr e
	= fileErr (ioeGetErrorString e)
    fileErr msg0
	= Left ( [ (transferStatus,  "999")
		 , (transferMessage, msg)
		 ]
	       , msg
	       )
	  where
	  msg = "file read error: " ++ show msg0 ++ " when accessing " ++ show source'

    -- remove leading / if file starts with windows drive letter, e.g. /c:/windows -> c:/windows
    drivePath ('/' : file@(d : ':' : _more))
	| d `elem` ['A'..'Z'] || d `elem` ['a'..'z']
	    = file
    drivePath file
	= file

-- | check whether file exists, if not
-- try to unescape filename and check again
-- return the existing filename

checkFile	:: String -> IO (Maybe String)
checkFile fn
    = do
      exists <- doesFileExist fn
      if exists
	 then return (Just fn)
	 else do
	      exists' <- doesFileExist fn'
	      return ( if exists'
		       then Just fn'
		       else Nothing
		     )
    where
    fn' = unEscapeString fn

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