content: -- ------------------------------------------------------------
  --
  -- protocol handler function for file protocol
  -- implemented as filer
  
  module Text.XML.HXT.Parser.ProtocolHandlerFile
      ( getFileContents
      )
  
  where
  
  import Text.XML.HXT.DOM.XmlTree
  
  import Text.XML.HXT.DOM.XmlState
  
  import System.Directory
      ( doesFileExist
      , getPermissions
      , readable
      )
  
  import Network.URI
      ( URI
      , unEscapeString
      , uriPath
      )
  
  import System.IO
  import System.IO.Error
  
  -- ------------------------------------------------------------
  --
  -- the file protocol handler
  
  getFileContents :: URI -> XmlStateFilter a
  getFileContents uri n
      = do
        trace 2 ("getFileContent: reading file " ++ show source)
        exists <- io $ doesFileExist source
        if exists
           then do
                perm <- io $ getPermissions source
                if readable perm
                   then do
                        h <- io $ try ( openBinaryFile source ReadMode )
                        case h of
                               Left e
                                   -> readErr ( "system error when reading file "
                                                ++ show source
                                                ++ ": "
                                                ++ ioeGetErrorString e
                                              )
                               Right h'
                                   -> do
                                      c <- io $ hGetContents h'
                                      return ( ( addAttrInt transferStatus 200
                                                 .>
                                                 addAttr transferMessage "OK"
                                                 .>
                                                 replaceChildren (xtext c)
                                               ) n
                                             )
  
                   else readErr ("file " ++ show source ++ " not readable")
           else readErr ("file " ++ show source ++ " not found")
      where
      source      = fileUriPath . unEscapeString . uriPath $ uri
      readErr msg = addFatal msg n
  
      -- remove leading / if file starts with windows drive letter, e.g. /c:/windows -> c:/windows
      fileUriPath ('/' : file@(d : ':' : _more))
          | d `elem` ['A'..'Z'] || d `elem` ['a'..'z']
              = file
      fileUriPath file
          = file
  
  -- ------------------------------------------------------------
  