diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Andrey Mulik (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Andrey Mulik nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/sdp-io.cabal b/sdp-io.cabal new file mode 100644 --- /dev/null +++ b/sdp-io.cabal @@ -0,0 +1,45 @@ +name: sdp-io +version: 0.2 +category: Data Structures + +synopsis: SDP IO extension +description: SDP utils for input/output + +author: Andrey Mulik +maintainer: work.a.mulik@gmail.com +bug-reports: https://github.com/andreymulik/sdp-io/issues + +copyright: 2020 Andrey Mulik +license-file: LICENSE +license: BSD3 + +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/andreymulik/sdp-io + +--- _ _____ ______ ______ ___ ______ __ __ --- +--- | | |_ _|| ___ \| ___ \ / _ \ | ___ \\ \ / / --- +--- | | | | | |_/ /| |_/ // /_\ \| |_/ / \ V / --- +--- | | | | | ___ \| / | _ || / \ / --- +--- | |____ _| |_ | |_/ /| |\ \ | | | || |\ \ | | --- +--- \_____/ \___/ \____/ \_| \_|\_| |_/\_| \_| \_/ --- + +Library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -Wcompat + + build-depends: + base >= 4.12 && < 5, + fmr >= 0.1 && < 1, + sdp >= 0.2 && < 0.3 + + exposed-modules: + System.IO.Classes + System.IO.Handle + + Data.FilePath + diff --git a/src/Data/FilePath.hs b/src/Data/FilePath.hs new file mode 100644 --- /dev/null +++ b/src/Data/FilePath.hs @@ -0,0 +1,695 @@ +{-# LANGUAGE CPP, ViewPatterns, PatternSynonyms #-} + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +#else +#define IS_POSIX +#endif + +{- | + Module : Data.FilePath + Copyright : (c) Andrey Mulik 2020 + License : BSD-style + Maintainer : work.a.mulik@gmail.com + Portability : non-portable (GHC extensions) + + @Data.FilePath@ provides pattern synonyms similar to @System.FilePath@ + functions. So you don't need the @filepath@ package, when use @sdp-io@. +-} +module Data.FilePath +( + -- * FilePath + FilePath, isPathSep, isValid, isRelative, isAbsolute, + + makeValid, normalise, equalFilePath, makeRelative, + + -- * @$PATH@ + getPath, + + -- * Patterns + pattern PathSep, + + -- ** Drive + pattern (:\\), + + -- ** Extensions + pattern (:.), pattern (:..), + + -- ** Split path + pattern (:/), pattern (://), pattern Path, pattern Dirs +) +where + +import Prelude () +import SDP.SafePrelude hiding ( many ) +import SDP.Linear + +import Data.Char + +#ifndef IS_POSIX +import Data.Maybe + +import Text.ParserCombinators.ReadPrec ( lift ) +import Text.ParserCombinators.ReadP + +import Text.Read.SDP ( readMaybeBy ) +#endif + +import System.Environment + +default () + +infixr 7 :., :.. -- like <.> +infixr 5 :/, :// -- like + +-------------------------------------------------------------------------------- + +-- | Separator check. +isPathSep :: Char -> Bool +#ifdef IS_POSIX +isPathSep = (== '/') +#else +isPathSep = (\ c -> c == '/' || c == '\\') +#endif + +-- | Default path separator. +pattern PathSep :: Char +#ifdef IS_POSIX +pattern PathSep = '/' +#else +pattern PathSep <- ((\ c -> c == '/' || c == '\\') -> True) where PathSep = '\\' +#endif + +-------------------------------------------------------------------------------- + +{- PATH parse. -} + +-- | Get a list of 'FilePath's in the $PATH. +getPath :: IO [FilePath] +getPath = +#ifdef IS_POSIX + map (\ dir -> null dir ? "." $ dir) . splitsBy (== ':') <$> getEnv "PATH" +#else + select (null ?- literal) . splitsBy (== ';') <$> getEnv "PATH" + where + literal ('"' : (path :< '"')) = path + literal path = path +#endif + +-------------------------------------------------------------------------------- + +{- Path/extension split and join. -} + +{-# COMPLETE (:.) #-} + +{- | + Add an extension. + + > "/directory/path" :. "ext" == "/directory/path.ext" + > "file.txt" :. "tar" == "file.txt.tar" + > "file." :. ".tar" == "file..tar" + > "file" :. ".xml" == "file.xml" + > "/" :. "d" == "/.d" + + Windows: + > "\\\\share" :. ".txt" == "\\\\share\\.txt" + + Split on the extension. Note that points are discarded. + + > ("file" :. "") <- "file" + > ("out" :. "txt") <- "out.txt" + > ("/etc/pam.d/" :. "") <- "/etc/pam.d/" + > ("dir.d/fnya" :. "") <- "dir.d/fnya" + > ("dir.d/data" :. "bak") <- "dir.d/data.bak" + > ("/directory/path" :. "ext") <- "/directory/path.ext" + > ("file/path.txt.alice" :. "bob") <- "file/path.txt.alice.bob" + + Note that filenames starting with a @.@ are handled correctly: + + > (".bashrc" :. "") <- ".bashrc" +-} +pattern (:.) :: FilePath -> String -> FilePath +pattern path :. ext <- (splitExt -> (path, ext)) where (:.) = addExt + +splitExt :: FilePath -> (String, String) +splitExt path = null name ? (path, "") $ (dir ++ name, ext) + where + (name, ext) = divideBy (== '.') file + (dir, file) = dirName path + +addExt :: FilePath -> String -> FilePath +addExt file "" = file +addExt (drive :\\ path) ext@('.' : _) = drive :\\ (path ++ ext) +addExt (drive :\\ path) ext = drive :\\ (path ++ '.' : ext) + +{-# COMPLETE (:..) #-} + +{- | + Add an extensions. + + > x :.. [] = x -- forall x + > path :.. [ext] = path :. ext -- forall path ext + + > "dir/file" :.. ["fb2", "zip"] == "dir/file.fb2.zip" + > "dir/file" :.. ["fb2", ".zip"] == "dir/file.fb2.zip" + > "pacman" :.. ["pkg", "tar", "xz"] == "pacman.pkg.tar.xz" + + Split on the extensions. Note that points are discarded. + + > ("file" :.. []) <- "file" + > ("out" :.. ["txt"]) <- "out.txt" + > ("/etc/pam.d/" :.. []) <- "/etc/pam.d/" + > ("dir.d/fnya" :.. []) <- "dir.d/fnya" + > ("dir.d/data" :.. ["bak"]) <- "dir.d/data.bak" + > ("/directory/path" :.. ["ext"]) <- "/directory/path.ext" + > ("file/path." :.. ["txt", "alice", "bob"]) <- "file/path.txt.alice.bob" + + This function separates the extensions and also considers the case when the + file name begins with a period. + + > splitExtensions "file/.path.txt.alice.bob" == ("file/", ".path.txt.alice.bob") + > ("file/.path" :.. [txt, alice, bob]) <- "file/.path.txt.alice.bob" + > splitExtensions ".bashrc" == ("", ".bashrc") + > (".bashrc" :.. []) <- ".bashrc" +-} +pattern (:..) :: FilePath -> [String] -> FilePath +pattern path :.. exts <- (splitExts -> (path, exts)) where (:..) = foldl (:.) + +splitExts :: FilePath -> (FilePath, [String]) +splitExts path = case splitsBy (== '.') file' of + (name : exts) -> (dir ++ pt ++ name, exts) + _ -> (path, []) + where + (pt, file') = spanl (== '.') file + (dir, file) = dirName path + +-------------------------------------------------------------------------------- + +{- Directory/file split and join. -} + +{-# COMPLETE (:/) #-} + +{- | + Split a filename into directory and file. The first component will often end + with a trailing slash. + + > "/directory/" :/ "file.ext" <- "/directory/file.ext" + > "file/" :/ "bob.txt" <- "file/bob.txt" + > "./" :/ "bob" <- "bob" + + Posix: + > "/" :/ "" <- "/" + + Windows: + > "c:" :/ "" <- "c:" + + Combine two paths with a path separator. + + If the second path looks like an absolute path or a drive, then it returns the + second. + + > "directory" :/ "/file.ext" == "/file.ext" + + Posix: + > "/directory" :/ "file.ext" == "/directory/file.ext" + > "/" :/ "tmp" == "/tmp" + > "x:" :/ "foo" == "x:/foo" + > "home" :/ "/user" == "/user" + > "home" :/ "user" == "home/user" + + Windows: + > "/directory" :/ "file.ext" == "/directory\\file.ext" + > "C:\\foo" :/ "bar" == "C:\\foo\\bar" + > "home" :/ "C:\\bob" == "C:\\bob" + > "home" :/ "bob" == "home\\bob" + + > "C:\\home" :/ "\\bob" == "\\bob" + > "home" :/ "\\bob" == "\\bob" + > "home" :/ "/bob" == "/bob" + + > "D:\\foo" :/ "C:bar" == "C:bar" + > "C:\\foo" :/ "C:bar" == "C:bar" +-} +pattern (:/) :: FilePath -> FilePath -> FilePath +pattern dir :/ file <- (splitName -> (dir, file)) + where + a :/ b@(drive :\\ _) = headIs isPathSep b || drive /= "" ? b $ a :\\ b + +splitName :: FilePath -> (FilePath, FilePath) +splitName = first (\ dir -> null dir ? "./" $ dir) . dirName + +dirName :: FilePath -> (FilePath, FilePath) +dirName (drive :\\ path) = (drive ++) `first` breakr isPathSep path + +-------------------------------------------------------------------------------- + +{-# COMPLETE Path #-} + +{- | + Separates filepath into a search path - list of ancestors with trailing + separators and file name (if any): + + Posix: + > Path ["/", "home/", "user/", ".ghci"] <- "/home/user/.ghci" + > Path ["/", "home/", "user/"] <- "/home/user/" + > Path ["/", "home/", "user"] <- "/home/user" + + Windows: + > Path ["C:\\", "home\\", "user\\"] <- "C:\\home\\user\\" + > Path ["C:\\", "home\\", "user"] <- "C:\\home\\user" + + 'Path' concatenates the file path regardless of a trailing separator. +-} +pattern Path :: [FilePath] -> FilePath +pattern Path path <- (splitPath -> path) where Path = foldr (:/) [] + +splitPath :: FilePath -> [FilePath] +splitPath (drive :\\ path) = null drive ? f path $ drive : f path + where + f "" = [] + f y = (a ++ c) : f d + where + (a, b) = breakl isPathSep y + (c, d) = spanl isPathSep b + +{-# COMPLETE Dirs #-} + +{- | + Separates filepath into a search path - list of ancestors without trailing + separators and file name (if any): + + Posix: + > Dirs ["/", "home", "user", ".ghci"] <- "/home/user/.ghci" + > Dirs ["/", "home", "user"] <- "/home/user/" + > Dirs ["/", "home", "user"] <- "/home/user" + + Windows: + > Dirs ["C:\\", "home", "user"] <- "C:\\home\\user\\" + > Dirs ["C:\\","home","user"] <- "C:\\home\\user" + + 'Dirs' concatenates the file path regardless of a trailing separator. +-} +pattern Dirs :: [FilePath] -> FilePath +pattern Dirs dirs <- (splitDirs -> dirs) where Dirs = foldr (:/) [] + +splitDirs :: FilePath -> [FilePath] +splitDirs = map stripSlash . splitPath + where + stripSlash (drive :\\ "") = drive + stripSlash path = not (lastIs isPathSep path) ? path $ + case dropEnd isPathSep path of {"" -> [last path]; dir -> dir} + +{-# COMPLETE (://) #-} + +-- | Splits/joins directories and a file name. +pattern (://) :: [FilePath] -> FilePath -> FilePath +pattern dirs :// file <- (splitDirs -> dirs :< file) where (://) = flip $ foldr (:/) + +-------------------------------------------------------------------------------- + +{- Drive split and join. -} + +{-# COMPLETE (:\\) #-} + +{- | + Windows: + > "" :\\ "file" <- "file" + > "c:/" :\\ "file" <- "c:/file" + > "c:\\" :\\ "file" <- "c:\\file" + > "\\\\shared\\" :\\ "test" <- "\\\\shared\\test" + > "\\\\shared" :\\ "" <- "\\\\shared" + > "\\\\?\\UNC\\shared\\" :\\ "file" <- "\\\\?\\UNC\\shared\\file" + > "\\\\?\\" :\\ "UNCshared\\file" <- "\\\\?\\UNCshared\\file" + > "\\\\?\\d:\\" :\\ "file" <- "\\\\?\\d:\\file" + > "" :\\ "/d" <- "/d" + + Posix: + > "/" :\\ "test" <- "/test" + > "//" :\\ "test" <- "//test" + > "" :\\ "test/file" <- "test/file" + > "" :\\ "file" <- "file" +-} +pattern (:\\) :: FilePath -> FilePath -> FilePath +pattern drive :\\ path <- (splitDrive -> (drive, path)) + where + a :\\ b + | null a = b + | null b = a + | isPathSep (last a) = a ++ b +#ifndef IS_POSIX + | c : ":" <- a, isLetter' c = a ++ b +#endif + | True = a ++ PathSep : b + +splitDrive :: FilePath -> (FilePath, FilePath) +#ifdef IS_POSIX +splitDrive = spanl (== '/') +#else +splitDrive path = + let drive = lift (letter <++ unc <++ share) + in ("", path) `fromMaybe` readMaybeBy drive path +#endif + +-------------------------------------------------------------------------------- + +{- Validity. -} + +{- | + Is a 'FilePath' valid? This function checks for invalid names, invalid + characters, but doesn't check if length limits are exceeded, as these are + typically filesystem dependent. + + > isValid "" == False + > isValid "\0" == False + + Posix: + > isValid "/random_ path:*" == True + > isValid x => not (null x) + + Windows: + > isValid "c:\\test" == True + > isValid "c:\\test:of_test" == False + > isValid "test*" == False + > isValid "c:\\test\\nul" == False + > isValid "c:\\test\\prn.txt" == False + > isValid "c:\\nul\\file" == False + > isValid "\\\\" == False + > isValid "\\\\\\foo" == False + > isValid "\\\\?\\D:file" == False + > isValid "foo\tbar" == False + > isValid "nul .txt" == False + > isValid " nul.txt" == True +-} +isValid :: FilePath -> Bool +isValid "" = False +#ifdef IS_POSIX +isValid path = not ('\0' `elem` path) +#else +isValid (drive :\\ path@(Dirs dirs)) = not $ or + [ + any isBadChar path, + any (\ (name :.. _) -> isBadElem name) dirs, + + drive .>= 2 && all isPathSep drive, + isDriveUNC drive && not (lastIs isPathSep drive) + ] +#endif + +{- | + Take a FilePath and make it vali, doesn't change already valid FilePaths: + + > isValid (makeValid x) == True + > isValid x => makeValid x == x + > makeValid "" == "_" + > makeValid "file\0name" == "file_name" + + Windows: + > makeValid "c:\\already\\/valid" == "c:\\already\\/valid" + > makeValid "c:\\test:of_test" == "c:\\test_of_test" + > makeValid "test*" == "test_" + > makeValid "c:\\test\\nul" == "c:\\test\\nul_" + > makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" + > makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt" + > makeValid "c:\\nul\\file" == "c:\\nul_\\file" + > makeValid "\\\\\\foo" == "\\\\drive" + > makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file" + > makeValid "nul .txt" == "nul _.txt" +-} +makeValid :: FilePath -> FilePath +makeValid "" = "_" +#ifdef IS_POSIX +makeValid path = repl (== '\0') '_' path +#else +makeValid (drive :\\ path@(Path paths)) + | drive .>= 2 && all isPathSep drive = take 2 drive ++ "drive" + | isDriveUNC drive && lastIs isPathSep drive = + makeValid (drive ++ "\\" ++ path) + | True = drive :\\ Path (f <$> paths) + where + f = uncurry ((++) . g) . break isPathSep . repl isBadChar '_' + g = \ x@(a :.. b) -> isBadElem a ? a ++ "_" :.. b $ x +#endif + +-------------------------------------------------------------------------------- + +{- Absolute and relative paths. -} + +{- | + Is a path relative, or is it fixed to the root? + + Posix: + > isRelative "test/path" == True + > isRelative "/test" == False + > isRelative "/" == False + + Windows: + + > isRelative "path\\test" == True + > isRelative "c:\\test" == False + > isRelative "c:test" == True + > isRelative "c:\\" == False + > isRelative "c:/" == False + > isRelative "c:" == True + > isRelative "\\\\foo" == False + > isRelative "\\\\?\\foo" == False + > isRelative "\\\\?\\UNC\\foo" == False + > isRelative "/foo" == True + > isRelative "\\foo" == True + + * "A UNC name of any format [is never relative]." + * "You can't use the "\\?\" prefix with a relative path." +-} +isRelative :: FilePath -> Bool +#ifdef IS_POSIX +isRelative (dr :\\ _) = null dr +#else +isRelative (dr :\\ _) = case dr of + (c : ':' : x : _) -> isLetter' c && not (isPathSep x) + [c, ':'] -> isLetter' c + xs -> null xs +#endif + +-- | Same as @not . 'isRelative'@. +isAbsolute :: FilePath -> Bool +isAbsolute = not . isRelative + +-------------------------------------------------------------------------------- + +{- | + Normalise a file name: + * \/\/ outside of the drive can be made blank + * \/ -> 'PathSep' + * .\/ -> \"\" + + > normalise "." == "." + + Posix: + > normalise "/file/\\test////" == "/file/\\test/" + > normalise "/file/./test" == "/file/test" + > normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" + > normalise "../bob/fred/" == "../bob/fred/" + > normalise "./bob/fred/" == "bob/fred/" + + > normalise "./" == "./" + > normalise "./." == "./" + > normalise "/./" == "/" + > normalise "/" == "/" + > normalise "bob/fred/." == "bob/fred/" + > normalise "//home" == "/home" + + Windows: + > normalise "c:\\file/bob\\" == "C:\\file\\bob\\" + > normalise "c:\\" == "C:\\" + > normalise "C:.\\" == "C:" + > normalise "\\\\server\\test" == "\\\\server\\test" + > normalise "//server/test" == "\\\\server\\test" + > normalise "c:/file" == "C:\\file" + > normalise "/file" == "\\file" + > normalise "\\" == "\\" + > normalise "/./" == "\\" +-} +normalise :: FilePath -> FilePath +normalise (drive :\\ path@(Dirs dirs)) = addPathSep ? res :< PathSep $ res + where + res = join' $ normDrive drive :\\ Dirs (f dirs) + + join' x = null x ? "." $ x + + addPathSep = isDirPath path + && not (lastIs isPathSep res) +#ifndef IS_POSIX + && not (isRelativeDrive drive) +#endif + + isDirPath xs = lastIs isPathSep xs || + lastIs (== '.') xs && lastIs isPathSep (init xs) + + f (x : xs) = except ("." ==) $ all isPathSep x ? [PathSep] : xs $ x : xs + f [] = [] + +normDrive :: FilePath -> FilePath +#ifdef IS_POSIX +normDrive dr = null dr ? "" $ [PathSep] +#else +normDrive "" = "" +normDrive dr = isDriveLetter dosDrive ? map toUpper dosDrive $ dosDrive + where + dosDrive = repl (== '/') '\\' dr +#endif + +{- | + Equality of two 'FilePath's. If you call @System.Directory.canonicalizePath@ + first this has a much better chance of working. Note that this doesn't follow + symlinks or DOSNAMEs. + + > x == y ==> equalFilePath x y + > normalise x == normalise y ==> equalFilePath x y + + > equalFilePath "foo" "foo/" + > not (equalFilePath "foo" "/foo") + + Posix: + > not (equalFilePath "foo" "FOO") + + Windows: + > equalFilePath "foo" "FOO" + > not (equalFilePath "C:" "C:/") +-} +equalFilePath :: FilePath -> FilePath -> Bool +equalFilePath = on (==) $ + dropSep . +#ifndef IS_POSIX + map toLower . +#endif + normalise + +dropSep :: FilePath -> FilePath +dropSep xs = lastIs isPathSep xs && notDrive xs ? (null xs' ? [x] $ xs') $ xs + where + notDrive path@(_ :\\ rel) = null path || not (null rel) + + xs' = dropEnd isPathSep xs + x = last xs + +-------------------------------------------------------------------------------- + +{- | + Contract a filename, based on a relative path. Note that the resulting path + will never introduce @..@ paths, as the presence of symlinks means @..\/b@ may + not reach @a\/b@ if it starts from @a\/c@. For a worked example see + . + + The corresponding @makeAbsolute@ function can be found in @System.Directory@. + + > makeRelative "/directory" "/directory/file.ext" == "file.ext" + > Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x + > makeRelative x x == "." + > Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x + + Posix: + > makeRelative "/Home" "/home/bob" == "/home/bob" + > makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar" + > makeRelative "/fred" "bob" == "bob" + > makeRelative "/file/test" "/file/test/fred" == "fred" + > makeRelative "/file/test" "/file/test/fred/" == "fred/" + > makeRelative "some/path" "some/path/a/b/c" == "a/b/c" + + Windows: + > makeRelative "C:\\Home" "c:\\home\\bob" == "bob" + > makeRelative "C:\\Home" "c:/home/bob" == "bob" + > makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob" + > makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob" + > makeRelative "/Home" "/home/bob" == "bob" + > makeRelative "/" "//" == "//" +-} +makeRelative :: FilePath -> FilePath -> FilePath +makeRelative root path + | equalFilePath root path = "." + | takeAbs root /= takeAbs path = path + | True = dropAbs root `f` dropAbs path + where + f "" y = dropWhile isPathSep y + f x y = equalFilePath x1 y1 ? f x2 y2 $ path + where + (x1, x2) = g x + (y1, y2) = g y + + g = double bimap (dropWhile isPathSep) . break isPathSep . dropWhile isPathSep + + dropAbs pth@(drv :\\ rel) = headIs isPathSep pth && null drv ? tail pth $ rel + takeAbs pth@(drv :\\ _) = headIs isPathSep pth && null drv ? [PathSep] $ map (\ y -> isPathSep y ? PathSep $ toLower y) drv + +-------------------------------------------------------------------------------- + +{- Windefs. -} + +#ifndef IS_POSIX +isDriveLetter :: String -> Bool +isDriveLetter x2 = isJust (readMaybeBy (lift letter) x2) + +isDriveUNC :: String -> Bool +isDriveUNC = isJust . readMaybeBy (lift unc) + +isRelativeDrive :: String -> Bool +isRelativeDrive = + maybe False (not . lastIs isPathSep . fst) . readMaybeBy (lift letter) + +isBadElem :: FilePath -> Bool +isBadElem = (`elem` badElems) . fmap toUpper . dropEnd (== ' ') + +badElems :: [FilePath] +badElems = + [ + "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", + "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", + "CON", "PRN", "AUX", "NUL", "CLOCK$" + ] + +isBadChar :: Char -> Bool +isBadChar x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\"" + +unc :: ReadP (String, String) +unc = do sep; sep; void (char '?'); sep; long <++ short + where + long = do ci "UNC"; sep; first ("\\\\?\\UNC\\" ++) <$> shareName + ci = mapM_ $ \ c -> char (toLower c) <++ char (toUpper c) + short = first ("\\\\?\\" ++) <$> letter + +share :: ReadP (String, String) +share = do sep; sep; first ("\\\\" ++) <$> shareName + +shareName :: ReadP (String, String) +shareName = (do x <- manyTill get sep; y <- end; return (x :< '\\', y)) <++ + (do x <- end; return (x, "")) + +letter :: ReadP (String, String) +letter = do c <- satisfy isLetter'; void (char ':'); slash [c, ':'] <$> end + +slash :: String -> String -> (String, String) +slash a = first (a ++) . span isPathSep + +end :: ReadP String +end = manyTill get eof + +sep :: ReadP () +sep = void (satisfy isPathSep) + +isLetter' :: Char -> Bool +isLetter' x = isAsciiLower x || isAsciiUpper x +#endif + +-------------------------------------------------------------------------------- + +headIs :: (Char -> Bool) -> String -> Bool +headIs f es = not (null es) && f (head es) + +lastIs :: (Char -> Bool) -> String -> Bool +lastIs f es = not (null es) && f (last es) + +repl :: (a -> Bool) -> a -> ([a] -> [a]) +repl = \ f n -> map $ \ c -> f c ? n $ c + +double :: (a -> a -> b) -> a -> b +double = \ f x -> f x x + + + diff --git a/src/System/IO/Classes.hs b/src/System/IO/Classes.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Classes.hs @@ -0,0 +1,215 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-} + +{- | + Module : System.IO.Classes + Copyright : (c) Andrey Mulik 2020 + License : BSD-style + Maintainer : work.a.mulik@gmail.com + Portability : portable + + @System.IO.Classes@ provides generalized path and file classes. +-} +module System.IO.Classes +( + -- * Export + module System.IO.Handle, + module System.IO.Error, + + -- * Generalized path + IsFilePath (..), + + -- * Generalized file + IsFile (..), getContents, putContents, withFile, readFile, writeFile, appendFile, + + -- ** Text IO + IsTextFile (..), getLine, putStr, putStrLn, gets, puts +) +where + +import Prelude () +import SDP.SafePrelude + +import Data.FilePath + +import qualified System.IO as IO +import System.IO.Handle +import System.IO.Error + +import Control.Exception + +default () + +-------------------------------------------------------------------------------- + +-- | 'IsFilePath' is type class of file path (data destination) representations. +class IsFilePath path + where + {- | + @hOpen path mode@ open new text handle with block buffering and given + @mode@ using @path@ identifier. + + This operation may fail with: + + * @isAlreadyInUseError@ if the file is already open and cannot be reopened + * @isDoesNotExistError@ if the file does not exist + * @isPermissionError@ if the user doesn't have permission to open the file + -} + hOpen :: (MonadIO io) => IOMode -> path -> io Handle + hOpen mode path = hOpenWith mode path (BlockBuffering Nothing) False + + {- | + @hOpenWith path mode buf bin@ open new handle with buffering mode @buf@, + binary mode @bin@ and 'IOMode' @mode@ using @path@ identifier. + + This operation may fail with: + + * 'isAlreadyInUseError' if the file is already open and cannot be reopened + * 'isDoesNotExistError' if the file does not exist + * 'isPermissionError' if the user doesn't have permission to open the file + -} + hOpenWith :: (MonadIO io) => IOMode -> path -> BufferMode -> Bool -> io Handle + + -- | Open new temp file 'Handle' by given source identifier. + hOpenTemp :: (MonadIO io) => path -> io (path, Handle) + +-------------------------------------------------------------------------------- + +{- | + 'IsFile' is a type class that represents the contents of a file. + + 'IsFile' provides only basic read and write operations. It doesn't allow, for + example, changing the 'IOMode' or handle the concatenation of the file + contents with the appendable information. +-} +class IsFile file + where + {- | + @hGetContents hdl@ reads the contents of the file. Reading may be both + lazily (in this case @hdl@ should be semi-closed until the file end is + reached) or strictly. After reading the file, @hdl@ should be closed. + + Once a semi-closed handle becomes closed, the contents becomes fixed. + The contents of this final value is only partially specified: it will + contain at least all the items of the stream that were evaluated prior to + the handle becoming closed. + + This operation may fail with: + + * isEOFError if the end of file has been reached. + -} + hGetContents :: (MonadIO io) => Handle -> io file + + {- | + @hPutContents hdl file@ writes the @file@ contents to @hdl@. + + This operation may fail with: + + * 'isFullError' if the device is full; or + * 'isPermissionError' if another system resource limit would be exceeded. + + If 'hPutContents' changes the recording mode (buffering, binary/text), + it should return the original Handle settings. + -} + hPutContents :: (MonadIO io) => Handle -> file -> io () + +-- | Just 'hGetContents' 'stdin'. +getContents :: (MonadIO io, IsFile file) => io file +getContents = hGetContents stdin + +-- | Just 'hPutContents' 'stdout'. +putContents :: (MonadIO io, IsFile file) => file -> io () +putContents = hPutContents stdout + +-------------------------------------------------------------------------------- + +{- | + @withFile path mode act@ opens a file using 'hOpen' and passes the resulting + handle to the computation @act@. The handle will be closed on exit from + @withFile@, whether by normal termination or by raising an exception. + + If closing the handle raises an exception, then this exception will be raised + by withFile rather than any exception raised by act. +-} +withFile :: (MonadIO io, IsFilePath path) => path -> IOMode -> (Handle -> IO a) -> io a +withFile path mode = liftIO . bracket (hOpen mode path) hClose + +{- | + The 'readFile' function reads a file and returns its contents. + + The specifics of reading a file (laziness/strictness, possible exceptions) + depend on the type of resource and the 'hGetContents' implementation. +-} +readFile :: (MonadIO io, IsFilePath p, IsFile f) => p -> io f +readFile = hOpen ReadMode >=> hGetContents + +-- | @writeFile path file@ function writes the @file@ value, to the @path@. +writeFile :: (MonadIO io, IsFilePath p, IsFile f) => p -> f -> io () +writeFile path file = withFile path WriteMode (`hPutContents` file) + +-- | @appendFile path file@ appends the @file@ value, to the @path@. +appendFile :: (MonadIO io, IsFilePath p, IsFile f) => p -> f -> io () +appendFile path file = withFile path AppendMode (`hPutContents` file) + +-------------------------------------------------------------------------------- + +-- | 'IsTextFile' is a type class of text file representations. +class (IsFile text) => IsTextFile text + where + -- | Read one text line from handle. + hGetLine :: (MonadIO io) => Handle -> io text + + -- | Put text to handle. + hPutStr :: (MonadIO io) => Handle -> text -> io () + + -- | Put text line to handle. + hPutStrLn :: (MonadIO io) => Handle -> text -> io () + hPutStrLn hdl text = do hPutStr hdl text; hPutChar hdl '\n' + +-------------------------------------------------------------------------------- + +-- | Same as @hGetLine stdin@. +getLine :: (MonadIO io, IsTextFile text) => io text +getLine = hGetLine stdin + +-- | Same as @hPutStr stdout@. +putStr :: (MonadIO io, IsTextFile text) => text -> io () +putStr = hPutStr stdout + +-- | Same as @hPutStrLn stdout@. +putStrLn :: (MonadIO io, IsTextFile text) => text -> io () +putStrLn = hPutStrLn stdout + +-- | Short version of 'getLine'. +gets :: (MonadIO io, IsTextFile text) => io text +gets = getLine + +-- | Short version of 'putStrLn'. +puts :: (MonadIO io, IsTextFile text) => text -> io () +puts = putStrLn + +-------------------------------------------------------------------------------- + +instance IsFilePath FilePath + where + hOpen = liftIO ... flip IO.openFile + + hOpenWith mode path buf bin = do + h <- hOpen mode path + hSetBuffering h buf + hSetBinaryMode h bin + return h + + hOpenTemp (dir :/ name) = liftIO $ first (dir :/) <$> IO.openTempFile dir name + +instance IsFile String + where + hGetContents = liftIO . IO.hGetContents + hPutContents = liftIO ... IO.hPutStr + +instance IsTextFile String + where + hPutStrLn = liftIO ... IO.hPutStrLn + hGetLine = liftIO . IO.hGetLine + hPutStr = liftIO ... IO.hPutStr + + diff --git a/src/System/IO/Handle.hs b/src/System/IO/Handle.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Handle.hs @@ -0,0 +1,615 @@ +{- | + Module : System.Handle + Copyright : (c) Andrey Mulik 2020 + License : BSD-style + Maintainer : work.a.mulik@gmail.com + Portability : portable + + @System.IO.Handle@ is safe import of "System.IO". +-} +module System.IO.Handle +( + -- * Handles + Handle, hClose, + + -- ** Standard handles + stdin, stdout, stderr, + + -- ** IO mode + IOMode (..), + + -- ** File size + hGetFileSize, hSetFileSize, fileSize, + + -- ** Detecting the end of input + isEOF, hIsEOF, + + -- ** Buffering + BufferMode (..), hFlush, hSetBuffering, hGetBuffering, hBuffering, + + -- ** Repositioning + HandlePosn, hGetPosn, hSetPosn, + + SeekMode (..), hSeek, hTell, + + -- ** Properties + hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable, + + -- * Terminal operations (not portable: GHC only) + hIsTerminalDevice, hSetEcho, hGetEcho, echo, + + -- * Text IO + hWaitForInput, hReady, hLookAhead, + + hGetChar, hPutChar, getChar, putChar, + + -- * Binary IO + hSetBinaryMode, withBinaryFile, openBinaryFile, + + hGetBuf, hGetBufSome, hPutBuf, hPutBufNonBlocking, hGetBufNonBlocking, + + -- * Temporary files + openTempFile, openBinaryTempFile, openTempFileWith', openBinaryTempFile', + + -- * Encoding + hSetEncoding, hGetEncoding, encoding, + + TextEncoding, mkTextEncoding, localeEncoding, char8, latin1, utf8, utf8_bom, + utf16, utf16le, utf16be, utf32, utf32le, utf32be, + + -- * Newline conversion + Newline (..), NewlineMode (..), nativeNewline, hSetNewlineMode, + + noNewlineTranslation, universalNewlineMode, nativeNewlineMode +) +where + +import Prelude () +import SDP.SafePrelude + +import qualified System.IO as IO +import System.IO + ( + TextEncoding, Newline (..), NewlineMode (..), localeEncoding, char8, latin1, + + Handle, HandlePosn, IOMode (..), BufferMode (..), SeekMode (..), + + noNewlineTranslation, universalNewlineMode, nativeNewlineMode, nativeNewline, + + utf8, utf8_bom, utf16, utf16le, utf16be, utf32, utf32le, utf32be, + + stdin, stdout, stderr + ) + +import Foreign.Ptr ( Ptr ) + +import Data.Field + +default () + +-------------------------------------------------------------------------------- + +{- | + Computation @'hClose' hdl@ makes handle @hdl@ closed. Before the computation + finishes, if @hdl@ is writable its buffer is flushed as for 'hFlush'. + Performing 'hClose' on a handle that has already been closed has no effect; + doing so is not an error. All other operations on a closed handle will fail. + If 'hClose' fails for any reason, any further operations (apart from 'hClose') + on the handle will still fail as if @hdl@ had been successfully closed. +-} +hClose :: (MonadIO io) => Handle -> io () +hClose = liftIO . IO.hClose + +-------------------------------------------------------------------------------- + +{- | + For a handle @hdl@ which attached to a physical file, @'fileSize' hdl@ + returns the size of that file in 8-bit bytes. +-} +hGetFileSize :: (MonadIO io) => Handle -> io Integer +hGetFileSize = liftIO . IO.hFileSize + +{- | + @'hSetFileSize' hdl size@ truncates the physical file with handle @hdl@ to + @size@ bytes. +-} +hSetFileSize :: (MonadIO io) => Handle -> Integer -> io () +hSetFileSize = liftIO ... IO.hSetFileSize + +-- | File size 'Field'. +fileSize :: (MonadIO io) => Field io Handle Integer +fileSize = hGetFileSize `sfield` hSetFileSize + +-------------------------------------------------------------------------------- + +-- | Computation 'isEOF' is equal to @'hIsEOF' 'stdin'@ +isEOF :: (MonadIO io) => io Bool +isEOF = liftIO IO.isEOF + +{- | + For a readable handle @hdl@, @'hIsEOF' hdl@ returns 'True' if no further input + can be taken from @hdl@ or for a physical file, if the current I/O position is + equal to the length of the file. Otherwise, it returns 'False'. + + NOTE: 'hIsEOF' may block, because it has to attempt to read from the stream to + determine whether there is any more data to be read. +-} +hIsEOF :: (MonadIO io) => Handle -> io Bool +hIsEOF = liftIO . IO.hIsEOF + +-------------------------------------------------------------------------------- + +{- | + The action @'hFlush' hdl@ causes any items buffered for output in handle @hdl@ + to be sent immediately to the operating system. + + This operation may fail with: + + * 'System.IO.Error.isFullError' if the device is full; + * 'System.IO.Error.isPermissionError' if a system resource limit would be + exceeded. It is unspecified whether the characters in the buffer are discarded + or retained under these circumstances. +-} +hFlush :: (MonadIO io) => Handle -> io () +hFlush = liftIO . IO.hFlush + +{- | + @'hSetBuffering' hdl mode@ sets the mode of buffering for handle @hdl@ on + subsequent reads and writes. + + If the buffer mode is changed from 'BlockBuffering' or 'LineBuffering' to + 'NoBuffering', then + + * if @hdl@ is writable, the buffer is flushed as for 'hFlush'; + * if @hdl@ is not writable, the contents of the buffer is discarded. + + This operation may fail with: + + * 'System.IO.Error.isPermissionError' if the handle has already been used + for reading or writing and the implementation does not allow the buffering + mode to be changed. +-} +hSetBuffering :: (MonadIO io) => Handle -> BufferMode -> io () +hSetBuffering = liftIO ... IO.hSetBuffering + +-- | @'hGetBuffering' hdl@ returns the current buffering mode for @hdl@. +hGetBuffering :: (MonadIO io) => Handle -> io BufferMode +hGetBuffering = liftIO . IO.hGetBuffering + +-- | 'Handle' buffering 'Field'. +hBuffering :: (MonadIO io) => Field io Handle BufferMode +hBuffering = hGetBuffering `sfield` hSetBuffering + +-------------------------------------------------------------------------------- + +{- | + @'hGetPosn' hdl@ returns the current I/O position of @hdl@ as a value of the + abstract type @HandlePosn@. +-} +hGetPosn :: (MonadIO io) => Handle -> io HandlePosn +hGetPosn = liftIO . IO.hGetPosn + +{- | + If a call to @'hGetPosn' hdl@ returns a position @p@, then @'hSetPosn' p@ sets + the position of @hdl@ to the position it held at the time of the call to + 'hGetPosn'. + + This operation may fail with: + + * 'System.IO.Error.isPermissionError' if a system resource limit would be + exceeded. +-} +hSetPosn :: (MonadIO io) => HandlePosn -> io () +hSetPosn = liftIO . IO.hSetPosn + +-------------------------------------------------------------------------------- + +{- | + @'hSeek' hdl mode i@ sets the position of handle @hdl@ depending on @mode@. + The offset @i@ is given in terms of 8-bit bytes. + + If @hdl@ is block- or line-buffered, then seeking to a position which isn't in + the current buffer will first cause any items in the output buffer to be + written to the device, and then cause the input buffer to be discarded. Some + handles may not be seekable (see 'hIsSeekable'), or only support a subset of + the possible positioning operations (for instance, it may only be possible to + seek to the end of a tape, or to a positive offset from the beginning or + current position). It isn't possible to set a negative I/O position, or for a + physical file, an I/O position beyond the current end-of-file. + + This operation may fail with: + + * 'System.IO.Error.isIllegalOperationError' if the 'Handle' isn't seekable, or + doesn't support the requested seek mode. + * 'System.IO.Error.isPermissionError' if a system resource limit would be + exceeded. +-} +hSeek :: (MonadIO io) => Handle -> IO.SeekMode -> Integer -> io () +hSeek hdl = liftIO ... IO.hSeek hdl + +{- | + @'hTell' hdl@ returns the current position of the handle @hdl@, as the number + of bytes from the beginning of the file. The value returned may be + subsequently passed to 'hSeek' to reposition the handle to the current + position. + + This operation may fail with: + + * 'System.IO.Error.isIllegalOperationError' if the Handle isn't seekable. +-} +hTell :: (MonadIO io) => Handle -> io Integer +hTell = liftIO . IO.hTell + +-------------------------------------------------------------------------------- + +-- | Same as 'IO.hIsOpen'. +hIsOpen :: (MonadIO io) => Handle -> io Bool +hIsOpen = liftIO . IO.hIsOpen + +-- | Same as 'IO.hIsClosed'. +hIsClosed :: (MonadIO io) => Handle -> io Bool +hIsClosed = liftIO . IO.hIsClosed + +-- | Same as 'IO.hIsReadable'. +hIsReadable :: (MonadIO io) => Handle -> io Bool +hIsReadable = liftIO . IO.hIsReadable + +-- | Same as 'IO.hIsWritable'. +hIsWritable :: (MonadIO io) => Handle -> io Bool +hIsWritable = liftIO . IO.hIsWritable + +-- | Same as 'IO.hIsSeekable'. +hIsSeekable :: (MonadIO io) => Handle -> io Bool +hIsSeekable = liftIO . IO.hIsSeekable + +-------------------------------------------------------------------------------- + +-- | Is the handle connected to a terminal? +hIsTerminalDevice :: (MonadIO io) => Handle -> io Bool +hIsTerminalDevice = liftIO . IO.hIsTerminalDevice + +-- | Set the echoing status of a handle connected to a terminal. +hSetEcho :: (MonadIO io) => Handle -> Bool -> io () +hSetEcho = liftIO ... IO.hSetEcho + +-- | Get the echoing status of a handle connected to a terminal. +hGetEcho :: (MonadIO io) => Handle -> io Bool +hGetEcho = liftIO . IO.hGetEcho + +-- | Echo 'Field'. +echo :: (MonadIO io) => Field io Handle Bool +echo = hGetEcho `sfield` hSetEcho + +-------------------------------------------------------------------------------- + +{- | + @'hWaitForInput' hdl t@ waits until input is available on handle @hdl@. + It returns 'True' as soon as input is available on @hdl@, or 'False' if no + input is available within @t@ milliseconds. Note that @hWaitForInput@ waits + until one or more full characters are available, which means that it needs to + do decoding, and hence may fail with a decoding error. + + If @t@ is less than zero, then 'hWaitForInput' waits indefinitely. + + This operation may fail with: + + * 'System.IO.Error.isEOFError' if the end of file has been reached. + * a decoding error, if the input begins with an invalid byte sequence in this + Handle's encoding. + + NOTE for GHC users: unless you use the -threaded flag, + @'hWaitForInput' hdl t where t >= 0@ will block all other Haskell threads for + the duration of the call. It behaves like a safe foreign call in this respect. +-} +hWaitForInput :: (MonadIO io) => Handle -> Int -> io Bool +hWaitForInput = liftIO ... IO.hWaitForInput + +{- | + @'hReady' hdl@ indicates whether at least one item is available for input from + handle @hdl@. + + This operation may fail with: + + * 'System.IO.Error.isEOFError' if the end of file has been reached. +-} +hReady :: (MonadIO io) => Handle -> io Bool +hReady = liftIO . IO.hReady + +{- | + Computation @'hGetChar' hdl@ reads a character from the file or channel + managed by @hdl@, blocking until a character is available. + + This operation may fail with: + + * 'System.IO.Error.isEOFError' if the end of file has been reached. +-} +hLookAhead :: (MonadIO io) => Handle -> io Char +hLookAhead = liftIO . IO.hLookAhead + +-------------------------------------------------------------------------------- + +{- | + @'hGetChar' hdl@ reads a character from the file or channel managed by @hdl@, + blocking until a character is available. + + This operation may fail with: + + * 'System.IO.Error.isEOFError' if the end of file has been reached. +-} +hGetChar :: (MonadIO io) => Handle -> io Char +hGetChar = liftIO . IO.hGetChar + +{- | + Computation @'hPutChar' hdl ch@ writes the character @ch@ to the file or + channel managed by @hdl@. Characters may be buffered if buffering is enabled + for @hdl@. + + This operation may fail with: + + * 'System.IO.Error.isPermissionError' if another system resource limit would + be exceeded + * 'System.IO.Error.isFullError' if the device is full +-} +hPutChar :: (MonadIO io) => Handle -> Char -> io () +hPutChar = liftIO ... IO.hPutChar + +-- | Read a character from the standard input device, @'hGetChar' 'stdin'@. +getChar :: (MonadIO io) => io Char +getChar = liftIO IO.getChar + +-- | Write a character to the standard output device @'hPutChar' 'stdout'@. +putChar :: (MonadIO io) => Char -> io () +putChar = liftIO . IO.putChar + +-------------------------------------------------------------------------------- + +{- | + Select binary mode ('True') or text mode ('False') on a open handle. + + This has the same effect as calling 'hSetEncoding' with 'char8', together with + 'hSetNewlineMode' with 'noNewlineTranslation'. +-} +hSetBinaryMode :: (MonadIO io) => Handle -> Bool -> io () +hSetBinaryMode = liftIO ... IO.hSetBinaryMode + +{- | + @'withBinaryFile' name mode act@ opens a file using 'openBinaryFile' and + passes the resulting handle to the computation @act@. The handle will be + closed on exit from 'withBinaryFile', whether by normal termination or by + raising an exception. +-} +withBinaryFile :: (MonadIO io) => FilePath -> IOMode -> (Handle -> IO r) -> io r +withBinaryFile path = liftIO ... IO.withBinaryFile path + +{- | + Like 'IO.openFile', but open the file in binary mode. On Windows, reading a + file in text mode (which is the default) will translate CRLF to LF, and + writing will translate LF to CRLF. This is usually what you want with text + files. With binary files this is undesirable; also, as usual under MS OSes, + text mode treats control-Z as EOF. Binary mode turns off all special treatment + of end-of-line and end-of-file characters. +-} +openBinaryFile :: (MonadIO io) => FilePath -> IOMode -> io Handle +openBinaryFile = liftIO ... IO.openBinaryFile + +-------------------------------------------------------------------------------- + +{- | + @'hGetBuf' hdl buf count@ reads data from the handle @hdl@ into the buffer + @buf@ until either EOF is reached or count 8-bit bytes have been read. It + returns the number of bytes actually read. This may be zero if EOF was reached + before any data was read (or if count is zero). + + 'hGetBuf' never raises an EOF exception, instead it returns a value smaller + than count. + + If the handle is a pipe or socket, and the writing end is closed, 'hGetBuf' + will behave as if EOF was reached. + + 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode' on the + 'Handle', and reads bytes directly. +-} +hGetBuf :: (MonadIO io) => Handle -> Ptr a -> Int -> io Int +hGetBuf hdl = liftIO ... IO.hGetBuf hdl + +{- | + @'hGetBufSome' hdl buf count@ reads data from the handle @hdl@ into the buffer + @buf@. If there is any data available to read, then 'hGetBufSome' returns it + immediately; it only blocks if there is no data to be read. + + It returns the number of bytes actually read. This may be zero if EOF was + reached before any data was read (or if count is zero). + + 'hGetBufSome' never raises an EOF exception, instead it returns a value + smaller than count. + + If the handle is a pipe or socket, and the writing end is closed, + 'hGetBufSome' will behave as if EOF was reached. + + 'hGetBufSome' ignores the prevailing 'TextEncoding' and 'NewlineMode' on the + 'Handle', and reads bytes directly. +-} +hGetBufSome :: (MonadIO io) => Handle -> Ptr a -> Int -> io Int +hGetBufSome hdl = liftIO ... IO.hGetBufSome hdl + +{- | + @'hPutBuf' hdl buf count@ writes count 8-bit bytes from the buffer @buf@ to + the handle @hdl@. + + 'hPutBuf' ignores any text encoding that applies to the 'Handle', writing the + bytes directly to the underlying file or device. + + This operation may fail with: + + * 'GHC.IO.Exception.ResourceVanished' if the handle is a pipe or socket, and + the reading end is closed. (If this is a POSIX system, and the program has not + asked to ignore SIGPIPE, then a SIGPIPE may be delivered instead, whose + default action is to terminate the program). +-} +hPutBuf :: (MonadIO io) => Handle -> Ptr a -> Int -> io () +hPutBuf hdl = liftIO ... IO.hPutBuf hdl + +{- | + @'hGetBufNonBlocking' hdl buf count@ reads data from the handle @hdl@ into the + buffer @buf@ until either EOF is reached, or count 8-bit bytes have been read, + or there is no more data available to read immediately. + + 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will never + block waiting for data to become available, instead it returns only whatever + data is available. To wait for data to arrive before calling + 'hGetBufNonBlocking', use 'hWaitForInput'. + + If the handle is a pipe or socket, and the writing end is closed, + 'hGetBufNonBlocking' will behave as if EOF was reached. + + 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and 'NewlineMode' + on the 'Handle', and reads bytes directly. + + NOTE: on Windows, this function doesn't work correctly; it behaves + identically to 'hGetBuf'. +-} +hPutBufNonBlocking :: (MonadIO io) => Handle -> Ptr a -> Int -> io Int +hPutBufNonBlocking hdl = liftIO ... IO.hPutBufNonBlocking hdl + +{- | + @'hGetBufNonBlocking' hdl buf count@ reads data from the handle @hdl@ into the + buffer @buf@ until either EOF is reached, or count 8-bit bytes have been read, + or there is no more data available to read immediately. + + 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will never + block waiting for data to become available, instead it returns only whatever + data is available. To wait for data to arrive before calling + 'hGetBufNonBlocking', use 'hWaitForInput'. + + If the handle is a pipe or socket, and the writing end is closed, + 'hGetBufNonBlocking' will behave as if EOF was reached. + + 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and 'NewlineMode' + on the 'Handle', and reads bytes directly. + + NOTE: on Windows, this function doesn't work correctly; it behaves identically + to 'hGetBuf'. +-} +hGetBufNonBlocking :: (MonadIO io) => Handle -> Ptr a -> Int -> io Int +hGetBufNonBlocking hdl = liftIO ... IO.hGetBufNonBlocking hdl + +-------------------------------------------------------------------------------- + +{- | + Set the 'NewlineMode' on the specified Handle. All buffered data is flushed + first. +-} +hSetNewlineMode :: (MonadIO io) => Handle -> NewlineMode -> io () +hSetNewlineMode = liftIO ... IO.hSetNewlineMode + +{- | + Look up the named Unicode encoding. May fail with + + * isDoesNotExistError if the encoding is unknown + + The set of known encodings is system-dependent, but includes at least: + + * UTF-8 + * UTF-16, UTF-16BE, UTF-16LE + * UTF-32, UTF-32BE, UTF-32LE + + There is additional notation (borrowed from GNU iconv) for specifying how + illegal characters are handled: + + * a suffix of //IGNORE, e.g. UTF-8//IGNORE, will cause all illegal sequences + on input to be ignored, and on output will drop all code points that have no + representation in the target encoding. + * a suffix of //TRANSLIT will choose a replacement character for illegal + sequences or code points. + * a suffix of //ROUNDTRIP will use a PEP383-style escape mechanism to + represent any invalid bytes in the input as Unicode codepoints (specifically, + as lone surrogates, which are normally invalid in UTF-32). Upon output, these + special codepoints are detected and turned back into the corresponding + original byte. + + In theory, this mechanism allows arbitrary data to be roundtripped via a + String with no loss of data. In practice, there are two limitations to be + aware of: + + * This only stands a chance of working for an encoding which is an ASCII + superset, as for security reasons we refuse to escape any bytes smaller than + 128. Many encodings of interest are ASCII supersets (in particular, you can + assume that the locale encoding is an ASCII superset) but many (such as + UTF-16) are not. + * If the underlying encoding is not itself roundtrippable, this mechanism can + fail. Roundtrippable encodings are those which have an injective mapping into + Unicode. Almost all encodings meet this criteria, but some do not. Notably, + Shift-JIS (CP932) and Big5 contain several different encodings of the same + Unicode codepoint. + + On Windows, you can access supported code pages with the prefix CP; for + example, "CP1250". +-} +mkTextEncoding :: (MonadIO io) => String -> io TextEncoding +mkTextEncoding = liftIO . IO.mkTextEncoding + +{- | + @'hSetEncoding' hdl@ encoding changes the text encoding for the handle @hdl@ + to encoding. The default encoding when a 'Handle' is created is + 'localeEncoding', namely the default encoding for the current locale. + + To create a 'Handle' with no encoding at all, use 'openBinaryFile'. To stop + further encoding or decoding on an existing 'Handle', use 'hSetBinaryMode'. + + 'hSetEncoding' may need to flush buffered data in order to change the encoding +-} +hSetEncoding :: (MonadIO io) => Handle -> TextEncoding -> io () +hSetEncoding = liftIO ... hSetEncoding + +{- | + Return the current 'TextEncoding' for the specified 'Handle', or 'Nothing' if + the 'Handle' is in binary mode. + + Note that the 'TextEncoding' remembers nothing about the state of the + encoder/decoder in use on this 'Handle'. For example, if the encoding in use + is @UTF-16@, then using 'hGetEncoding' and 'hSetEncoding' to save and restore + the encoding may result in an extra byte-order-mark being written to the file. +-} +hGetEncoding :: (MonadIO io) => Handle -> io (Maybe TextEncoding) +hGetEncoding = liftIO . IO.hGetEncoding + +-- | Encoding 'Field', @set hdl [encoding := Nothing] = hSetBinaryMode hdl True@ +encoding :: (MonadIO io) => Field io Handle (Maybe TextEncoding) +encoding = + let setter hdl = hSetBinaryMode hdl True `maybe` hSetEncoding hdl + in hGetEncoding `sfield` setter + +-------------------------------------------------------------------------------- + +{- | + The function creates a temporary file in 'ReadWriteMode'. The created file + isn't deleted automatically, so you need to delete it manually. + + The file is created with permissions such that only the current user can + read/write it. + + With some exceptions (see below), the file will be created securely in the + sense that an attacker should not be able to cause 'openTempFile' to overwrite + another file on the filesystem using your credentials, by putting symbolic + links (on Unix) in the place where the temporary file is to be created. On + Unix the O_CREAT and O_EXCL flags are used to prevent this attack, but note + that O_EXCL is sometimes not supported on NFS filesystems, so if you rely on + this behaviour it is best to use local filesystems only. +-} +openTempFile :: (MonadIO io) => FilePath -> String -> io (FilePath, Handle) +openTempFile = liftIO ... IO.openTempFile + +-- | Like 'openTempFile', but opens the file in binary mode. +openBinaryTempFile :: (MonadIO io) => FilePath -> String -> io (FilePath, Handle) +openBinaryTempFile = liftIO ... IO.openBinaryTempFile + +-- | Like 'openTempFile', but uses the default file permissions. +openTempFileWith' :: (MonadIO io) => FilePath -> String -> io (FilePath, Handle) +openTempFileWith' = liftIO ... IO.openTempFileWithDefaultPermissions + +-- | Like 'openBinaryTempFile', but uses the default file permissions. +openBinaryTempFile' :: (MonadIO io) => FilePath -> String -> io (FilePath, Handle) +openBinaryTempFile' = liftIO ... IO.openBinaryTempFileWithDefaultPermissions + + +