sdp-io (empty) → 0.2
raw patch · 6 files changed
+1602/−0 lines, 6 filesdep +basedep +fmrdep +sdpsetup-changed
Dependencies added: base, fmr, sdp
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- sdp-io.cabal +45/−0
- src/Data/FilePath.hs +695/−0
- src/System/IO/Classes.hs +215/−0
- src/System/IO/Handle.hs +615/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ sdp-io.cabal view
@@ -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+
+ src/Data/FilePath.hs view
@@ -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+ <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.+ + 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+++
+ src/System/IO/Classes.hs view
@@ -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++
+ src/System/IO/Handle.hs view
@@ -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+++