How can I get a list of directories that are in a directory?
I've come up with the below, but I'm hoping there is a more elegant way:
import System.Directory
import qualified Filesystem.Path as FsP
import Filesystem.Path.CurrentOS
import Control.Monad
getDirectories :: Prelude.FilePath -> IO [Prelude.FilePath]
getDirectories x = do
listDirectory x
>>= (return . fmap decodeString)
>>= return . fmap (FsP.append (decodeString x))
>>= (return . fmap encodeString)
>>= filterM doesDirectoryExist
It looks like you are using the package system-filepath which is deprecated, how about using the filepath package instead:
import Control.Monad (filterM)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
getDirectories :: FilePath -> IO [FilePath]
getDirectories filePath = do
allFiles <- listDirectory filePath
filterM (doesDirectoryExist . (filePath </>)) allFiles
Or if you prefer explicitly using the bind operator:
import Control.Monad (filterM)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
getDirectories :: FilePath -> IO [FilePath]
getDirectories filePath = listDirectory filePath
>>= filterM (doesDirectoryExist . (filePath </>))
NOTE: Your version of the function will return the input filepath prepended to every output directory in the list. While this might be what you want, the version of getDirectories I am giving you may be more general as it behaves exactly like listDirectory and simply prunes the files/executables.
EDIT: Changed the import from System.FilePath.Posix to System.FilePath for true platform independence. Thanks to Justin Raymond for the suggestion.
All you need is System.Directory.
import Control.Monad (filterM)
import System.Directory (doesDirectoryExist, getCurrentDirectory, getDirectoryContents)
listDirs :: IO [FilePath]
listDirs = getCurrentDirectory >>= getDirectoryContents >>= filterM doesDirectoryExist
If you want to pass the filepath as argument, just doen't use getCurrentDirectory.
import Control.Monad (filterM)
import System.Directory (doesDirectoryExist, getCurrentDirectory)
listDirs :: FilePath -> IO [FilePath]
listDirs path = getDirectoryContents path >>= filterM (doesDirectoryExist . (++) path)
Related
I have a function reading the content of /proc every second. Surprisingly, its CPU usage in top is around 5%, peak at 8%. But same logic in C or Rust just takes like 1% or 2%. Wondering if this can be improved.
import Control.Exception
import Control.Concurrent
import Control.Monad
import Data.Char
import Data.Maybe
import System.Directory
import System.FilePath
import System.Posix.Files
import System.Posix.Signals
import System.Posix.Types
import System.Posix.User
import System.IO.Strict as Strict
watch u limit0s limit0h = do
listDirectory "/proc/" >>= mapM_ (\fp -> do
isMyPid' <- maybe False id <$> wrap2Maybe (isMyPid fp u)
wrap2Maybe (Strict.readFile ("/proc/" </> fp </> "stat")))
threadDelay 1000000
watch u limit0s limit0h
where
wrap2Maybe :: IO a -> IO (Maybe a)
wrap2Maybe f = catch ((<$>) Just $! f) (\(_ :: IOException) -> return Nothing)
isMyPid :: FilePath -> UserID -> IO Bool
isMyPid fp me = do
let areDigit = fp >= "0" && fp <= "9"
isDir <- doesDirectoryExist $ "/proc/" </> fp
owner <- fileOwner <$> getFileStatus ("/proc" </> fp)
return $ areDigit && isDir && (owner == me)
Being totally new to Haskell I thought that writing a small practical tool would be a good start for learning it. My goal is to implement some kind of a linux "more" command for displaying the content of a PK zipped archive file. So far I only managed to list the file names within the archive:
module Main where
import Codec.Archive.Zip
import Path
import Path.IO (resolveFile')
import Data.List (sortBy)
import Data.Ord (comparing)
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as Byte (ByteString)
loadTicks :: Path Abs File -> EntrySelector -> IO Byte.ByteString
loadTicks ticksArchivePath entry = withArchive ticksArchivePath (getEntry entry)
extractEntries :: Path Abs File -> IO [EntrySelector]
extractEntries ticksArchivePath = withArchive ticksArchivePath loadEntries
loadEntries :: ZipArchive [EntrySelector]
loadEntries = fmap Map.keys getEntries
-- not really useful since only natural ordering is required
customSort :: Ord a => a -> a -> Ordering
customSort elem1 elem2 = compare elem1 elem2
main :: IO ()
main = do
let ticksArchivePath = resolveFile' "data/data-small.zip" :: IO (Path Abs File)
let entries = extractEntries =<< ticksArchivePath :: IO [EntrySelector]
sortedEntries <- fmap (sortBy customSort) entries :: IO [EntrySelector]
print sortedEntries
I am stuck at this point because I cannot figure out how to call the loadTicks function over each entry in sortedEntries. How can I do that in order to eventually obtain a [String] output that concatenates all lines from each file of the archive (example archive:
https://drive.google.com/open?id=1mp1TIPmJd74SGJ4Yy5J-BBsoyBPPPHRh) ?
EDIT
After #arrowd comments the following code works:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Codec.Archive.Zip
import Path
import Path.IO (resolveFile')
import Data.List (sortBy)
import Data.Text (takeEnd)
import Data.Ord (comparing)
import Prelude hiding (concat)
import Data.ByteString.Char8 (concat)
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as Byte (ByteString)
loadTicks :: Path Abs File -> EntrySelector -> IO Byte.ByteString
loadTicks ticksArchivePath entry = withArchive ticksArchivePath (getEntry entry)
extractEntries :: Path Abs File -> IO [EntrySelector]
extractEntries ticksArchivePath = withArchive ticksArchivePath loadEntries
loadEntries :: ZipArchive [EntrySelector]
loadEntries = fmap Map.keys getEntries
-- not really useful since only natural ordering is required
customSort :: Ord a => a -> a -> Ordering
customSort elem1 elem2 = compare elem1 elem2
isCSVFile :: EntrySelector -> Bool
isCSVFile entry = takeEnd 4 (getEntryName entry) == ".csv"
main :: IO ()
main = do
ticksArchivePath <- resolveFile' "data/data-small.zip" :: IO (Path Abs File)
entries <- extractEntries ticksArchivePath :: IO [EntrySelector]
let sortedEntries = sortBy customSort entries :: [EntrySelector]
let ticks = loadTicks ticksArchivePath
contents <- mapM ticks sortedEntries :: IO [Byte.ByteString]
print (concat contents)
Take as a rule of thumb, that arrow <- "pulls" a from some m a, where m is a Monad. In this case, arrows of your do-block pull as from IO as.
So, to get rid of fmaps you should write
ticksArchivePath <- resolveFile' "data/data-small.zip" :: IO (Path Abs File)
instead of
let ticksArchivePath = resolveFile' "data/data-small.zip" :: IO (Path Abs File)
and
entries <- extractEntries ticksArchivePath :: IO [EntrySelector]
instead of
let entries = extractEntries =<< ticksArchivePath :: IO [EntrySelector]
Expressions starting with let in do-blocks are usually used for pure computations. In your case it is
let sortedEntries = sortBy customSort entries
StackOverflow documentation had a great section explaining monads and do-syntax, but alas, it is gone now.
I was discussing some code on Reddit, and it made me curious about how this would be implemented in io-streams. Consider the following code which traverses a directory structure and prints out all of the filenames:
import Control.Exception (bracket)
import qualified Data.Foldable as F
import Data.Streaming.Filesystem (closeDirStream, openDirStream,
readDirStream)
import System.Environment (getArgs)
import System.FilePath ((</>))
printFiles :: FilePath -> IO ()
printFiles dir = bracket
(openDirStream dir)
closeDirStream
loop
where
loop ds = do
mfp <- readDirStream ds
F.forM_ mfp $ \fp' -> do
let fp = dir </> fp'
ftype <- getFileType fp
case ftype of
FTFile -> putStrLn fp
FTFileSym -> putStrLn fp
FTDirectory -> printFiles fp
_ -> return ()
loop ds
main :: IO ()
main = getArgs >>= mapM_ printFiles
Instead of simply printing the files, suppose we wanted to create some kind of streaming filepath representation. I know how this would work in enumerator, conduit, and pipes. However, since the intermediate steps require acquisition of a scarce resource (the DirStream), I'm not sure what the implementation would be for io-streams. Can someone provide an example of how that would be done?
For comparison, here's the conduit implementation, which is made possible via bracketP and MonadResource. And here's how the conduit code would be used to implemented the same file printing program as above:
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit (($$))
import Data.Conduit.Filesystem (sourceDirectoryDeep)
import qualified Data.Conduit.List as CL
import System.Environment (getArgs)
main :: IO ()
main =
getArgs >>= runResourceT . mapM_ eachRoot
where
-- False means don't traverse dir symlinks
eachRoot root = sourceDirectoryDeep False root
$$ CL.mapM_ (liftIO . putStrLn)
Typical style would be to do something like this:
traverseDirectory :: RawFilePath -> (InputStream RawFilePath -> IO a) -> IO a
i.e. a standard "with-" function, with the obvious implementation.
Edit: added a working example implementation: https://gist.github.com/gregorycollins/00c51e7e33cf1f9c8cc0
It's not exactly complicated but it's also not as trivial as I had first suggested.
While I can use reify to get information about most other syntactic constructs, I couldn't find anything that would give some information about a module.
Unfortunately Template Haskell currently has no such capabilities. All the solutions involve parsing of the module's source-code. However the location and loc_filename functions of TH make it easy to locate the module with the calling splice.
Here is a solution extracted from the source code of one of my projects:
{-# LANGUAGE LambdaCase, TupleSections #-}
import Language.Haskell.TH
import qualified Data.Attoparsec.Text as AP
import qualified Data.Text.IO as Text
import qualified Data.Text as Text
import qualified Data.Char as Char
import Data.Maybe
import Data.List
import Control.Applicative
import Data.Traversable
import Prelude hiding (mapM)
reifyLocalFunctions :: Q [(Name, Type)]
reifyLocalFunctions =
listTopLevelFunctionLikeNames >>=
mapM (\name -> reifyFunction name >>= mapM (return . (name, ))) >>=
return . catMaybes
where
listTopLevelFunctionLikeNames = do
loc <- location
text <- runIO $ Text.readFile $ loc_filename loc
return $ map (mkName . Text.unpack) $ nub $ parse text
where
parse text =
either (error . ("Local function name parsing failure: " ++)) id $
AP.parseOnly parser text
where
parser =
AP.sepBy (optional topLevelFunctionP <* AP.skipWhile (not . AP.isEndOfLine))
AP.endOfLine >>=
return . catMaybes
where
topLevelFunctionP = do
head <- AP.satisfy Char.isLower
tail <- many (AP.satisfy (\c -> Char.isAlphaNum c || c `elem` ['_', '\'']))
return $ Text.pack $ head : tail
reifyFunction :: Name -> Q (Maybe Type)
reifyFunction name = do
tryToReify name >>= \case
Just (VarI _ t _ _) -> return $ Just $ t
_ -> return Nothing
tryToReify :: Name -> Q (Maybe Info)
tryToReify n = recover (return Nothing) (fmap Just $ reify n)
I have a file with strings which represent directories. Some of those strings have a tilde (~) in it.
I want to join the homedirectory (~) of a user to the rest of the string.
What I have so far:
import Data.List (isPrefixOf)
import System.Directory (doesDirectoryExist, getHomeDirectory)
import System.FilePath (joinPath)
getFullPath s
| "~" `isPrefixOf` s = joinPath [getHomeDirectory, tail s]
| otherwise = s
But I get the following error:
Couldn't match type `IO FilePath' with `[Char]'Expected type: FilePath Actual type: IO FilePathIn the expression: getHomeDirectoryIn the first argument of `joinPath', namely `[getHomeDirectory, tail s]'In the expression: joinPath
I don't know, and I can't find, how to convert the types so they match and can be joined together.
A more idiomatic solution than #user2720372 suggests is to split non-monadic code from monadic code. IO actions are monadic functions in IO monad.
If you only need getFullPath locally it makes sense to cache home directory:
fullPath homePath s
| "~" `isPrefixOf` s = joinPath [homePath, tail s]
| otherwise = s
main = do
homePath <- getHomeDirectory
let getFullPath = fullPath homePath
print $ getFullPath "~/foo"
If you still need full global getFullPath then it can be implemented like this:
getFullPath p = do
homePath <- getHomeDirectory
return $ fullPath homePath p
And it's considered a good style to keep fullPath and getFullPath separated.
Also you don't need isPrefixOf and tail in the first place for such a simple case:
fullPath homePath ('~' : t) = joinPath [homePath, t]
fullPath _ s = s
If you want just a monolithic getFullPath then #user2720372's variant can be simplified:
getFullPath s = do
homeDir <- getHomeDirectory
return $ case s of
('~' : t) -> joinPath [homeDir, t]
_ -> s
Note that the code above is just refactorings of your code preserving its wrong behavior: you should compare ~ with the first path component, not with the first path character. Use splitPath from System.FilePath:
getFullPath s = do
homeDir <- getHomeDirectory
return $ case splitPath s of
("~" : t) -> joinPath $ homeDir : t
_ -> s
Also, do-notation is only for complicated cases. If you use do-notation for simple two-liners it is almost certainly reducible to an application of fmap/<$>/>>=/>=>/liftM2 or other functions from Control.Monad and Control.Applicative.
Here is another version:
import Control.Applicative ((<$>))
import System.Directory (getHomeDirectory)
import System.FilePath (joinPath, splitPath)
getFullPath s = case splitPath s of
"~/" : t -> joinPath . (: t) <$> getHomeDirectory
_ -> return s
main = getFullPath "~/foo" >>= print
Here is yet another more modular, but less readable version:
import Control.Applicative ((<$>), (<*>))
import System.Directory (getHomeDirectory)
import System.FilePath (joinPath, splitPath)
main = getFullPath "~/foo" >>= print
withPathComponents f = joinPath . f . splitPath
replaceHome p ("~/" : t) = p : t
replaceHome _ s = s
getFullPath path = withPathComponents . replaceHome <$> getHomeDirectory <*> return path
Haskell gurus are invited to rewrite it to preserve modularity but improve readability :)
getHomeDirectory :: IO FilePath
getHomeDirectory is not a function but an IO action so you have to unpack it within another IO action first.
getFullPath :: String -> IO FilePath
getFullPath s = do
homeDir <- getHomeDirectory
if "~" `isPrefixOf` s
then return (joinPath [homeDir, tail s])
else return s