{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances #-}
-- | Construct an ADT representing block and character devices
-- (but mostly block devices) by interpreting the contents of
-- the Linux sysfs filesystem.
module System.Unix.SpecialDevice
    (SpecialDevice,
     sysMountPoint,     -- IO String
     ofNode,            -- FilePath -> IO (Maybe SpecialDevice)
     ofNodeStatus,      -- FileStatus -> Maybe SpecialDevice
     ofPath,            -- FilePath -> IO (Maybe SpecialDevice)
     rootPart,          -- IO (Maybe SpecialDevice)
     ofDevNo,           -- (DeviceID -> SpecialDevice) -> Int -> SpecialDevice
     ofSysName,         -- String -> IO (Maybe SpecialDevice)
     ofSysPath,         -- (DeviceID -> SpecialDevice) -> FilePath -> IO (Maybe SpecialDevice)
     toDevno,           -- SpecialDevice -> Int
     --major,           -- SpecialDevice -> Int
     --minor,           -- SpecialDevice -> Int
     ofMajorMinor,      -- (DeviceID -> SpecialDevice) -> Int -> Int -> SpecialDevice
     node,              -- SpecialDevice -> IO (Maybe FilePath)
     nodes,             -- SpecialDevice -> IO [FilePath]
     sysName,           -- SpecialDevice -> IO (Maybe String)
     splitPart,         -- String -> (String, Int)
     sysDir,            -- SpecialDevice -> IO (Maybe FilePath)
     diskOfPart,        -- SpecialDevice -> IO (Maybe SpecialDevice)
     getAllDisks,       -- IO [SpecialDevice]
     getAllPartitions,  -- IO [SpecialDevice]
     getAllCdroms,      -- IO [SpecialDevice]
     getAllRemovable,   -- IO [SpecialDevice]
--     toDevName,
--     getBlkidAlist,
--     getBlkidInfo,
--     deviceOfUuid,
--     devicesOfLabel,
--     updateBlkidFns,
--     update
    )
    where

import Control.Exception
import System.IO
import System.Directory
import Data.Char
import Data.List
import Data.Maybe
import System.FilePath
import System.Posix.Types
import System.Posix.Files
import System.Posix.User
import Text.Regex.TDFA

data SpecialDevice =
    BlockDevice DeviceID | CharacterDevice DeviceID
    deriving (Int -> SpecialDevice -> ShowS
[SpecialDevice] -> ShowS
SpecialDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecialDevice] -> ShowS
$cshowList :: [SpecialDevice] -> ShowS
show :: SpecialDevice -> String
$cshow :: SpecialDevice -> String
showsPrec :: Int -> SpecialDevice -> ShowS
$cshowsPrec :: Int -> SpecialDevice -> ShowS
Show, Eq SpecialDevice
SpecialDevice -> SpecialDevice -> Bool
SpecialDevice -> SpecialDevice -> Ordering
SpecialDevice -> SpecialDevice -> SpecialDevice
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
min :: SpecialDevice -> SpecialDevice -> SpecialDevice
$cmin :: SpecialDevice -> SpecialDevice -> SpecialDevice
max :: SpecialDevice -> SpecialDevice -> SpecialDevice
$cmax :: SpecialDevice -> SpecialDevice -> SpecialDevice
>= :: SpecialDevice -> SpecialDevice -> Bool
$c>= :: SpecialDevice -> SpecialDevice -> Bool
> :: SpecialDevice -> SpecialDevice -> Bool
$c> :: SpecialDevice -> SpecialDevice -> Bool
<= :: SpecialDevice -> SpecialDevice -> Bool
$c<= :: SpecialDevice -> SpecialDevice -> Bool
< :: SpecialDevice -> SpecialDevice -> Bool
$c< :: SpecialDevice -> SpecialDevice -> Bool
compare :: SpecialDevice -> SpecialDevice -> Ordering
$ccompare :: SpecialDevice -> SpecialDevice -> Ordering
Ord, SpecialDevice -> SpecialDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecialDevice -> SpecialDevice -> Bool
$c/= :: SpecialDevice -> SpecialDevice -> Bool
== :: SpecialDevice -> SpecialDevice -> Bool
$c== :: SpecialDevice -> SpecialDevice -> Bool
Eq)

-- | FIXME: We should really get this value from the mount table.
sysMountPoint :: FilePath
sysMountPoint :: String
sysMountPoint = String
"/sys"

