module Extra.Misc
(
columns
, justify
, mapSnd
, parentPath
, canon
, listMap
, listDiff
--ePut,
--ePutList,
, checkSuperUser
, md5sum
, sameInode
, sameMd5sum
, tarDir
, Extra.Misc.processOutput
, processOutput2
, splitOutput
, cd
, read'
) where
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Extra.List
import System.FilePath
import System.Unix.Process
import System.Directory
import System.Exit
import System.IO
import System.Posix.Files
import System.Posix.User (getEffectiveUserID)
import Text.Regex
mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (a, b) = (a, f b)
columns :: [[String]] -> [[String]]
columns rows =
map (map pad . zip (widths ++ [0])) rows
where
widths = map (fromJust . listMax) . transpose . map (map length . init) $ rows
listMax l = foldl (\ a b -> Just . maybe b (max b) $ a) Nothing l
pad (width, field) = field ++ replicate (max 0 (width length field)) ' '
justify :: String -> Int -> [[String]]
justify s n =
foldr doWord [[]] (words s)
where doWord w [] = [[w]]
doWord w (ws : etc) =
if length (concat (intersperse " " (w:ws))) <= n then
(w : ws) : etc else
[w] : ws : etc
parentPath :: FilePath -> FilePath
parentPath path = fst (splitFileName path)
listMap :: (Ord k) => [(k, a)] -> Map.Map k [a]
listMap pairs =
foldl insertPair Map.empty (reverse pairs)
where insertPair m (k,a) = Map.insert k (a : (Map.findWithDefault [] k m)) m
listDiff :: Ord a => [a] -> [a] -> [a]
listDiff a b = Set.toList (Set.difference (Set.fromList a) (Set.fromList b))
canon :: FilePath -> FilePath
canon path =
let re = mkRegex "/" in
let names = splitRegex re path in
concat (intersperse "/" (merge names))
where
merge (".." : xs) = ".." : (merge xs)
merge ("." : xs) = "." : (merge xs)
merge (_ : ".." : xs) = (merge xs)
merge (x : "." : xs) = (merge (x : xs))
merge (x : xs) = x : merge xs
merge [] = []
md5sum :: FilePath -> IO (Either String String)
md5sum path =
do output <- lazyCommand cmd B.empty
let result =
case exitCodeOnly output of
[ExitFailure n] -> Left ("Error " ++ show n ++ " running '" ++ cmd ++ "'")
[ExitSuccess] ->
case listToMaybe . words . B.unpack . stdoutOnly $ output of
Nothing -> Left $ "Error in output of '" ++ cmd ++ "'"
Just checksum -> Right checksum
_ -> Left "Internal error 12"
return result
where
cmd = "md5sum " ++ path
sameInode :: FilePath -> FilePath -> IO Bool
sameInode a b =
do
aStatus <- getFileStatus a
bStatus <- getFileStatus b
return (deviceID aStatus == deviceID bStatus && fileID aStatus == fileID bStatus)
sameMd5sum :: FilePath -> FilePath -> IO Bool
sameMd5sum a b =
do
asum <- md5sum a
bsum <- md5sum b
return (asum == bsum)
processOutput :: String -> IO (Either Int String)
processOutput command =
do
output <- lazyCommand command B.empty
case exitCodeOnly output of
[ExitSuccess] -> return . Right . B.unpack . stdoutOnly $ output
[ExitFailure n] -> return . Left $ n
_ -> error "My.processOutput: Internal error 13"
processOutput2 :: String -> IO (String, ExitCode)
processOutput2 command =
do
output <- lazyCommand command B.empty
case exitCodeOnly output of
[code] -> return ((B.unpack . stdoutOnly $ output), code)
_ -> error "My.processOutput2: Internal error 14"
splitOutput :: [Output] -> (B.ByteString, B.ByteString, Maybe ExitCode)
splitOutput output = (stdoutOnly output, stderrOnly output, listToMaybe (exitCodeOnly output))
read' s =
case reads s of
[] -> error $ "read - no parse: " ++ show s
((x, s) : _) -> x
checkSuperUser :: IO Bool
checkSuperUser = getEffectiveUserID >>= return . (== 0)
tarDir :: FilePath -> IO (Maybe String)
tarDir path =
Extra.Misc.processOutput cmd >>=
return . either (const Nothing) (dir . lines)
where
cmd = "tar tfz '" ++ path ++ "'"
dir [] = Nothing
dir (file : _) = case wordsBy (== '/') file of
[] -> Nothing
("" : _) -> Nothing
(s : _) -> Just s
cd :: FilePath -> IO a -> IO a
cd name m =
bracket
(do cwd <- getCurrentDirectory
setCurrentDirectory name
return cwd)
(\oldwd -> do setCurrentDirectory oldwd)
(const m)