module Python.Objects.File (
PyFile,
mkPyFile,
fromPyFile,
openPyFile,
pyfwrap,
openModeConv
)
where
import Python.Objects ( PyObject(..)
, callMethodHs
, fromPyObject
, getattr
, hasattr
, noKwParms
, noParms
, runMethodHs
, showPyObject
, toPyObject
)
import Python.Interpreter (callByName)
import System.IO (IOMode(..), SeekMode(..))
import System.IO.Error (eofErrorType)
import System.IO.Unsafe (unsafeInterleaveIO)
import Python.Exceptions (catchPy, exc2ioerror)
import System.IO.HVIO (HVIO(..))
import Foreign.C.Types (CInt, CLong)
newtype PyFile = PyFile PyObject
mkPyFile :: PyObject -> PyFile
mkPyFile o = PyFile o
fromPyFile :: PyFile -> PyObject
fromPyFile (PyFile o) = o
openModeConv ReadMode = "r"
openModeConv WriteMode = "w"
openModeConv AppendMode = "a"
openModeConv ReadWriteMode = "w+"
openPyFile :: FilePath -> IOMode -> IO PyFile
openPyFile fp mode =
do parms1 <- toPyObject [fp]
parms2 <- toPyObject [openModeConv mode]
obj <- callByName "open" [parms1, parms2] []
return $ mkPyFile obj
instance Show PyFile where
show _ = "<Python File Object>"
pyfwrap :: PyFile -> (PyObject -> IO a) -> IO a
pyfwrap (PyFile pyobj) func = catchPy (func pyobj) exc2ioerror
raiseEOF :: PyFile -> IO a
raiseEOF h = vThrow h eofErrorType
instance HVIO PyFile where
vClose pyf = pyfwrap pyf (\pyo -> runMethodHs pyo "close" noParms noKwParms)
vIsClosed pyf = pyfwrap pyf (\pyo ->
do h <- hasattr pyo "closed"
if h then
do v <- (getattr pyo "closed" >>= fromPyObject)::IO CInt
if v == 0
then return False
else return True
else return False
)
vGetContents pyf = do vTestOpen pyf
vTestEOF pyf
pyfwrap pyf (\pyo ->
let loop = unsafeInterleaveIO $
do block <- callMethodHs pyo "read"
[4096::CLong] noKwParms
case block of
[] -> do vClose pyf
return []
x -> do next <- loop
return $ x : next
in do c <- loop
return $ concat c
)
vIsEOF pyf = return False
vShow pyf = pyfwrap pyf showPyObject
vGetChar pyf = do vTestOpen pyf
pyfwrap pyf (\pyo ->
do c <- callMethodHs pyo "read" [1::CInt] noKwParms
case c of
[] -> raiseEOF pyf
[x] -> return x
)
vGetLine pyf = do vTestOpen pyf
pyfwrap pyf (\pyo ->
do line <- callMethodHs pyo "readline" noParms noKwParms
case reverse line of
[] -> raiseEOF pyf
'\n':xs -> return $ reverse xs
x -> return line
)
vPutChar pyf c = vPutStr pyf [c]
vPutStr pyf [] = vTestOpen pyf >> return ()
vPutStr pyf s = let (this, next) = (splitAt 4096 s)::(String, String)
in do vTestOpen pyf
pyfwrap pyf (\pyo ->
runMethodHs pyo "write" [this] noKwParms)
vPutStr pyf next
vFlush pyf = pyfwrap pyf (\pyo ->
do vTestOpen pyf
h <- hasattr pyo "flush"
if h then runMethodHs pyo "flush" noParms noKwParms
else return ()
)
vSeek pyf sm offset =
let seekint = case sm of
AbsoluteSeek -> 0::CLong
RelativeSeek -> 1
SeekFromEnd -> 2
in do vTestOpen pyf
pyfwrap pyf (\pyo ->
case sm of
AbsoluteSeek -> runMethodHs pyo "seek"
[(fromIntegral offset)::CLong]
noKwParms
_ -> runMethodHs pyo "seek" [(fromIntegral offset),
seekint] noKwParms
)
vTell pyf = pyfwrap pyf (\pyo ->
vTestOpen pyf >> callMethodHs pyo "tell" noParms noKwParms)
vIsSeekable _ = return True
vIsWritable _ = return True
vIsReadable _ = return True