ofPath :: FilePath -> IO (Maybe SpecialDevice)
ofPath :: String -> IO (Maybe SpecialDevice)
ofPath String
path =
    -- Catch the exception thrown on an invalid symlink
    (forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceID -> SpecialDevice
BlockDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
deviceID)

rootPart :: IO (Maybe SpecialDevice)
rootPart :: IO (Maybe SpecialDevice)
rootPart = String -> IO (Maybe SpecialDevice)
ofPath String
"/"

-- | Return the device represented by a device node, such as \/dev\/sda2.
-- Returns Nothing if there is an exception trying to stat the node, or
-- if the node turns out not to be a special device.
ofNode :: FilePath -> IO (Maybe SpecialDevice)
ofNode :: String -> IO (Maybe SpecialDevice)
ofNode String
"/dev/root" = String -> IO (Maybe SpecialDevice)
ofPath String
"/"
ofNode String
node = (forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
node) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> forall a. Maybe a
Nothing) FileStatus -> Maybe SpecialDevice
ofNodeStatus

ofNodeStatus :: FileStatus -> Maybe SpecialDevice
ofNodeStatus :: FileStatus -> Maybe SpecialDevice
ofNodeStatus FileStatus
status =
    if FileStatus -> Bool
isBlockDevice FileStatus
status then
        (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceID -> SpecialDevice
BlockDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
specialDeviceID forall a b. (a -> b) -> a -> b
$ FileStatus
status) else
        if FileStatus -> Bool
isCharacterDevice FileStatus
status then
            (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceID -> SpecialDevice
CharacterDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
specialDeviceID forall a b. (a -> b) -> a -> b
$ FileStatus
status) else
            forall a. Maybe a
Nothing

ofSysName :: String -> IO (Maybe SpecialDevice)
ofSysName :: String -> IO (Maybe SpecialDevice)
ofSysName String
name =
    do
      [String]
paths <- Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
False (String
sysMountPoint forall a. [a] -> [a] -> [a]
++ String
"/block") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (String, b) -> Bool
isDev
      case forall a. (a -> Bool) -> [a] -> [a]
filter (\ String
x -> ShowS
basename (ShowS
dirname String
x) forall a. Eq a => a -> a -> Bool
== String
name) [String]
paths of
        [String
path] -> (DeviceID -> SpecialDevice) -> String -> IO (Maybe SpecialDevice)
ofSysPath DeviceID -> SpecialDevice
BlockDevice (ShowS
dirname String
path)
    where
      isDev :: (String, b) -> Bool
isDev (String
path, b
status) = ShowS
basename String
path forall a. Eq a => a -> a -> Bool
== String
"dev"

ofSysPath :: (DeviceID -> SpecialDevice) -> FilePath -> IO (Maybe SpecialDevice)
ofSysPath :: (DeviceID -> SpecialDevice) -> String -> IO (Maybe SpecialDevice)
ofSysPath DeviceID -> SpecialDevice
typ String
path = String -> IO String
readFile (String
path forall a. [a] -> [a] -> [a]
++ String
"/dev") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceID -> SpecialDevice) -> String -> Maybe SpecialDevice
parseSysDevFile DeviceID -> SpecialDevice
typ

parseSysDevFile :: (DeviceID -> SpecialDevice) -> String -> Maybe SpecialDevice
parseSysDevFile :: (DeviceID -> SpecialDevice) -> String -> Maybe SpecialDevice
parseSysDevFile DeviceID -> SpecialDevice
typ String
text =
    case forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\ Char
a Char
b -> Char -> Bool
isDigit Char
a Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
b) forall a b. (a -> b) -> a -> b
$ String
text of
      [String
major, String
minor] -> forall a. a -> Maybe a
Just ((DeviceID -> SpecialDevice) -> Int -> Int -> SpecialDevice
ofMajorMinor DeviceID -> SpecialDevice
typ (forall a. Read a => String -> a
read String
major) (forall a. Read a => String -> a
read String
minor))
      [String]
_ -> forall a. Maybe a
Nothing

ofMajorMinor :: (DeviceID -> SpecialDevice) -> Int -> Int -> SpecialDevice
ofMajorMinor :: (DeviceID -> SpecialDevice) -> Int -> Int -> SpecialDevice
ofMajorMinor DeviceID -> SpecialDevice
typ Int
major Int
minor = (DeviceID -> SpecialDevice) -> Int -> SpecialDevice
ofDevNo DeviceID -> SpecialDevice
typ forall a b. (a -> b) -> a -> b
$ Int
major forall a. Num a => a -> a -> a
* Int
256 forall a. Num a => a -> a -> a
+ Int
minor

