{-# 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
(Int -> SpecialDevice -> ShowS)
-> (SpecialDevice -> String)
-> ([SpecialDevice] -> ShowS)
-> Show SpecialDevice
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
Eq SpecialDevice
-> (SpecialDevice -> SpecialDevice -> Ordering)
-> (SpecialDevice -> SpecialDevice -> Bool)
-> (SpecialDevice -> SpecialDevice -> Bool)
-> (SpecialDevice -> SpecialDevice -> Bool)
-> (SpecialDevice -> SpecialDevice -> Bool)
-> (SpecialDevice -> SpecialDevice -> SpecialDevice)
-> (SpecialDevice -> SpecialDevice -> SpecialDevice)
-> Ord 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
$cp1Ord :: Eq SpecialDevice
Ord, SpecialDevice -> SpecialDevice -> Bool
(SpecialDevice -> SpecialDevice -> Bool)
-> (SpecialDevice -> SpecialDevice -> Bool) -> Eq SpecialDevice
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
    (IO FileStatus -> IO (Either SomeException FileStatus)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO FileStatus -> IO (Either SomeException FileStatus))
-> IO FileStatus -> IO (Either SomeException FileStatus)
forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
path) IO (Either SomeException FileStatus)
-> (Either SomeException FileStatus -> IO (Maybe SpecialDevice))
-> IO (Maybe SpecialDevice)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Maybe SpecialDevice -> IO (Maybe SpecialDevice)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SpecialDevice -> IO (Maybe SpecialDevice))
-> (Either SomeException FileStatus -> Maybe SpecialDevice)
-> Either SomeException FileStatus
-> IO (Maybe SpecialDevice)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> Maybe SpecialDevice)
-> (FileStatus -> Maybe SpecialDevice)
-> Either SomeException FileStatus
-> Maybe SpecialDevice
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> Maybe SpecialDevice
forall a. Maybe a
Nothing) (SpecialDevice -> Maybe SpecialDevice
forall a. a -> Maybe a
Just (SpecialDevice -> Maybe SpecialDevice)
-> (FileStatus -> SpecialDevice)
-> FileStatus
-> Maybe SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceID -> SpecialDevice
BlockDevice (DeviceID -> SpecialDevice)
-> (FileStatus -> DeviceID) -> FileStatus -> SpecialDevice
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 = (IO FileStatus -> IO (Either SomeException FileStatus)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO FileStatus -> IO (Either SomeException FileStatus))
-> IO FileStatus -> IO (Either SomeException FileStatus)
forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
node) IO (Either SomeException FileStatus)
-> (Either SomeException FileStatus -> IO (Maybe SpecialDevice))
-> IO (Maybe SpecialDevice)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe SpecialDevice -> IO (Maybe SpecialDevice)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SpecialDevice -> IO (Maybe SpecialDevice))
-> (Either SomeException FileStatus -> Maybe SpecialDevice)
-> Either SomeException FileStatus
-> IO (Maybe SpecialDevice)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> Maybe SpecialDevice)
-> (FileStatus -> Maybe SpecialDevice)
-> Either SomeException FileStatus
-> Maybe SpecialDevice
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> Maybe SpecialDevice
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
        (SpecialDevice -> Maybe SpecialDevice
forall a. a -> Maybe a
Just (SpecialDevice -> Maybe SpecialDevice)
-> (FileStatus -> SpecialDevice)
-> FileStatus
-> Maybe SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceID -> SpecialDevice
BlockDevice (DeviceID -> SpecialDevice)
-> (FileStatus -> DeviceID) -> FileStatus -> SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
specialDeviceID (FileStatus -> Maybe SpecialDevice)
-> FileStatus -> Maybe SpecialDevice
forall a b. (a -> b) -> a -> b
$ FileStatus
status) else
        if FileStatus -> Bool
isCharacterDevice FileStatus
status then
            (SpecialDevice -> Maybe SpecialDevice
forall a. a -> Maybe a
Just (SpecialDevice -> Maybe SpecialDevice)
-> (FileStatus -> SpecialDevice)
-> FileStatus
-> Maybe SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceID -> SpecialDevice
CharacterDevice (DeviceID -> SpecialDevice)
-> (FileStatus -> DeviceID) -> FileStatus -> SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
specialDeviceID (FileStatus -> Maybe SpecialDevice)
-> FileStatus -> Maybe SpecialDevice
forall a b. (a -> b) -> a -> b
$ FileStatus
status) else
            Maybe SpecialDevice
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/block") IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([(String, FileStatus)] -> [String])
-> [(String, FileStatus)]
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> String)
-> [(String, FileStatus)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileStatus) -> String
forall a b. (a, b) -> a
fst ([(String, FileStatus)] -> [String])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, FileStatus) -> Bool
forall b. (String, b) -> Bool
isDev
      case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ String
