diff --git a/Filesystem/CanonicalPath/Directory.hs b/Filesystem/CanonicalPath/Directory.hs --- a/Filesystem/CanonicalPath/Directory.hs +++ b/Filesystem/CanonicalPath/Directory.hs @@ -29,11 +29,12 @@ /Since 0.1.1.0/ -} -createDirectory :: CanonicalPath -- ^ base directory +createDirectory :: MonadIO m + => CanonicalPath -- ^ base directory -> UnsafePath -- ^ name of new directory - -> IO CanonicalPath -- ^ @'CanonicalPath'@ of created directory + -> m CanonicalPath -- ^ @'CanonicalPath'@ of created directory createDirectory cp dir = - do Directory.createDirectory $ toPrelude path + do liftIO . Directory.createDirectory $ toPrelude path return $ CanonicalPath path where path = unsafePath cp dir @@ -44,12 +45,13 @@ /Since 0.1.1.0/ -} -createDirectoryIfMissing :: Bool -- ^ Create its parents too? +createDirectoryIfMissing :: MonadIO m + => Bool -- ^ Create its parents too? -> CanonicalPath -- ^ base directory -> UnsafePath -- ^ name of new directory - -> IO CanonicalPath -- ^ @'CanonicalPath'@ of created directory + -> m CanonicalPath -- ^ @'CanonicalPath'@ of created directory createDirectoryIfMissing flag cp dir = - do Directory.createDirectoryIfMissing flag $ toPrelude path + do liftIO . Directory.createDirectoryIfMissing flag $ toPrelude path return $ CanonicalPath path where path = unsafePath cp dir @@ -60,8 +62,8 @@ /Since 0.1.1.0/ -} -removeDirectory :: CanonicalPath -> IO () -removeDirectory = preludeMap Directory.removeDirectory +removeDirectory :: MonadIO m => CanonicalPath -> m () +removeDirectory = liftIO . preludeMap Directory.removeDirectory {-| @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ together with its content and all subdirectories. Be careful, if the directory contains symlinks, the function will follow them. @@ -70,8 +72,8 @@ /Since 0.1.1.0/ -} -removeDirectoryRecursive :: CanonicalPath -> IO () -removeDirectoryRecursive = preludeMap Directory.removeDirectoryRecursive +removeDirectoryRecursive :: MonadIO m => CanonicalPath -> m () +removeDirectoryRecursive = liftIO . preludeMap Directory.removeDirectoryRecursive {-| @'renameDirectory' old new@ changes the name of an existing directory from /old/ to /new/ and returns @'CanonicalPath'@ of new directory. @@ -80,12 +82,13 @@ /Since 0.1.1.0/ -} -renameDirectory :: CanonicalPath -- ^ old directory +renameDirectory :: MonadIO m + => CanonicalPath -- ^ old directory -> UnsafePath -- ^ new directory (should be just name of directory) - -> IO CanonicalPath -- ^ @'CanonicalPath'@ of new directory + -> m CanonicalPath -- ^ @'CanonicalPath'@ of new directory renameDirectory cp p = do newPath <- canonicalPath $ parent p - Directory.renameDirectory (toPrelude . unsafePath $ cp) (toPrelude p) + liftIO $ Directory.renameDirectory (toPrelude . unsafePath $ cp) (toPrelude p) return . CanonicalPath $ unsafePath newPath dirname (addSlash p) {-| @@ -95,16 +98,16 @@ /Since 0.1.1.0/ -} -getDirectoryContents :: CanonicalPath -> IO [UnsafePath] -getDirectoryContents cp = liftM (fromPrelude <$>) $ preludeMap Directory.getDirectoryContents cp +getDirectoryContents :: MonadIO m => CanonicalPath -> m [UnsafePath] +getDirectoryContents cp = liftIO . liftM (fromPrelude <$>) $ preludeMap Directory.getDirectoryContents cp {-| The same as @'getDirectoryContents'@, but returns list of @'CanonicalPath'@ instead of @'UnsafePath'@. /Since 0.1.1.0/ -} -getDirectoryContents' :: CanonicalPath -> IO [CanonicalPath] -getDirectoryContents' cp = liftM (CanonicalPath . ( ) up <$>) $ getDirectoryContents cp +getDirectoryContents' :: MonadIO m => CanonicalPath -> m [CanonicalPath] +getDirectoryContents' cp = liftIO . liftM (CanonicalPath . ( ) up <$>) $ getDirectoryContents cp where up = unsafePath cp {- |If the operating system has a notion of current directories, 'getCurrentDirectory' returns an @'CanonicalPath'@ to the current directory of the calling process. @@ -113,8 +116,8 @@ /Since 0.1.1.0/ -} -getCurrentDirectory :: IO CanonicalPath -getCurrentDirectory = liftM (CanonicalPath . fromPrelude) Directory.getCurrentDirectory +getCurrentDirectory :: MonadIO m => m CanonicalPath +getCurrentDirectory = liftIO $ liftM (CanonicalPath . fromPrelude) Directory.getCurrentDirectory {-| If the operating system has a notion of current directories, @'setCurrentDirectory' dir@ changes the current directory of the calling process to /dir/. @@ -123,8 +126,8 @@ /Since 0.1.1.0/ -} -setCurrentDirectory :: CanonicalPath -> IO () -setCurrentDirectory = preludeMap Directory.setCurrentDirectory +setCurrentDirectory :: MonadIO m => CanonicalPath -> m () +setCurrentDirectory = liftIO . preludeMap Directory.setCurrentDirectory {-| Returns the current user's home directory. @@ -133,8 +136,8 @@ /Since 0.1.1.0/ -} -getHomeDirectory :: IO CanonicalPath -getHomeDirectory = liftM (CanonicalPath . fromPrelude) Directory.getHomeDirectory +getHomeDirectory :: MonadIO m => m CanonicalPath +getHomeDirectory = liftIO $ liftM (CanonicalPath . fromPrelude) Directory.getHomeDirectory {-| Returns the @'CanonicalPath'@ of a directory in which application-specific data for the current user can be stored. The result of 'getAppUserDataDirectory' for a given application is specific to the current user. @@ -143,8 +146,8 @@ /Since 0.1.1.0/ -} -getAppUserDataDirectory :: Text -> IO UnsafePath -getAppUserDataDirectory = liftM fromPrelude . Directory.getAppUserDataDirectory . textToString +getAppUserDataDirectory :: MonadIO m => Text -> m UnsafePath +getAppUserDataDirectory = liftIO . liftM fromPrelude . Directory.getAppUserDataDirectory . textToString {-| Returns the current user's document directory. @@ -153,8 +156,8 @@ /Since 0.1.1.0/ -} -getUserDocumentsDirectory :: IO CanonicalPath -getUserDocumentsDirectory = liftM (CanonicalPath . fromPrelude) Directory.getUserDocumentsDirectory +getUserDocumentsDirectory :: MonadIO m => m CanonicalPath +getUserDocumentsDirectory = liftIO $ liftM (CanonicalPath . fromPrelude) Directory.getUserDocumentsDirectory {-| Returns the current directory for temporary files. @@ -163,8 +166,8 @@ /Since 0.1.1.0/ -} -getTemporaryDirectory :: IO UnsafePath -getTemporaryDirectory = liftM fromPrelude Directory.getTemporaryDirectory +getTemporaryDirectory :: MonadIO m => m UnsafePath +getTemporaryDirectory = liftIO $ liftM fromPrelude Directory.getTemporaryDirectory {-| 'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. @@ -173,8 +176,8 @@ /Since 0.1.1.0/ -} -removeFile :: CanonicalPath -> IO () -removeFile = preludeMap Directory.removeFile +removeFile :: MonadIO m => CanonicalPath -> m () +removeFile = liftIO . preludeMap Directory.removeFile {-| @'renameFile' old new@ changes the name of an existing file system object from /old/ to /new/. @@ -183,12 +186,13 @@ /Since 0.1.1.0/ -} -renameFile :: CanonicalPath -- ^ @'CanonicalPath'@ of file you want to rename +renameFile :: MonadIO m + => CanonicalPath -- ^ @'CanonicalPath'@ of file you want to rename -> UnsafePath -- ^ new name of file - -> IO CanonicalPath -- ^ @'CanonicalPath'@ of /new/ file + -> m CanonicalPath -- ^ @'CanonicalPath'@ of /new/ file renameFile cp p = do newPath <- canonicalPath $ parent p - Directory.renameFile (toPrelude . unsafePath $ cp) (toPrelude p) + liftIO $ Directory.renameFile (toPrelude . unsafePath $ cp) (toPrelude p) return . CanonicalPath $ unsafePath newPath filename p {-| @@ -198,10 +202,11 @@ /Since 0.1.1.0/ -} -copyFile :: CanonicalPath -- ^ @'CanonicalPath'@ of file you want to copy +copyFile :: MonadIO m + => CanonicalPath -- ^ @'CanonicalPath'@ of file you want to copy -> UnsafePath -- ^ name of new file (actually it can be path relative to directory of /old/ - -> IO CanonicalPath -- ^ @'CanonicalPath'@ of /new/ file + -> m CanonicalPath -- ^ @'CanonicalPath'@ of /new/ file copyFile oldFile newFile = do newPath <- canonicalPath $ parent newFile - Directory.copyFile (toPrelude . unsafePath $ oldFile) (toPrelude newFile) + liftIO $ Directory.copyFile (toPrelude . unsafePath $ oldFile) (toPrelude newFile) return . CanonicalPath $ unsafePath newPath filename newFile diff --git a/Filesystem/CanonicalPath/Internal.hs b/Filesystem/CanonicalPath/Internal.hs --- a/Filesystem/CanonicalPath/Internal.hs +++ b/Filesystem/CanonicalPath/Internal.hs @@ -31,7 +31,7 @@ ,doesFileExist) import qualified System.Environment as SE (getEnv) -data CanonicalPath = CanonicalPath UnsafePath +newtype CanonicalPath = CanonicalPath UnsafePath instance Show CanonicalPath where showsPrec d path = @@ -53,7 +53,7 @@ /Since 0.1.0.0/ -} -canonicalPath :: UnsafePath -> IO CanonicalPath +canonicalPath :: MonadIO m => UnsafePath -> m CanonicalPath canonicalPath path = canonicalize path >>= either (error . textToString) (return . CanonicalPath) {-| @@ -67,7 +67,7 @@ /Since 0.1.0.0/ -} -canonicalPathM :: UnsafePath -> IO (Maybe CanonicalPath) +canonicalPathM :: MonadIO m => UnsafePath -> m (Maybe CanonicalPath) canonicalPathM path = canonicalize path >>= either (\_ -> return Nothing) (return . Just . CanonicalPath) {-| @@ -81,7 +81,7 @@ /Since 0.1.0.0/ -} -canonicalPathE :: UnsafePath -> IO (Either Text CanonicalPath) +canonicalPathE :: MonadIO m => UnsafePath -> m (Either Text CanonicalPath) canonicalPathE path = canonicalize path >>= either (return . Left) (return . Right . CanonicalPath) -- | Convert @CanonicalPath@ to @Filesystem.FilePath@. @@ -98,42 +98,42 @@ -- * Functions used for canonicalization -canonicalize :: UnsafePath -> IO SafePath +canonicalize :: MonadIO m => UnsafePath -> m SafePath canonicalize fp = extractPath fp >>= either (return . Left) canonicalize' -canonicalize' :: UnsafePath -> IO SafePath +canonicalize' :: MonadIO m => UnsafePath -> m SafePath canonicalize' fp = - do exists <- liftM2 (||) (doesFileExist . toPrelude $ fp) (doesDirectoryExist . toPrelude $ fp) + do exists <- liftIO $ liftM2 (||) (doesFileExist . toPrelude $ fp) (doesDirectoryExist . toPrelude $ fp) if exists - then liftM Right (pathMap canonicalizePath fp) + then liftIO $ liftM Right (pathMap canonicalizePath fp) else return . Left $ "Path does not exist (no such file or directory): " ++ pathToText fp -extractPath :: UnsafePath -> IO SafePath +extractPath :: MonadIO m => UnsafePath -> m SafePath extractPath = liftM concatPath . mapM extractAtom . FilePath.splitDirectories -extractAtom :: UnsafePath -> IO SafePath +extractAtom :: MonadIO m => UnsafePath -> m SafePath extractAtom atom = tryEnvPosix <||> tryEnvWindows <||> tryHome <%> atom -- * Parsers and parser combinators -type Parser = UnsafePath -> Maybe (IO SafePath) +type Parser m = UnsafePath -> Maybe (m SafePath) -tryEnvPosix :: Parser +tryEnvPosix :: MonadIO m => Parser m tryEnvPosix x = when' (hasPrefix "$" x) (Just . getEnv . pathTail $ x) -tryEnvWindows :: Parser +tryEnvWindows :: MonadIO m => Parser m tryEnvWindows x = when' (hasPrefix "%" x && hasSuffix "%" x) (Just . getEnv . pathTail . pathInit $ x) -tryHome :: Parser +tryHome :: MonadIO m => Parser m tryHome x = when' (textToPath "~" == x) (Just $ liftM Right homeDirectory) -(<||>) :: Parser -> Parser -> Parser +(<||>) :: MonadIO m => Parser m -> Parser m -> Parser m p1 <||> p2 = \v -> p1 v <|> p2 v -(<%>) :: Parser -> UnsafePath -> IO SafePath +(<%>) :: MonadIO m => Parser m -> UnsafePath -> m SafePath p <%> v = fromMaybe (return . Right $ v) (p v) -- * File operations @@ -141,43 +141,43 @@ -- | @'readFile' file@ function reads a /file/ and returns the contents of the /file/ as a @'Text'@. The /file/ is read lazily, on demand, as with getContents. -- -- /Since 0.1.1.0/ -readFile :: CanonicalPath -> IO Text -readFile = BasicPrelude.readFile . unsafePath +readFile :: MonadIO m => CanonicalPath -> m Text +readFile = liftIO . BasicPrelude.readFile . unsafePath -- | @'writeFile' file txt@ writes /txt/ to the /file/. -- -- /Since 0.1.1.0/ -writeFile :: CanonicalPath -> Text -> IO () -writeFile = BasicPrelude.writeFile . unsafePath +writeFile :: MonadIO m => CanonicalPath -> Text -> m () +writeFile p = liftIO . BasicPrelude.writeFile (unsafePath p) -- | @'writeFile'' dir file txt@ writes /txt/ to the /dir\/file/. Useful, when the file isn't created yet or you don't sure if it exists. -- -- /Since 0.1.2.0/ -writeFile' :: CanonicalPath -> UnsafePath -> Text -> IO () -writeFile' cp file = BasicPrelude.writeFile (unsafePath cp file) +writeFile' :: MonadIO m => CanonicalPath -> UnsafePath -> Text -> m () +writeFile' cp file = liftIO . BasicPrelude.writeFile (unsafePath cp file) -- | @'appendFile' file txt@ appends /txt/ to the /file/. -- -- /Since 0.1.1.0/ -appendFile :: CanonicalPath -> Text -> IO () -appendFile = BasicPrelude.appendFile . unsafePath +appendFile :: MonadIO m => CanonicalPath -> Text -> m () +appendFile p = liftIO . BasicPrelude.appendFile (unsafePath p) -- * Utilities -getEnv :: UnsafePath -> IO SafePath -getEnv var = map (left show) tryEnv +getEnv :: MonadIO m => UnsafePath -> m SafePath +getEnv var = liftM (left show) tryEnv where env = pathMap SE.getEnv - tryEnv :: IO (Either IOException UnsafePath) - tryEnv = try . env $ var + tryEnv :: MonadIO m => m (Either IOException UnsafePath) + tryEnv = liftIO . try . env $ var -homeDirectory :: IO UnsafePath -homeDirectory = fromPrelude <$> getHomeDirectory +homeDirectory :: MonadIO m => m UnsafePath +homeDirectory = liftIO $ fromPrelude <$> getHomeDirectory when' :: Alternative f => Bool -> f a -> f a when' b v = if b then v else Applicative.empty -pathMap :: (Prelude.FilePath -> IO Prelude.FilePath) -> UnsafePath -> IO UnsafePath -pathMap f = map fromPrelude . f . toPrelude +pathMap :: MonadIO m => (Prelude.FilePath -> m Prelude.FilePath) -> UnsafePath -> m UnsafePath +pathMap f p = liftM fromPrelude (f . toPrelude $ p) hasPrefix :: Text -> UnsafePath -> Bool hasPrefix prefix path = prefix `Text.isPrefixOf` pathToText path diff --git a/system-canonicalpath.cabal b/system-canonicalpath.cabal --- a/system-canonicalpath.cabal +++ b/system-canonicalpath.cabal @@ -1,5 +1,5 @@ name: system-canonicalpath -version: 0.1.2.0 +version: 0.2.0.0 synopsis: Abstract data type for canonical paths with pretty operations description: This library provides abstract data type named 'CanonicalPath' and some useful functions for working with it. See every module's description to find out more. homepage: https://github.com/d12frosted/CanonicalPath