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

    {- |
       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

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