x -> ShowS
basename (ShowS
dirname String
x) String -> String -> Bool
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 String -> String -> Bool
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/dev") IO String
-> (String -> IO (Maybe SpecialDevice)) -> IO (Maybe SpecialDevice)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe SpecialDevice -> IO (Maybe SpecialDevice)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SpecialDevice -> IO (Maybe SpecialDevice))
-> (String -> Maybe SpecialDevice)
-> String
-> IO (Maybe SpecialDevice)
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 (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> String -> [String]
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) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
text of
      [String
major, String
minor] -> SpecialDevice -> Maybe SpecialDevice
forall a. a -> Maybe a
Just ((DeviceID -> SpecialDevice) -> Int -> Int -> SpecialDevice
ofMajorMinor DeviceID -> SpecialDevice
typ (String -> Int
forall a. Read a => String -> a
read String
major) (String -> Int
forall a. Read a => String -> a
read String
minor))
      [String]
_ -> Maybe SpecialDevice
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 (Int -> SpecialDevice) -> Int -> SpecialDevice
forall a b. (a -> b) -> a -> b
$ Int
major Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
256 Int -> Int -> Int
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 (DeviceID -> SpecialDevice)
-> (Int -> DeviceID) -> Int -> SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DeviceID
forall a. Num a => Integer -> a
fromInteger (Integer -> DeviceID) -> (Int -> Integer) -> Int -> DeviceID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> SpecialDevice) -> Int -> SpecialDevice
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 IO [String] -> ([String] -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> ([String] -> Maybe String) -> [String] -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe String
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" IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
               [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> IO [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, FileStatus) -> Bool) -> (String, FileStatus) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"/dev/.static/" (String -> Bool)
-> ((String, FileStatus) -> String) -> (String, FileStatus) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> String
forall a b. (a, b) -> a
fst) ([(String, FileStatus)] -> [(String, FileStatus)])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                             ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, FileStatus) -> Bool) -> (String, FileStatus) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"/dev/.udevdb/" (String -> Bool)
-> ((String, FileStatus) -> String) -> (String, FileStatus) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> String
forall a b. (a, b) -> a
fst)
      let pairs' :: [(String, FileStatus)]
pairs' = ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (String
node, FileStatus
status) -> (FileStatus -> Maybe SpecialDevice
ofNodeStatus FileStatus
status) Maybe SpecialDevice -> Maybe SpecialDevice -> Bool
forall a. Eq a => a -> a -> Bool
== SpecialDevice -> Maybe SpecialDevice
forall a. a -> Maybe a
Just SpecialDevice
dev) [(String, FileStatus)]
pairs
      [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([(String, FileStatus)] -> [String])
-> [(String, FileStatus)]
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> String)
-> [(String, FileStatus)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileStatus) -> String
forall a b. (a, b) -> a
fst ([(String, FileStatus)] -> IO [String])
-> [(String, FileStatus)] -> IO [String]
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 =
    (String -> Int) -> (String, String) -> (String, Int)
forall t b a. (t -> b) -> (a, t) -> (a, b)
mapSnd String -> Int
forall a. Read a => String -> a
read ((Char -> Bool) -> String -> (String, String)
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 IO (Maybe String)
-> (Maybe String -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (Maybe String -> Maybe String)
-> Maybe String
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> (String -> Maybe String) -> Maybe String -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> String
forall a b. (a, b) -> a
fst ((String, Int) -> String) -> (String -> (String, Int)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, Int)
splitPart) IO (Maybe String)
-> (Maybe String -> IO (Maybe SpecialDevice))
-> IO (Maybe SpecialDevice)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    IO (Maybe SpecialDevice)
-> (String -> IO (Maybe SpecialDevice))
-> Maybe String
-> IO (Maybe SpecialDevice)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe SpecialDevice -> IO (Maybe SpecialDevice)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SpecialDevice
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 IO (Maybe String)
-> (Maybe String -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (Maybe String -> Maybe String)
-> Maybe String
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> (String -> Maybe String) -> Maybe String -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/block")
      let ([String]
paths :: [FilePath]) = ((String, FileStatus) -> String)
-> [(String, FileStatus)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileStatus) -> String
forall a b. (a, b) -> a
fst ([(String, FileStatus)] -> [String])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, FileStatus) -> Bool
forall b. (String, b) -> Bool
isDev ([(String, FileStatus)] -> [String])
-> [(String, FileStatus)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, FileStatus)]
pairs'
      [Maybe SpecialDevice]
