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
, 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
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'
drivePath ('/' : file@(d : ':' : _more))
| d `elem` ['A'..'Z'] || d `elem` ['a'..'z']
= file
drivePath file
= file
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