{-# LANGUAGE OverloadedStrings #-}

module System.Linux.Proc.IO
  ( listProcDirectory
  , readProcFile
  ) where

import           Control.Error (ExceptT, handleExceptT)

import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS

import           Data.Text (Text)
import qualified Data.Text as T

import           System.IO (IOMode (..), withFile)

import           System.Directory (getDirectoryContents)
import           System.Linux.Proc.Errors


readProcFile :: FilePath -> ExceptT ProcError IO ByteString
readProcFile :: FilePath -> ExceptT ProcError IO ByteString
readProcFile FilePath
fpath =
  (IOError -> ProcError)
-> IO ByteString -> ExceptT ProcError IO ByteString
forall e (m :: * -> *) x a.
(Exception e, Functor m, MonadCatch m) =>
(e -> x) -> m a -> ExceptT x m a
handleExceptT (FilePath -> Text -> ProcError
ProcReadError FilePath
fpath (Text -> ProcError) -> (IOError -> Text) -> IOError -> ProcError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Text
ioErrorToText) (IO ByteString -> ExceptT ProcError IO ByteString)
-> IO ByteString -> ExceptT ProcError IO ByteString
forall a b. (a -> b) -> a -> b
$
    -- BS.readFile won't work here because it tries to get the file
    -- length before reading the file and files in the /proc filesystem
    -- are reported as having zero length.
    FilePath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fpath IOMode
ReadMode Handle -> IO ByteString
BS.hGetContents

listProcDirectory :: FilePath -> ExceptT ProcError IO [FilePath]
listProcDirectory :: FilePath -> ExceptT ProcError IO [FilePath]
listProcDirectory FilePath
fpath =
  (IOError -> ProcError)
-> IO [FilePath] -> ExceptT ProcError IO [FilePath]
forall e (m :: * -> *) x a.
(Exception e, Functor m, MonadCatch m) =>
(e -> x) -> m a -> ExceptT x m a
handleExceptT (FilePath -> Text -> ProcError
ProcReadError FilePath
fpath (Text -> ProcError) -> (IOError -> Text) -> IOError -> ProcError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Text
ioErrorToText) (IO [FilePath] -> ExceptT ProcError IO [FilePath])
-> IO [FilePath] -> ExceptT ProcError IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
fpath

ioErrorToText :: IOError -> Text
ioErrorToText :: IOError -> Text
ioErrorToText = FilePath -> Text
T.pack (FilePath -> Text) -> (IOError -> FilePath) -> IOError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> FilePath
forall a. Show a => a -> FilePath
show