devs <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
readFile [String]
paths IO [String]
-> ([String] -> IO [Maybe SpecialDevice])
-> IO [Maybe SpecialDevice]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Maybe SpecialDevice] -> IO [Maybe SpecialDevice]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe SpecialDevice] -> IO [Maybe SpecialDevice])
-> ([String] -> [Maybe SpecialDevice])
-> [String]
-> IO [Maybe SpecialDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe SpecialDevice)
-> [String] -> [Maybe SpecialDevice]
forall a b. (a -> b) -> [a] -> [b]
map ((DeviceID -> SpecialDevice) -> String -> Maybe SpecialDevice
parseSysDevFile DeviceID -> SpecialDevice
BlockDevice)
      let pairs :: [(Maybe SpecialDevice, String)]
pairs = [Maybe SpecialDevice]
-> [String] -> [(Maybe SpecialDevice, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe SpecialDevice]
devs (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
dirname [String]
paths)
      Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> ([(Maybe SpecialDevice, String)] -> Maybe String)
-> [(Maybe SpecialDevice, String)]
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SpecialDevice
-> [(Maybe SpecialDevice, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (SpecialDevice -> Maybe SpecialDevice
forall a. a -> Maybe a
Just SpecialDevice
dev) ([(Maybe SpecialDevice, String)] -> IO (Maybe String))
-> [(Maybe SpecialDevice, String)] -> IO (Maybe String)
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dev"

diskGroup :: IO GroupID
diskGroup :: IO GroupID
diskGroup = String -> IO GroupEntry
getGroupEntryForName String
"disk" IO GroupEntry -> (GroupEntry -> IO GroupID) -> IO GroupID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GroupID -> IO GroupID
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupID -> IO GroupID)
-> (GroupEntry -> GroupID) -> GroupEntry -> IO GroupID
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" IO GroupEntry -> (GroupEntry -> IO GroupID) -> IO GroupID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GroupID -> IO GroupID
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupID -> IO GroupID)
-> (GroupEntry -> GroupID) -> GroupEntry -> IO GroupID
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" IO GroupEntry -> (GroupEntry -> IO GroupID) -> IO GroupID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GroupID -> IO GroupID
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupID -> IO GroupID)
-> (GroupEntry -> GroupID) -> GroupEntry -> IO GroupID
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" IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> IO [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (GroupID -> (String, FileStatus) -> Bool
forall a. GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group) IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [SpecialDevice])
-> IO [SpecialDevice]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    [SpecialDevice] -> IO [SpecialDevice]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SpecialDevice] -> IO [SpecialDevice])
-> ([(String, FileStatus)] -> [SpecialDevice])
-> [(String, FileStatus)]
-> IO [SpecialDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe SpecialDevice] -> [SpecialDevice]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SpecialDevice] -> [SpecialDevice])
-> ([(String, FileStatus)] -> [Maybe SpecialDevice])
-> [(String, FileStatus)]
-> [SpecialDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Maybe SpecialDevice)
-> [(String, FileStatus)] -> [Maybe SpecialDevice]
forall a b. (a -> b) -> [a] -> [b]
map (FileStatus -> Maybe SpecialDevice
ofNodeStatus (FileStatus -> Maybe SpecialDevice)
-> ((String, FileStatus) -> FileStatus)
-> (String, FileStatus)
-> Maybe SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> FileStatus
forall a b. (a, b) -> b
snd)
    where
      inGroup :: GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group (a
_, FileStatus
status) = FileStatus -> GroupID
fileGroup FileStatus
status GroupID -> GroupID -> Bool
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" IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> IO [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, FileStatus) -> Bool) -> (String, FileStatus) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> Bool
isPart) ([(String, FileStatus)] -> [(String, FileStatus)])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (GroupID -> (String, FileStatus) -> Bool
forall a. GroupID -> (a, FileStatus) -> Bool
inGroup GroupID
group) IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [Maybe SpecialDevice])
-> IO [Maybe SpecialDevice]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              [Maybe SpecialDevice] -> IO [Maybe SpecialDevice]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe SpecialDevice] -> IO [Maybe SpecialDevice])
-> ([(String, FileStatus)] -> [Maybe SpecialDevice])
-> [(String, FileStatus)]
-> IO [Maybe SpecialDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Maybe SpecialDevice)
-> [(String, FileStatus)] -> [Maybe SpecialDevice]
forall a b. (a -> b) -> [a] -> [b]
map (FileStatus -> Maybe SpecialDevice
ofNodeStatus (FileStatus -> Maybe SpecialDevice)
-> ((String, FileStatus) -> FileStatus)
-> (String, FileStatus)
-> Maybe SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> FileStatus
forall a b. (a, b) -> b
snd)
      [SpecialDevice] -> IO [SpecialDevice]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe SpecialDevice] -> [SpecialDevice]
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 GroupID -> GroupID -> Bool
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" IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> ([(String, FileStatus)] -> [(String, FileStatus)])
-> [(String, FileStatus)]
-> IO [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Bool)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, FileStatus) -> Bool
isPart IO [(String, FileStatus)]
-> ([(String, FileStatus)] -> IO [SpecialDevice])
-> IO [SpecialDevice]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SpecialDevice] -> IO [SpecialDevice]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SpecialDevice] -> IO [SpecialDevice])
-> ([(String, FileStatus)] -> [SpecialDevice])
-> [(String, FileStatus)]
-> IO [SpecialDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe SpecialDevice] -> [SpecialDevice]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SpecialDevice] -> [SpecialDevice])
-> ([(String, FileStatus)] -> [Maybe SpecialDevice])
-> [(String, FileStatus)]
-> [SpecialDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileStatus) -> Maybe SpecialDevice)
-> [(String, FileStatus)] -> [Maybe SpecialDevice]
forall a b. (a -> b) -> [a] -> [b]
map (FileStatus -> Maybe SpecialDevice
ofNodeStatus (FileStatus -> Maybe SpecialDevice)
-> ((String, FileStatus) -> FileStatus)
-> (String, FileStatus)
-> Maybe SpecialDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileStatus) -> FileStatus
forall a b. (a, b) -> b
snd)