ofDevNo :: (DeviceID -> SpecialDevice) -> Int -> SpecialDevice
ofDevNo :: (DeviceID -> SpecialDevice) -> Int -> SpecialDevice
ofDevNo DeviceID -> SpecialDevice
typ Int
n = DeviceID -> SpecialDevice
typ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Int
n

{-
major :: SpecialDevice -> Integer
major dev = toInteger (toDevno dev)
minor :: SpecialDevice -> Int
minor dev = mod (fromInteger (toInteger (toDevno dev))) 256
-}
toDevno :: SpecialDevice -> DeviceID
toDevno :: SpecialDevice -> DeviceID
toDevno (BlockDevice DeviceID
n) = DeviceID
n
toDevno (CharacterDevice DeviceID
n) = DeviceID
n

node :: SpecialDevice -> IO (Maybe FilePath)
node :: SpecialDevice -> IO (Maybe String)
node dev :: SpecialDevice
dev@(BlockDevice DeviceID
_) = SpecialDevice -> IO [String]
nodes SpecialDevice
dev forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe

nodes :: SpecialDevice -> IO [FilePath]
nodes :: SpecialDevice -> IO [String]
nodes dev :: SpecialDevice
dev@(BlockDevice DeviceID
_) =
    do
      [(String, FileStatus)]
pairs <- Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
True String
"/dev" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
               forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"/dev/.static/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                             forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"/dev/.udevdb/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
      let pairs' :: [(String, FileStatus)]
pairs' = forall a. (a -> Bool) -> [a] -> [a]
filter (\ (String
node, FileStatus
status) -> (FileStatus -> Maybe SpecialDevice
ofNodeStatus FileStatus
status) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just SpecialDevice
dev) [(String, FileStatus)]
pairs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [(String, FileStatus)]
pairs'
    where
      mapSnd :: (t -> b) -> (a, t) -> (a, b)
mapSnd t -> b
f (a
a, t
b) = (a
a, t -> b
f t
b)

splitPart :: String -> (String, Int)
splitPart :: String -> (String, Int)
splitPart String
name =
    forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
mapSnd forall a. Read a => String -> a
read (forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDigit String
name)
    where mapSnd :: (t -> b) -> (a, t) -> (a, b)
mapSnd t -> b
f (a
a, t
b) = (a
a, t -> b
f t
b)

diskOfPart :: SpecialDevice -> IO (Maybe SpecialDevice)
diskOfPart :: SpecialDevice -> IO (Maybe SpecialDevice)
diskOfPart SpecialDevice
part =
    SpecialDevice -> IO (Maybe String)
sysName SpecialDevice
part forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, Int)
splitPart) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) String -> IO (Maybe SpecialDevice)
ofSysName

sysName :: SpecialDevice -> IO (Maybe String)
sysName :: SpecialDevice -> IO (Maybe String)
sysName SpecialDevice
dev = SpecialDevice -> IO (Maybe String)
sysDir SpecialDevice
dev forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
basename)

sysDir :: SpecialDevice -> IO (Maybe FilePath)
sysDir :: SpecialDevice -> IO (Maybe String)
sysDir dev :: SpecialDevice
dev@(BlockDevice DeviceID
_) =
    do
      ([(String, FileStatus)]
pairs' :: [(FilePath, FileStatus)]) <- Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
False (String
sysMountPoint forall a. [a] -> [a] -> [a]
++ String
"/block")
      let ([String]
paths :: [FilePath]) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (String, b) -> Bool
isDev forall a b. (a -> b) -> a -> b
$ [(String, FileStatus)]
pairs'
      [Maybe SpecialDevice]
devs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
readFile [String]
paths forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((DeviceID -> SpecialDevice) -> String -> Maybe SpecialDevice
parseSysDevFile DeviceID -> SpecialDevice
BlockDevice)
      let pairs :: [(Maybe SpecialDevice, String)]
pairs = forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe SpecialDevice]
devs (forall a b. (a -> b) -> [a] -> [b]
map ShowS
dirname [String]
paths)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. a -> Maybe a
Just SpecialDevice
dev) forall a b. (a -> b) -> a -> b
$ [(Maybe SpecialDevice, String)]
pairs
    where
      isDev :: (String, b) -> Bool
isDev (String
path, b
status) = ShowS
basename String
path forall a. Eq a => a -> a -> Bool
== String
"dev"

diskGroup :: IO GroupID
diskGroup :: IO GroupID
diskGroup = String -> IO GroupEntry
getGroupEntryForName String
"disk" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupEntry -> GroupID
groupID

