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

{- |
   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           Control.Exception      ( try )

import qualified Data.ByteString.Lazy   as B

import           Network.URI            ( unEscapeString
                                        )
import           System.IO.Error        ( ioeGetErrorString
                                        )
import           System.Directory       ( doesFileExist
                                        -- , getPermissions
                                        -- , readable
                                        )
import           Text.XML.HXT.DOM.XmlKeywords

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

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

getCont         :: Bool -> String -> IO (Either ([(String, String)], String) B.ByteString)
getCont :: Bool
-> String -> IO (Either ([(String, String)], String) ByteString)
getCont Bool
strictInput String
source
    = do                        -- preliminary
      source'' <- String -> IO (Maybe String)
checkFile String
source'
      case source'' of
           Maybe String
Nothing -> Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ([(String, String)], String) ByteString
 -> IO (Either ([(String, String)], String) ByteString))
-> Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Either ([(String, String)], String) ByteString
forall {p} {b}.
Show p =>
p -> Either ([(String, String)], String) b
fileErr String
"file not found"
           Just String
fn -> do
                      -- perm <- getPermissions fn  -- getPermission may fail
                      -- if not (readable perm)
                      if Bool
False
                         then Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ([(String, String)], String) ByteString
 -> IO (Either ([(String, String)], String) ByteString))
-> Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Either ([(String, String)], String) ByteString
forall {p} {b}.
Show p =>
p -> Either ([(String, String)], String) b
fileErr String
"file not readable"
                         else do
                              c <- IO ByteString -> IO (Either IOError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$
                                   do
                                   cb <- String -> IO ByteString
B.readFile String
fn
                                   if strictInput
                                      then B.length `seq` return cb
                                      else                return cb
                              return (either readErr Right c)
    where
    source' :: String
source' = String -> String
drivePath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
source
    readErr :: IOError -> Either ([(String, String)], String) b
readErr IOError
e
        = String -> Either ([(String, String)], String) b
forall {p} {b}.
Show p =>
p -> Either ([(String, String)], String) b
fileErr (IOError -> String
ioeGetErrorString IOError
e)
    fileErr :: p -> Either ([(String, String)], String) b
fileErr p
msg0
        = ([(String, String)], String)
-> Either ([(String, String)], String) b
forall a b. a -> Either a b
Left ( [ (String
transferStatus,  String
"999")
                 , (String
transferMessage, String
msg)
                 ]
               , String
msg
               )
          where
          msg :: String
msg = String
"file read error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
msg0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" when accessing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
source'

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

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

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

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