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

{- |
   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
      Either IOException ByteString
c <- IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try ( do
                 ByteString
cb <- IO ByteString
B.getContents
                 if Bool
strictInput
                    then ByteString -> Int64
B.length ByteString
cb Int64 -> IO ByteString -> IO ByteString
`seq` ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
cb
                    else                   ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
cb
               )
      Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IOException -> Either ([(String, String)], String) ByteString)
-> (ByteString -> Either ([(String, String)], String) ByteString)
-> Either IOException ByteString
-> Either ([(String, String)], String) ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> Either ([(String, String)], String) ByteString
forall b. IOException -> Either ([(String, String)], String) b
readErr ByteString -> Either ([(String, String)], String) ByteString
forall a b. b -> Either a b
Right Either IOException ByteString
c)
    where
    readErr :: IOException -> Either ([(String, String)], String) b
readErr IOException
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  = IOException -> String
ioeGetErrorString IOException
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
      Maybe String
source'' <- String -> IO (Maybe String)
checkFile String
source'
      case Maybe String
source'' of
           Maybe String
Nothing -> Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
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 a b. Show a => a -> 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 (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 a b. Show a => a -> Either ([(String, String)], String) b
fileErr String
"file not readable"
                         else do
                              Either IOException ByteString
c <- IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$
                                   do
                                   ByteString
cb <- String -> IO ByteString
B.readFile String
fn
                                   if Bool
strictInput
                                      then ByteString -> Int64
B.length (ByteString -> Int64) -> IO ByteString -> IO ByteString
`seq` ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
cb
                                      else                ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
cb
                              Either ([(String, String)], String) ByteString
-> IO (Either ([(String, String)], String) ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IOException -> Either ([(String, String)], String) ByteString)
-> (ByteString -> Either ([(String, String)], String) ByteString)
-> Either IOException ByteString
-> Either ([(String, String)], String) ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> Either ([(String, String)], String) ByteString
forall b. IOException -> Either ([(String, String)], String) b
readErr ByteString -> Either ([(String, String)], String) ByteString
forall a b. b -> Either a b
Right Either IOException ByteString
c)
    where
    source' :: String
source' = String -> String
drivePath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
source
    readErr :: IOException -> Either ([(String, String)], String) b
readErr IOException
e
        = String -> Either ([(String, String)], String) b
forall a b. Show a => a -> Either ([(String, String)], String) b
fileErr (IOException -> String
ioeGetErrorString IOException
e)
    fileErr :: a -> Either ([(String, String)], String) b
fileErr a
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]
++ a -> String
forall a. Show a => a -> String
show a
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A'..Char
'Z'] Bool -> Bool -> Bool
|| Char
d Char -> String -> 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
      Bool
exists <- String -> IO Bool
doesFileExist String
fn
      if Bool
exists
         then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
fn)
         else do
              Bool
exists' <- String -> IO Bool
doesFileExist String
fn'
              Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return ( if Bool
exists'
                       then String -> Maybe String
forall a. a -> Maybe a
Just String
fn'
                       else Maybe String
forall a. Maybe a
Nothing
                     )
    where
    fn' :: String
fn' = String -> String
unEscapeString String
fn

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