cdromGroup :: IO GroupID
cdromGroup :: IO GroupID
cdromGroup = String -> IO GroupEntry
getGroupEntryForName String
"cdrom" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupEntry -> GroupID
groupID

-- | Removable devices, such as USB keys, are in this group.
floppyGroup :: IO GroupID
floppyGroup :: IO GroupID
floppyGroup = String -> IO GroupEntry
getGroupEntryForName String
"floppy" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupEntry -> GroupID
groupID

getDisksInGroup :: GroupID -> IO [SpecialDevice]
getDisksInGroup :: GroupID -> IO [SpecialDevice]
getDisksInGroup GroupID
group =
    Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
True String
"/dev/disk/by-path" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a}. GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (FileStatus -> Maybe SpecialDevice
ofNodeStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    where
      inGroup :: GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group (a
_, FileStatus
status) = FileStatus -> GroupID
fileGroup FileStatus
status forall a. Eq a => a -> a -> Bool
== GroupID
group

getAllDisks :: IO [SpecialDevice]
getAllDisks :: IO [SpecialDevice]
getAllDisks =
    do
      GroupID
group <- IO GroupID
diskGroup
      [Maybe SpecialDevice]
devs <- Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
True String
"/dev/disk/by-path" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> Bool
isPart) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a}. GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (FileStatus -> Maybe SpecialDevice
ofNodeStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Maybe a] -> [a]
catMaybes [Maybe SpecialDevice]
devs)
    where
      inGroup :: GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group (a
_, FileStatus
status) = FileStatus -> GroupID
fileGroup FileStatus
status forall a. Eq a => a -> a -> Bool
== GroupID
group

getAllPartitions :: IO [SpecialDevice]
getAllPartitions :: IO [SpecialDevice]
getAllPartitions =
    Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
True String
"/dev/disk/by-path" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (String, FileStatus) -> Bool
isPart forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (FileStatus -> Maybe SpecialDevice
ofNodeStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

isPart :: (FilePath, FileStatus) -> Bool
isPart :: (String, FileStatus) -> Bool
isPart (String
path, FileStatus
_) =
    case String
path forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"-part[0-9]+$" of
      MatchResult String
x | forall a. MatchResult a -> a
mrMatch MatchResult String
x forall a. Eq a => a -> a -> Bool
== String
"" -> Bool
False
      MatchResult String
x -> Bool
True

getAllCdroms :: IO [SpecialDevice]
getAllCdroms :: IO [SpecialDevice]
getAllCdroms = IO GroupID
cdromGroup forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GroupID -> IO [SpecialDevice]
getDisksInGroup

getAllRemovable :: IO [SpecialDevice]
getAllRemovable :: IO [SpecialDevice]
getAllRemovable = IO GroupID
floppyGroup forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GroupID -> IO [SpecialDevice]
getDisksInGroup

-- ofNode "/dev/sda1" >>= maybe (return Nothing) sysDir >>= putStrLn . show
-- -> Just "/sys/block/sda/sda1/dev"

-- | Traverse a directory and return a list of all the (path,
-- fileStatus) pairs.
directory_find :: Bool -> FilePath -> IO [(FilePath, FileStatus)]
directory_find :: Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
follow String
path =
    if Bool
follow then IO [(String, FileStatus)]
fileStatus else IO [(String, FileStatus)]
linkStatus
    where
      fileStatus :: IO [(String, FileStatus)]
fileStatus = forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO FileStatus
getFileStatus String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return []) FileStatus -> IO [(String, FileStatus)]
useStatus
      linkStatus :: IO [(String, FileStatus)]
linkStatus = String -> IO FileStatus
getSymbolicLinkStatus String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FileStatus -> IO [(String, FileStatus)]
useStatus
      useStatus :: FileStatus -> IO [(String, FileStatus)]
useStatus FileStatus
status
          | FileStatus -> Bool
isDirectory FileStatus
status =
              do -- Catch the exception thrown if we lack read permission
                 [(String, FileStatus)]
subs <- (forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> []) forall a. a -> a
id forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
path String -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String
".", String
".."]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> String -> IO [(String, FileStatus)]
directory_find Bool
follow) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String
path, FileStatus
status) forall a. a -> [a] -> [a]
: [(String, FileStatus)]
subs
          | Bool
True = forall (m :: * -> *) a. Monad m => a -> m a
return [(String
path, FileStatus
status)]

dirname :: ShowS
dirname String
path = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String
path
basename :: ShowS
basename String
path = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String
path