isPart :: (FilePath, FileStatus) -> Bool
isPart :: (String, FileStatus) -> Bool
isPart (String
path, FileStatus
_) =
    case String
path String -> String -> MatchResult String
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"-part[0-9]+$" of
      MatchResult String
x | MatchResult String -> String
forall a. MatchResult a -> a
mrMatch MatchResult String
x String -> String -> Bool
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 IO GroupID -> (GroupID -> IO [SpecialDevice]) -> IO [SpecialDevice]
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 IO GroupID -> (GroupID -> IO [SpecialDevice]) -> IO [SpecialDevice]
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 = IO FileStatus -> IO (Either SomeException FileStatus)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO FileStatus
getFileStatus String
path) IO (Either SomeException FileStatus)
-> (Either SomeException FileStatus -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO [(String, FileStatus)])
-> (FileStatus -> IO [(String, FileStatus)])
-> Either SomeException FileStatus
-> IO [(String, FileStatus)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> [(String, FileStatus)] -> IO [(String, FileStatus)]
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 IO FileStatus
-> (FileStatus -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
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 <- (IO [String] -> IO (Either SomeException [String])
forall e a. Exception e => IO a -> IO (Either e a)
try (IO [String] -> IO (Either SomeException [String]))
-> IO [String] -> IO (Either SomeException [String])
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
path) IO (Either SomeException [String])
-> (Either SomeException [String] -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (Either SomeException [String] -> [String])
-> Either SomeException [String]
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> [String])
-> ([String] -> [String])
-> Either SomeException [String]
-> [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
_ :: SomeException) -> []) [String] -> [String]
forall a. a -> a
id IO [String] -> ([String] -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
path String -> ShowS
</>) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String
".", String
".."]) IO [String]
-> ([String] -> IO [[(String, FileStatus)]])
-> IO [[(String, FileStatus)]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         (String -> IO [(String, FileStatus)])
-> [String] -> IO [[(String, FileStatus)]]
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) IO [[(String, FileStatus)]]
-> ([[(String, FileStatus)]] -> IO [(String, FileStatus)])
-> IO [(String, FileStatus)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> ([[(String, FileStatus)]] -> [(String, FileStatus)])
-> [[(String, FileStatus)]]
-> IO [(String, FileStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(String, FileStatus)]] -> [(String, FileStatus)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                 [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, FileStatus)] -> IO [(String, FileStatus)])
-> [(String, FileStatus)] -> IO [(String, FileStatus)]
forall a b. (a -> b) -> a -> b
$ (String
path, FileStatus
status) (String, FileStatus)
-> [(String, FileStatus)] -> [(String, FileStatus)]
forall a. a -> [a] -> [a]
: [(String, FileStatus)]
subs
          | Bool
True = [(String, FileStatus)] -> IO [(String, FileStatus)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String
path, FileStatus
status)]

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