{-# LINE 1 "System/MountPoints.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
module System.MountPoints (
Mntent(..),
getMounts,
getProcMounts,
) where
import Control.Monad
import Control.Exception
import Data.Maybe
import Control.Applicative
import Foreign
import Foreign.C
import Prelude
data Mntent = Mntent
{ Mntent -> String
mnt_fsname :: String
, Mntent -> String
mnt_dir :: FilePath
, Mntent -> String
mnt_type :: String
} deriving (Int -> Mntent -> ShowS
[Mntent] -> ShowS
Mntent -> String
(Int -> Mntent -> ShowS)
-> (Mntent -> String) -> ([Mntent] -> ShowS) -> Show Mntent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mntent -> ShowS
showsPrec :: Int -> Mntent -> ShowS
$cshow :: Mntent -> String
show :: Mntent -> String
$cshowList :: [Mntent] -> ShowS
showList :: [Mntent] -> ShowS
Show, Mntent -> Mntent -> Bool
(Mntent -> Mntent -> Bool)
-> (Mntent -> Mntent -> Bool) -> Eq Mntent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mntent -> Mntent -> Bool
== :: Mntent -> Mntent -> Bool
$c/= :: Mntent -> Mntent -> Bool
/= :: Mntent -> Mntent -> Bool
Eq, Eq Mntent
Eq Mntent =>
(Mntent -> Mntent -> Ordering)
-> (Mntent -> Mntent -> Bool)
-> (Mntent -> Mntent -> Bool)
-> (Mntent -> Mntent -> Bool)
-> (Mntent -> Mntent -> Bool)
-> (Mntent -> Mntent -> Mntent)
-> (Mntent -> Mntent -> Mntent)
-> Ord Mntent
Mntent -> Mntent -> Bool
Mntent -> Mntent -> Ordering
Mntent -> Mntent -> Mntent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Mntent -> Mntent -> Ordering
compare :: Mntent -> Mntent -> Ordering
$c< :: Mntent -> Mntent -> Bool
< :: Mntent -> Mntent -> Bool
$c<= :: Mntent -> Mntent -> Bool
<= :: Mntent -> Mntent -> Bool
$c> :: Mntent -> Mntent -> Bool
> :: Mntent -> Mntent -> Bool
$c>= :: Mntent -> Mntent -> Bool
>= :: Mntent -> Mntent -> Bool
$cmax :: Mntent -> Mntent -> Mntent
max :: Mntent -> Mntent -> Mntent
$cmin :: Mntent -> Mntent -> Mntent
min :: Mntent -> Mntent -> Mntent
Ord)
getMounts :: IO [Mntent]
{-# LINE 39 "System/MountPoints.hsc" #-}
getMounts = do
h <- c_mounts_start
when (h == nullPtr) $
throwErrno "getMounts"
mntent <- getmntent h []
_ <- c_mounts_end h
return mntent
where
getmntent h c = do
ptr <- c_mounts_next h
if ptr == nullPtr
then return (reverse c)
else do
mnt_fsname_str <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr >>= peekCString
{-# LINE 53 "System/MountPoints.hsc" #-}
mnt_dir_str <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr >>= peekCString
{-# LINE 54 "System/MountPoints.hsc" #-}
mnt_type_str <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr >>= peekCString
{-# LINE 55 "System/MountPoints.hsc" #-}
let ent = Mntent
{ mnt_fsname = mnt_fsname_str
, mnt_dir = mnt_dir_str
, mnt_type = mnt_type_str
}
getmntent h (ent:c)
{-# LINE 64 "System/MountPoints.hsc" #-}
{-# LINE 66 "System/MountPoints.hsc" #-}
foreign import ccall unsafe "libmounts.h mounts_start" c_mounts_start
:: IO (Ptr ())
foreign import ccall unsafe "libmounts.h mounts_next" c_mounts_next
:: Ptr () -> IO (Ptr ())
foreign import ccall unsafe "libmounts.h mounts_end" c_mounts_end
:: Ptr () -> IO CInt
{-# LINE 77 "System/MountPoints.hsc" #-}
getProcMounts :: IO [Mntent]
getProcMounts :: IO [Mntent]
getProcMounts = do
Either SomeException [Mntent]
v <- IO [Mntent] -> IO (Either SomeException [Mntent])
forall e a. Exception e => IO a -> IO (Either e a)
try IO [Mntent]
go :: IO (Either SomeException [Mntent])
[Mntent] -> IO [Mntent]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SomeException -> [Mntent])
-> ([Mntent] -> [Mntent])
-> Either SomeException [Mntent]
-> [Mntent]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Mntent] -> SomeException -> [Mntent]
forall a b. a -> b -> a
const []) [Mntent] -> [Mntent]
forall a. a -> a
id Either SomeException [Mntent]
v)
where
go :: IO [Mntent]
go = (String -> Maybe Mntent) -> [String] -> [Mntent]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([String] -> Maybe Mntent
parse ([String] -> Maybe Mntent)
-> (String -> [String]) -> String -> Maybe Mntent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [Mntent])
-> (String -> [String]) -> String -> [Mntent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [Mntent]) -> IO String -> IO [Mntent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
"/proc/mounts"
parse :: [String] -> Maybe Mntent
parse (String
device:String
mountpoint:String
fstype:[String]
_rest) = Mntent -> Maybe Mntent
forall a. a -> Maybe a
Just (Mntent -> Maybe Mntent) -> Mntent -> Maybe Mntent
forall a b. (a -> b) -> a -> b
$ Mntent
{ mnt_fsname :: String
mnt_fsname = String
device
, mnt_dir :: String
mnt_dir = String
mountpoint
, mnt_type :: String
mnt_type = String
fstype
}
parse [String]
_ = Maybe Mntent
forall a. Maybe a
Nothing