uniform-fileio (empty) → 0.1.0
raw patch · 17 files changed
+2303/−0 lines, 17 filesdep +HTFdep +basedep +bytestringsetup-changed
Dependencies added: HTF, base, bytestring, deepseq, directory, exceptions, filepath, monads-tf, path, path-io, pipes, pureMD5, quickcheck-text, safe, test-invariant, text, uniform-algebras, uniform-error, uniform-fileio, uniform-strings, uniform-time, unix, zlib
Files
- ChangeLog.md +10/−0
- README.md +23/−0
- Setup.hs +6/−0
- Uniform/FileIO.hs +32/−0
- Uniform/FileIOalgebra.hs +168/−0
- Uniform/FileStatus.hs +67/−0
- Uniform/FileStrings.hs +394/−0
- Uniform/Filenames.hs +277/−0
- Uniform/Piped.hs +92/−0
- Uniform/TypedFile.hs +292/−0
- tests/Testing.hs +52/−0
- tests/Uniform/FileStatus_test.hs +43/−0
- tests/Uniform/FileStrings_test.hs +271/−0
- tests/Uniform/Filenames_test.hs +299/−0
- tests/Uniform/Piped_test.hs +100/−0
- tests/Uniform/TypedFile_test.hs +74/−0
- uniform-fileio.cabal +103/−0
+ ChangeLog.md view
@@ -0,0 +1,10 @@+0.0.16+ move from versions in Workspace8 2019+ 0.0.8 for use in litText+ 0.0.11 fixed callIO and use callIO everywhere+ 0.0.12 changed to use path library for filnames+ 0.0.14.2 changed copyFile' to copyOneFile renameOneFile+ 0.0.14.3 path without wrapper + 0.0.14.6 fix fileExtension confusion+ 0.0.15.0 fix building issue with time + 0.0.15.2 lts 16.0
+ README.md view
@@ -0,0 +1,23 @@+Uniform methods to access data in files.++Goals:++- same functions with identical semantics independent of representation++- all functions are total (or become so using `Maybe` or `Either`)++- performance is NOT a goal - once the program logic is confirmed and tested, performance improvements can be achieved based on observations. The goal for "uniform" is reducing the complexity for the designer of a program - performance improvement come when the logic is correct. ++Specifically:++- a file path can be given as `Filepath` (which is a string) or as a `Path`, which different types for directories and files and for absolute and relative path, to reduce confusing.++- functions to work on file path independent of representation++- functions to access file with either type of path representation++- operations are total; failures of file operations are signaled by ErrorT or Either returns.++Experimentally:++- `TypedFile.hs` tries to extend a type concept from the representation in memory to a representation on file (indicated by the file extension). It proposes a set of functions to read structured files into structured data - selected by the extensions.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ Uniform/FileIO.hs view
@@ -0,0 +1,32 @@+----------------------------------------------------------------------+--+-- Module : FileIO+-- Copyright : andrew u frank -+--+-- | the basic file io - translated for the Either or ErrorT signaling style+-- uses the Path and Path.IO framework++-- this is the general export++----------------------------------------------------------------------++{-# OPTIONS_GHC -fno-warn-deprecations #-}++module Uniform.FileIO (+ module Uniform.Filenames+ , module Uniform.FileStatus+ , module Uniform.FileIOalgebra+ , module Uniform.TypedFile+ , module Uniform.FileStrings+ , module Uniform.Piped+ , Path.IO.getAppUserDataDir+ , Path.IO.doesFileExist --works in IO, not ErrIO+ ) where++import Uniform.FileIOalgebra -- hiding ((<.>), (</>))+import Uniform.Filenames+import Uniform.FileStatus+import Uniform.FileStrings+import Uniform.Piped+import Uniform.TypedFile+import qualified Path.IO (makeAbsolute, getAppUserDataDir, doesFileExist)
+ Uniform/FileIOalgebra.hs view
@@ -0,0 +1,168 @@+----------------------------------------------------------------------+--+-- Module : Uniform.FileIO+-- Copyright : andrew u frank -+--+-- reduced oct 2016 to small set+-- separate the operations from the OS and the operations which check for+-- undesirable characters in the filename and extension+-- approach: addExtension checks for bad extension characters+-- checks for filenames in the instances which use legalPathname+--+----------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses #-}++module Uniform.FileIOalgebra+ ( module Uniform.FileIOalgebra,+ -- module Uniform.Error,+ module Uniform.Zero,+ module System.IO,+ )+where++import qualified System.Directory as D+import System.IO (Handle, IOMode (..))+import Uniform.Error (ErrIO)+import Uniform.FileStatus (EpochTime, FileStatus)+import Uniform.Time (UTCTime, epochTime2UTCTime)+import Uniform.Zero (Zeros(..))+import Uniform.Strings (Text)++class FileHandles t where+ write2handle :: Handle -> t -> ErrIO ()++ -- write a string or text to a handle+ readLine4handle :: Handle -> ErrIO t++-- read a lline from a handle - used?++--class ListDir d f where+-- listDir' :: d -> ErrIO ([d],[f])+class FileSystemOps fp where+ getPermissions' :: fp -> ErrIO D.Permissions++ checkSymbolicLink :: fp -> ErrIO Bool+ -- ^ check if the fp points to a symbolic link+ -- better use isSimbolicLink (from FileStatus)++class DirOps fp where+ doesDirExist' :: fp -> ErrIO Bool+ createDir' :: fp -> ErrIO ()++ -- | write in a dir a new file with content+ -- getDirPermissions :: fp -> ErrIO D.Permissions+ createDirIfMissing' :: fp -> ErrIO ()++ -- | creates the directory, if missing, recursive for path+ -- noop if dir exist+ renameDir' :: fp -> fp -> ErrIO ()+ -- ^ rename directory old to new+ -- signals: getFileStatus: does not exist (No such file or directory)++ getDirectoryDirs' :: fp -> ErrIO [fp]++ -- get the directories (but not . and ..)+ -- getDirectoryDirs' dir = filterM f =<< getDirCont dir+ -- where f = doesDirExist'+ getDirectoryDirsNonHidden' :: fp -> ErrIO [fp]++ copyDirRecursive :: fp -> fp -> ErrIO ()++ -- | copy the directory content recursively, does not follow symlink+ -- implemented only for Path n Dir, not FilePath+ deleteDirRecursive :: fp -> ErrIO ()+ -- ^ delete a directory (even non empty), no error if not existing++class (Show fp) => FileOps fp where+ doesFileExist' :: fp -> ErrIO Bool++ copyOneFile :: fp -> fp -> ErrIO ()+ -- ^ copy a file from old to new+ -- source must exist, target must NOT exist++ copyOneFileOver :: fp -> fp -> ErrIO ()+ -- ^ copy a file from old to new+ -- source must exist, target may exist++ renameOneFile :: fp -> fp -> ErrIO ()+ -- ^ rename a file from old to new++ deleteFile :: fp -> ErrIO ()++ -- assertDirNotExist :: fp -> ErrIO ()+ -- -- ^ delete a directory (even non empty), if exist++ -- | get the directory content - if not existing Nothing, if empty Just []+ -- not returning the special entries . and ..+ -- filenames completed with the filename calling+ -- check access and readable+ -- returns for filepath always an absolute path+ -- for Path Rel gives Path Rel results+ getDirCont :: fp -> ErrIO [fp] -- (Maybe [String])++ -- | get the directory content - if not existing Nothing, if empty Just []+ -- not returning any hidden files+ -- alphabetic search to assure that equal directories have equal conten+ -- independent of file system internal structure+ -- filenames completed with calling fp+ -- only for filepath!+ getDirContNonHidden :: fp -> ErrIO [fp]++ getMD5 :: fp -> ErrIO (Maybe Text)++ -- get MD5, but why Text -- TODO++ getAppConfigDirectory :: ErrIO fp+ -- ^ find the .config directory path++ getSymbolicLinkStatus :: fp -> ErrIO FileStatus+ -- ^ get status if exist (else Nothing)+ -- is the status of the link, does not follow the link++ getFileAccess :: fp -> (Bool, Bool, Bool) -> ErrIO Bool+ -- ^ check the read, write and execute permission on file+ -- dir get content needs execute,++ getFileModificationTime :: fp -> ErrIO EpochTime+ -- ^ get the modification time (replaces isFileAbeforeB)++ getFileModificationUTCTime :: fp -> ErrIO UTCTime+ -- ^ get the modification time in UTCTIme+ getFileModificationUTCTime = fmap epochTime2UTCTime . getFileModificationTime++ -- operations on handle++ openFile2handle :: fp -> IOMode -> ErrIO Handle++-- | operations on dir to produce file+class (Show fd, Show ff) => FileOps2a fd ff where+ getDirContentFiles :: fd -> ErrIO [ff]++ getDirContentNonHiddenFiles :: fd -> ErrIO [ff]++---- | the operations on files with content+class+ (Show fp) =>+ FileOps2 fp fc+ where+ --+ writeFile2 :: fp -> fc -> ErrIO ()++ -- write file if dir exist+ readFile2 :: fp -> ErrIO fc++ -- read file+ appendFile2 :: fp -> fc -> ErrIO ()++ writeFileOrCreate2 :: fp -> fc -> ErrIO ()++ --++ readFileOrZero2 :: (FileOps fp, Zeros fc) => fp -> ErrIO fc++ -- | reads file, if not present, returns zero+ readFileOrZero2 fp = do+ f <- doesFileExist' fp+ if f+ then readFile2 fp+ else return zero
+ Uniform/FileStatus.hs view
@@ -0,0 +1,67 @@+----------------------------------------------------------------------+--+-- Module : uniform-FileIO+-- Copyright : andrew u frank -+--+----------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++-- | the routines to take apart the file status+module Uniform.FileStatus+ ( getFileStatus,+ isDirectory,+ isRegularFile,+ getFileStatus',+ isSymbolicLink,+ getModificationTimeFromStatus,+ getFileSize,+ P.EpochTime,+ P.FileStatus,+ )+where++import qualified System.Directory as S+import qualified System.Posix as P+import Uniform.Error +-- (ErrIO, callIO, putIOwords, showT)+import Uniform.Filenames (Path, toShortFilePath)+import Uniform.Strings (putIOwords, showT)++unL :: Path df ar -> FilePath+unL = toShortFilePath++--getFileStatus :: Path df ra -> ErrIO P.FileStatus+-- getFileStatus :: (Control.Monad.Error.Class.MonadError m,+-- Control.Monad.IO.Class.MonadIO m,+-- Control.Monad.Error.Class.ErrorType m ~ Data.Text.Internal.Text)+-- => Path df ar -> m P.FileStatus+getFileStatus fp = callIO $ P.getFileStatus . unL $ fp++getFileStatus' :: FilePath -> ErrIO P.FileStatus+getFileStatus' fp = callIO $ P.getFileStatus fp++isRegularFile :: P.FileStatus -> Bool+isRegularFile = P.isRegularFile++isDirectory :: P.FileStatus -> Bool+isDirectory = P.isDirectory++isSymbolicLink :: P.FileStatus -> Bool+isSymbolicLink = P.isSymbolicLink++getModificationTimeFromStatus :: P.FileStatus -> P.EpochTime+getModificationTimeFromStatus = P.modificationTime++getFileSize = P.fileSize++createSymbolicLink :: Show (Path df ra) => Path df ra -> Path df ra -> ErrIO ()+createSymbolicLink fn tn = do+ putIOwords ["createSymbolidLink", showT fn, "to", showT tn]+ callIO $ P.createSymbolicLink (unL fn) (unL tn)++renameLink :: Path df ra -> Path df ra -> ErrIO ()+renameLink old new = callIO $ P.rename (unL old) (unL new)
+ Uniform/FileStrings.hs view
@@ -0,0 +1,394 @@+---------------------------------------------------------------------+-- Module : FileIO.Strings+--+----------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}++module Uniform.FileStrings+ ( module Uniform.Filenames,+ module Uniform.FileIOalgebra,+ SIO.IOMode (..),+ closeFile2,+ listDir',+ TIO.hGetLine,+ TIO.hPutStr,+ )+where++import Control.Arrow (first, second)+import Control.DeepSeq (force, ($!!))+import Control.Exception (SomeException, catch)+import Control.Monad (filterM, when)+import Control.Monad.Catch as Catch+ ( Exception,+ MonadThrow,+ SomeException,+ )+import Control.Monad.IO.Class (MonadIO (..))+import qualified Data.ByteString as BS (readFile, writeFile)+import qualified Data.ByteString.Lazy as L+import Data.Digest.Pure.MD5 (md5)+import Data.Either (isLeft)+import Data.List (isPrefixOf)+import Data.Maybe (catMaybes)+import qualified Data.Text.IO as T (appendFile, readFile, writeFile)+import qualified Data.Text.IO as TIO (hGetLine, hPutStr)+import qualified Path+import qualified Path.IO as PathIO+import qualified System.Directory as D+import qualified System.FilePath as OS+import qualified System.IO as SIO+import System.Posix (FileMode)+import qualified System.Posix as Posix+import Uniform.FileIOalgebra+import Uniform.FileStatus+import Uniform.Filenames+import Uniform.Filenames as FN (toFilePath)+import Uniform.Strings -- (Text)+import Uniform.Error+++closeFile2 :: SIO.Handle -> ErrIO ()+-- close a handle, does not need a filepath+closeFile2 handle = callIO $ SIO.hClose handle++instance FileHandles String where+ write2handle h c = callIO $ SIO.hPutStr h c+ readLine4handle h = callIO $ SIO.hGetLine h++instance FileHandles L.ByteString where+ write2handle h c = callIO $ L.hPutStr h c+ readLine4handle h = error "readLine4handle not implemented for lazy bytestring in FileStrings"++instance FileHandles Text where+ write2handle h c = callIO $ TIO.hPutStr h c+ readLine4handle h = callIO $ TIO.hGetLine h++instance FileHandles [Text] where+ write2handle h c = callIO $ TIO.hPutStr h (unlines' c)+ readLine4handle h = do+ res <- callIO $ TIO.hGetLine h+ return . lines' $ res++listDir' ::+ (MonadIO m, MonadThrow m) =>+ -- | Directory to list+ Path b Dir ->+ -- | Sub-directories and files+ m ([Path Abs Dir], [Path Abs File])+listDir' p = do+ abList :: ([Path.Path Abs Dir], [Path.Path Abs File]) <-+ PathIO.listDir . unPath $ p+ let abPathList = abList+ return abPathList++instance FileSystemOps FilePath where+ checkSymbolicLink fp = callIO $ D.pathIsSymbolicLink fp+ getPermissions' = callIO . D.getPermissions++instance DirOps FilePath where+ doesDirExist' = callIO . D.doesDirectoryExist+ createDirIfMissing' = callIO . D.createDirectoryIfMissing True++ createDir' = callIO . D.createDirectory+ renameDir' old new = do+ putIOwords ["renamed start"]+ testSource <- doesDirExist' old+ testTarget <- doesDirExist' new+ if testTarget+ then+ throwErrorT+ [showT new]+ else+ if not testSource+ then+ throwErrorT+ [showT old]+ else do+ callIO $ putStrLn "renamed"+ r <- callIO $ D.renameDirectory old new+ return ()++ getDirectoryDirs' dir = filterM f =<< getDirCont dir+ where+ f = doesDirExist'+ getDirectoryDirsNonHidden' dir = filterM f =<< getDirContNonHidden dir+ where+ f = doesDirExist'++ deleteDirRecursive f =+ do+ t <- doesDirExist' f+ when t $ do+ callIO . D.removeDirectoryRecursive $ f++ putIOwords ["deleted", showT f]++instance FileOps FilePath where+ doesFileExist' = callIO . D.doesFileExist++ copyOneFile old new = do+ -- source must exist, target must not exist+ t <- doesFileExist' old+ t2 <- doesFileExist' new+ if t && not t2+ then do+ let dir = getParentDir new -- was takeDir+ direxist <- doesDirExist' dir+ unless direxist $+ createDirIfMissing' dir+ callIO $ D.copyFile old new+ else+ if not t+ then+ throwErrorT+ ["copyFile source not exist", showT old]+ else+ if t2+ then+ throwErrorT+ ["copyFile target exist", showT new]+ else throwErrorT ["copyOneFile", "other error"]+ copyOneFileOver old new = do+ -- may overwrite existing target+ t <- doesFileExist' old+ if t+ then do+ let dir = getParentDir new -- was takeDir+ direxist <- doesDirExist' dir+ unless direxist $+ createDirIfMissing' dir+ callIO $ D.copyFile old new+ else -- not t - not existing source+ throwErrorT ["copyFileOver source not exist", showT old]++ getMD5 fn =+ do+ status <- getSymbolicLinkStatus fn+ let regular = isRegularFile status+ readable <- getFileAccess fn (True, False, False)+ if regular && readable+ then callIO $ do+ filedata :: L.ByteString <- L.readFile fn+ let res = showT $ md5 filedata+ return $!! (Just res)+ else throwErrorT ["getMD5 error file not readable", showT fn]+ `catchError` \e -> do+ putIOwords ["getMD5 in FileStrings.hs", showT fn, showT e]++ throwErrorT ["getMD5 error for", showT fn]++ getDirCont fn = getDirContAll True fn++ getDirContNonHidden fp = do+ r <- getDirContAll False fp+ return r++ deleteFile f = do+ callIO . D.removeFile $ f++ getAppConfigDirectory = error "not implemented" -- do++ getSymbolicLinkStatus fp = do+ st <- callIO $ Posix.getSymbolicLinkStatus fp+ return st++ getFileAccess fp (r, w, e) =+ callIO $+ Posix.fileAccess fp r w e++ getFileModificationTime fp = do+ stat :: Posix.FileStatus <- getFileStatus' fp+ let time = getModificationTimeFromStatus stat+ return time++ openFile2handle fp mode =+ callIO $ SIO.openFile fp mode++getDirContAll hiddenFlag fn = do+ -- the hiddenFlag must be true to include them+ testDir <- doesDirExist' fn+ readExec <- getFileAccess fn (True, False, True)+ if testDir && readExec+ then do+ r <- callIO . D.listDirectory $ fn+ let r2 = filter (\file' -> file' /= "." && file' /= "..") r+ let r3 =+ if hiddenFlag+ then r2+ else filter (not . isPrefixOf ".") r2+ let r4 = map (fn </>) r3+ return r4+ else+ throwErrorT+ [ "getDirCont not exist or not readable",+ showT fn,+ showT testDir,+ showT readExec+ ]++instance FileSystemOps (Path ar df) where+ getPermissions' = PathIO.getPermissions . unPath+ checkSymbolicLink fp = callIO $ D.pathIsSymbolicLink (unL fp)++instance DirOps (Path Abs Dir) where+ doesDirExist' = PathIO.doesDirExist++ createDir' = PathIO.createDir . unPath++ renameDir' old new =+ -- :: fp -> fp -> ErrIO Text+ PathIO.renameDir (unPath old) (unPath new)++ getDirectoryDirs' dir = do+ res <- filterM f =<< getDirCont (toFilePath dir)+ return . map makeAbsDir $ res+ where+ f = doesDirExist'+ getDirectoryDirsNonHidden' dir = do+ res <- filterM f =<< getDirContNonHidden (toFilePath dir)+ return . map makeAbsDir $ res+ where+ f = doesDirExist'++ createDirIfMissing' = PathIO.createDirIfMissing True . unPath++ copyDirRecursive old new = PathIO.copyDirRecur (unPath old) (unPath new)++ deleteDirRecursive f = deleteDirRecursive (unL f)++instance DirOps (Path Rel Dir) where+ doesDirExist' = PathIO.doesDirExist++ createDir' = PathIO.createDir . unPath++ renameDir' old new =+ PathIO.renameDir (unPath old) (unPath new)++ getDirectoryDirs' dir = do+ res <- filterM f =<< getDirCont (toFilePath dir)+ return . map makeRelDir $ res+ where+ f = doesDirExist'++ getDirectoryDirsNonHidden' dir = do+ res <- filterM f =<< getDirContNonHidden (toFilePath dir)+ return . map makeRelDir $ res+ where+ f = doesDirExist'++ createDirIfMissing' = PathIO.createDirIfMissing True . unPath++ copyDirRecursive old new = PathIO.copyDirRecur (unPath old) (unPath new)++ deleteDirRecursive f = deleteDirRecursive (unL f)++instance (Show (Path ar File)) => FileOps (Path ar File) where+ doesFileExist' = PathIO.doesFileExist . unPath++ copyOneFile old new = copyOneFile (unL old) (unL new)+ copyOneFileOver old new = copyOneFileOver (unL old) (unL new)+ renameOneFile old new =+ PathIO.renameFile (unPath old) (unPath new)++ deleteFile f = deleteFile (unL f)++ getMD5 fp = getMD5 (unL fp)++ getDirCont fp =+ error "getDirCont cannot be implemented for Path"+ getDirContNonHidden fp =+ error "getDirContentNonHidden cannot be implemented for Path"++ getFileModificationTime fp = getFileModificationTime (unL fp)++ openFile2handle fp mode = openFile2handle (unL fp) mode++ getFileAccess fp (r, w, e) =+ callIO+ ( do+ Posix.fileAccess (unL fp) r w e+ `catchError` \e -> do+ putIOwords ["getFileAccess error", showT fp, s2t $ show e]+ return False+ )++unL = FN.toFilePath++readFileT :: Path ar File -> ErrIO Text+readFileT fp = callIO . T.readFile . unL $ fp++writeFileT :: Path ar File -> Text -> ErrIO ()+writeFileT fp st = callIO $ T.writeFile (unL fp) st++-- attention - does not create file if not existing++instance (Show (Path ar File)) => FileOps2 (Path ar File) String where+ readFile2 fp = callIO $ readFile (unL fp)++ -- a strict read (does cloes?)+ writeFile2 fp st = callIO $ writeFile (unL fp) st+ appendFile2 fp st = callIO $ appendFile (unL fp) st++instance (Show (Path ar File)) => FileOps2 (Path ar File) Text where+ readFile2 fp = readFile2 (unL fp)++ writeFile2 fp st = writeFile2 (unL fp) st+ appendFile2 fp st = appendFile2 (unL fp) st++ writeFileOrCreate2 filepath st = do+ let dir = getParentDir filepath++ createDirIfMissing' dir+ when False $ putIOwords ["writeFileOrCreate2 dir created", showT dir]+ t <- doesDirExist' dir+ when False $ putIOwords ["writeFileOrCreate2 dir test", showT t]+ writeFile2 filepath st+ when False $ putIOwords ["writeFileOrCreate2 file written", showT filepath]++instance FileOps2 FilePath Text where+ readFile2 fp = callIO $ T.readFile fp+ writeFile2 fp st = callIO $ T.writeFile fp st+ appendFile2 fp st = callIO $ T.appendFile fp st++instance FileOps2 FilePath L.ByteString where+ readFile2 fp = callIO $ L.readFile fp+ writeFile2 fp st = callIO $ L.writeFile fp st+ appendFile2 fp st = callIO $ L.appendFile fp st++instance (Show (Path ar File)) => FileOps2 (Path ar File) L.ByteString where+ readFile2 fp = callIO $ L.readFile . unL $ fp+ writeFile2 fp st = callIO $ L.writeFile (unL fp) st+ appendFile2 fp st = callIO $ L.appendFile (unL fp) st++instance FileOps2a FilePath FilePath where+ getDirContentFiles dir =+ filterM doesFileExist'+ =<< getDirCont dir++ getDirContentNonHiddenFiles dir =+ filterM doesFileExist'+ =<< getDirContNonHidden dir++instance FileOps2a (Path Abs Dir) (Path Abs File) where+ getDirContentFiles dir = do+ res <- getDirContentFiles (toFilePath dir)+ return (map makeAbsFile res)+ getDirContentNonHiddenFiles dir = do+ res <- getDirContentNonHiddenFiles (toFilePath dir)+ return (map makeAbsFile res)++instance FileOps2a (Path Rel Dir) (Path Rel File) where+ getDirContentFiles dir = do+ res <- getDirContentFiles (toFilePath dir)+ return (map makeRelFile res)+ getDirContentNonHiddenFiles dir = do+ res <- getDirContentNonHiddenFiles (toFilePath dir)+ return (map makeRelFile res)
+ Uniform/Filenames.hs view
@@ -0,0 +1,277 @@+-------------------------------------------------------------------+--+-- Module : Filenames+-- Copyright : andrew u frank -+--+----------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-deprecations #-}++-- | the operations on filenames and extensions+-- uses the Path library, but wraps it in Path (to construct a read)+-- is a class except for the make+module Uniform.Filenames+ ( module Uniform.Filenames,+ module Uniform.Error,+ Abs,+ Rel,+ File,+ Dir,+ Path,+ toFilePath,+ )+where++-- for Generics+import Path+ ( Abs,+ Dir,+ File,+ Path,+ Rel,+ toFilePath,+ )+import qualified Path+import qualified Path.IO as PathIO+import qualified System.FilePath as S+import Uniform.Error(ErrIO, callIO)+-- import Uniform.Zero(Zeros(..))+import Uniform.Strings+-- (Text, fromJustNote, t2s)++takeBaseName' :: FilePath -> FilePath+takeBaseName' = S.takeBaseName++homeDir :: Path Abs Dir+homeDir = makeAbsDir "/home/frank/" :: Path Abs Dir++homeDir2 :: ErrIO (Path Abs Dir)+homeDir2 = callIO PathIO.getHomeDir :: ErrIO (Path Abs Dir)++-- replace homeDir with homeDir2 - is user independent but requires IO+currentDir :: ErrIO (Path Abs Dir)+currentDir = callIO PathIO.getCurrentDir++setCurrentDir :: Path Abs Dir -> ErrIO ()+setCurrentDir path = PathIO.setCurrentDir (unPath path)++stripProperPrefix' :: Path b Dir -> Path b t -> ErrIO (Path Rel t)+stripProperPrefix' dir fn = Path.stripProperPrefix (unPath dir) (unPath fn)++stripProperPrefixMaybe :: Path b Dir -> Path b t -> Maybe (Path Rel t)+stripProperPrefixMaybe dir fn = Path.stripProperPrefix (unPath dir) (unPath fn)++unPath :: a -> a+unPath = id++ ++makeRelFile :: FilePath -> Path Rel File+makeRelDir :: FilePath -> Path Rel Dir+makeAbsFile :: FilePath -> Path Abs File+makeAbsDir :: FilePath -> Path Abs Dir+makeRelFile fn = fromJustNote ("makeRelFile " ++ fn) $ Path.parseRelFile fn++makeRelDir fn = fromJustNote ("makeRelDir " ++ fn) $ Path.parseRelDir fn++makeAbsFile fn = fromJustNote ("makeAbsFile " ++ fn) $ Path.parseAbsFile fn++makeAbsDir fn = fromJustNote ("makeAbsDir " ++ fn) $ Path.parseAbsDir fn++makeRelFileT :: Text -> Path Rel File+makeRelDirT :: Text -> Path Rel Dir+makeAbsFileT :: Text -> Path Abs File+makeAbsDirT :: Text -> Path Abs Dir+makeRelFileT = makeRelFile . t2s++makeRelDirT = makeRelDir . t2s++makeAbsFileT = makeAbsFile . t2s++makeAbsDirT = makeAbsDir . t2s++toShortFilePath :: Path df ar -> FilePath+---- ^ get the filepath, but without the trailing separator+-- , necessary for systemcalls+toShortFilePath = S.dropTrailingPathSeparator . toFilePath++instance Zeros (Path Abs Dir) where+ zero = makeAbsDir "/"++instance Zeros (Path Abs File) where+ zero = makeAbsFile "/zero"++instance Zeros (Path Rel Dir) where+ zero = makeRelDir "./"++instance Zeros (Path Rel File) where+ zero = makeRelFile "zero"++newtype Extension = Extension FilePath deriving (Show, Read, Eq, Ord)++unExtension :: Extension -> FilePath+unExtension (Extension e) = e++makeExtension :: FilePath -> Extension+makeExtension = Extension++-- extension does not include a leading "."+-- would need a makeExtension in IO to catch errors here+makeExtensionT :: Text -> Extension+makeExtensionT = Extension . t2s++class Filenames fp fr where+ getFileName :: fp -> fr++class Filenames3 fp file where+ type FileResultT fp file++ -- add a filepath to a absolute dir and givev an absolte file+ --+ (</>), addFileName :: fp -> file -> FileResultT fp file+ -- fails, if file is empty does not add anything if file is empty+ (</>) = addFileName++class Filenames5 dir fil res where+ stripPrefix :: dir -> fil -> Maybe res+ -- ^ strip the++instance Filenames5 (Path b Dir) (Path b t) (Path Rel t) where+ stripPrefix d f = Path.stripProperPrefix (unPath d) (unPath f)++class Filenames4 fp file where+ type FileResultT4 fp file++ -- add a filepath to a absolute dir and givev an absolte dir+ --+ addDir :: fp -> file -> FileResultT4 fp file++class Filenames1 fp where+ -- instantiate only for filepath TODO do for path+ getImmediateParentDir :: fp -> FilePath+ -- ^ gets the name of the dir immediately above++ getParentDir :: fp -> FilePath+ -- ^ the parent dir of file++ getNakedFileName :: fp -> FilePath+ -- ^ filename without extension++ getNakedDir :: fp -> FilePath+ -- ^ get the last dir++instance Filenames FilePath FilePath where+ getFileName = snd . S.splitFileName++instance Filenames3 FilePath FilePath where+ type FileResultT FilePath FilePath = FilePath+ addFileName = S.combine++instance Filenames (Path ar File) (Path Rel File) where+ getFileName = Path.filename . unPath++instance Filenames3 (Path b Dir) FilePath where+ type FileResultT (Path b Dir) FilePath = (Path b File)+ addFileName p d =+ if null' d+ then error ("addFileName with empty file" ++ d)+ else (Path.</>) (unPath p) (unPath d2)+ where+ d2 = makeRelFile d :: Path Rel File++instance Filenames4 FilePath FilePath where+ type FileResultT4 FilePath FilePath = FilePath+ addDir p d = if null' d then p else p </> d++instance Filenames4 (Path b Dir) FilePath where+ type FileResultT4 (Path b Dir) FilePath = (Path b Dir)+ addDir p d =+ if null' d+ then p+ else p </> d2+ where+ d2 = makeRelDir d :: Path Rel Dir++instance Filenames4 (Path b Dir) (Path Rel t) where+ type FileResultT4 (Path b Dir) (Path Rel t) = (Path b t)+ addDir p d = (Path.</>) (unPath p) (unPath d)++instance Filenames3 (Path b Dir) (Path Rel t) where+ type FileResultT (Path b Dir) (Path Rel t) = (Path b t)+ addFileName p d = (Path.</>) (unPath p) (unPath d)++instance Filenames1 (Path ar File) where+ getNakedFileName = getNakedFileName . toFilePath+ getImmediateParentDir = getImmediateParentDir . toFilePath+ getParentDir = getParentDir . toFilePath+ getNakedDir = error "getNakedDir for Filenamse1 Path ar File) not existing"++instance Filenames1 (Path ar Dir) where+ getNakedFileName = error "getNakedFileName not from Dir"+ getImmediateParentDir = getImmediateParentDir . toFilePath+ getParentDir = getParentDir . toFilePath+ getNakedDir = getNakedDir . toFilePath++instance Filenames1 FilePath where+ getNakedFileName = removeExtension . getFileName+ getImmediateParentDir = (!! 1) . reverse . S.splitDirectories+ getParentDir = S.takeDirectory+ getNakedDir = (!! 0) . reverse . S.splitDirectories++class (Eq (ExtensionType fp)) => Extensions fp where+ -- extension do not include a leading '.'+ type ExtensionType fp+ getExtension :: fp -> ExtensionType fp+ removeExtension :: fp -> fp+ addExtension :: ExtensionType fp -> fp -> fp++ -- must not have an extension before+ (<.>) :: fp -> ExtensionType fp -> fp -- eror when not legal?+ (<.>) f e = addExtension e f+ setExtension :: ExtensionType fp -> fp -> fp+ hasExtension :: ExtensionType fp -> fp -> Bool+ hasExtension e = (e ==) . getExtension++ prop_add_has :: ExtensionType fp -> fp -> Bool+ prop_add_has e f = hasExtension e (addExtension e f)+ prop_add_add_has :: ExtensionType fp -> ExtensionType fp -> fp -> Bool+ prop_add_add_has e1 e2 f =+ hasExtension+ e1+ (setExtension e1 . setExtension e2 $ f)+ prop_set_get :: ExtensionType fp -> fp -> Bool+ prop_set_get e f = ((e ==) . getExtension) (setExtension e f)++instance Extensions FilePath where+ type ExtensionType FilePath = FilePath++ getExtension = removeChar '.' . snd . S.splitExtension+ addExtension e fp = fp S.<.> e+ removeExtension = fst . S.splitExtension+ setExtension e = addExtension e . removeExtension++-- hasExtension e = (e ==) . getExtension++instance Extensions (Path ar File) where+ type ExtensionType (Path ar File) = Extension++ getExtension f = Extension e+ where+ -- definition of extension in path is with leading '.'+ -- multiple extensions are gradually built and removed+ -- split gives only the last+ -- add allows only one to add+ -- empty extensions throw error++ e = getExtension . toFilePath $ f++ setExtension e f =+ fromJustNote "setExtension" $ Path.setFileExtension (unExtension e) f++ addExtension = setExtension+ removeExtension = setExtension (Extension "")
+ Uniform/Piped.hs view
@@ -0,0 +1,92 @@+----------------------------------------------------------------------+--+-- Module : piped+-- Copyright : andrew u frank -+--+---------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}++-- | the recursive access to many files not blocking+module Uniform.Piped+ ( getRecursiveContents,+ -- , pipeMap, pipeStdoutLn+ pipedDoIO,+ )+where++import Data.List (sort)+import qualified Path.IO (readable, searchable)+import Pipes ((>->))+import qualified Pipes as Pipe+import qualified Pipes.Prelude as PipePrelude+import Uniform.Error+-- ( ErrIO,+-- ErrorT,+-- Text,+-- putIOwords,+-- showT,+-- t2s,+-- when,+-- )+import Uniform.Strings +import Uniform.FileStrings++getRecursiveContents :: -- (Path Abs File-> Pipe.Proxy Pipe.X () () String (ErrorT Text IO) ())+ Path Abs Dir ->+ Pipe.Proxy Pipe.X () () (Path Abs File) (ErrorT Text IO) ()+getRecursiveContents fp = do+ -- putIOwords ["recurseDir start", showT fp]+ perm <- Pipe.lift $ getPermissions' fp+ if not (Path.IO.readable perm && Path.IO.searchable perm)+ then Pipe.lift $ putIOwords ["recurseDir not readable or not searchable", showT fp]+ else do+ symLink <- Pipe.lift $ checkSymbolicLink fp -- callIO $ xisSymbolicLink fp+ if symLink+ then Pipe.lift $ putIOwords ["recurseDir symlink", showT fp]+ else do+ (dirs, files) <- Pipe.lift $ listDir' fp+ when False $ do+ Pipe.lift $ putIOwords ["recurseDir files\n", showT files]+ Pipe.lift $ putIOwords ["recurseDir directories\n", showT dirs]++ Prelude.mapM_ Pipe.yield (sort files)+ -- (Path.IO.sort (map unPath files))+ Prelude.mapM_ getRecursiveContents (sort dirs)+ -- (Path.IO.sort (map unPath dirs))+ return () -- where processOneFile fp = Pipe.yield fp++--+---- examples how to use...+--+--pipedDo :: LegalPathname -> (LegalPathname -> Text) -> ErrIO ()+--pipedDo path transf = do+--+-- runEffect $+-- getRecursiveContents path+-- >-> P.map (t2s . transf)+-- >-> P.stdoutLn+--+--testDir = fromJustNote "testdir" $ makeLegalPath "/home/frank/Workspace8/uniform-fileio/testDirFileIO"+--test_getRec = do+-- res <- runErr $ pipedDo testDir (showT)+-- assertEqual (Right ()) res+-- -- check manually+--+--+--+--++-- | a convenient function to go through a directory and+-- recursively apply a function to each+pipedDoIO :: Path Abs File -> Path Abs Dir -> (Path Abs File -> Text) -> ErrIO ()+pipedDoIO file path transf = do+ hand <- openFile2handle file WriteMode+ Pipe.runEffect $+ getRecursiveContents path+ >-> PipePrelude.map (t2s . transf) -- some IO type left?+ >-> PipePrelude.toHandle hand+ closeFile2 hand+ return ()
+ Uniform/TypedFile.hs view
@@ -0,0 +1,292 @@+----------------------------------------------------------------------+--+-- Module : uniform.TypedFile+-- Copyright : andrew u frank -+--+-- mapping data structures to files typed with an extension+-- write and read quasi type-checked+----------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}++module Uniform.TypedFile+ ( module Uniform.TypedFile,+ GZip.compress,+ GZip.decompress,+ EpochTime,+ )+where++import qualified Codec.Compression.GZip as GZip+import qualified Data.ByteString.Lazy as L+import qualified Path.IO (ensureDir)+import Uniform.FileIOalgebra (Handle)+import Uniform.FileStatus (EpochTime)+import Uniform.FileStrings+import Uniform.Filenames as FN (Path)+import Uniform.Strings +import Uniform.Error++data TypedFile5 a b = TypedFile5 {tpext5 :: Extension}++rdfGraphDebug = False++-- | reads or writes a structured file with the specified parsers or writer+-- the first parameter is the type of file, it is the type of the+-- input data and the returned data+-- the second an arbitrary differentiation+-- to allow two file types with different extension and read+-- the b can be () if no differentiation is desired+class+ (FileHandles a) =>+ TypedFiles5 a b+ where+ append5 f = errorT ["TypedFiles - no implementation for append5", showT f]+ read5 f = errorT ["TypedFiles - no implementation for read5", showT f]+ read6 f = errorT ["TypedFiles - no implementation for read6", showT f]+ append6 f = errorT ["TypedFiles - no implementation for append6", showT f]+ openHandle6 f = errorT ["TypedFiles - no implementation for openHandle6", showT f]+ writeHandle6 f = errorT ["TypedFiles - no implementation for writeHandle6", showT f]+ closeHandle6 f = errorT ["TypedFiles - no implementation for closeHandle6", showT f]++ write5 :: FN.Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()+ -- write a file, directory is created if not exist+ -- file, if exist, is replaced+ write5 fp fn tp ct = do+ dirx <- Path.IO.ensureDir (unPath fp)+ write6 (fp </> fn) tp ct++ append5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()+ read5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> ErrIO a++ write6 :: Path Abs File -> TypedFile5 a b -> a -> ErrIO ()+ -- write a file, directory is created if not exist+ -- file, if exist, is replaced+ write6 fp tp queryText = do+ -- when rdfGraphDebug $+ putIOwords ["write6", showT fp]+ -- let fn2 = fp </> addExt lpX fn (tpext tp) -- :: LegalPathname+ let fn2 = setExtension (tpext5 tp) fp+ createDirIfMissing' (getParentDir fp) -- add everywhere?+ when rdfGraphDebug $+ putIOwords+ [ "sparql Turtle createDIrIfMissing' ",+ showT (getParentDir fp)+ ]+ hand <- openFile2handle fn2 WriteMode+ -- when rdfGraphDebug $ putIOwords ["write6", showT fn2]++ write2handle hand queryText -- changed for Text not []+ closeFile2 hand++ openHandle6 :: Path Abs File -> TypedFile5 a b -> ErrIO Handle++ -- | create the file and open the handle+ -- should attache ".tmp" to extension and when closing+ -- rename to correct filename - > transaction completed+ writeHandle6 :: Handle -> TypedFile5 a b -> a -> ErrIO ()++ closeHandle6 :: Path Abs File -> TypedFile5 a b -> Handle -> ErrIO ()++ -- | close the handle - with transaction+ append6 :: Path Abs File -> TypedFile5 a b -> a -> ErrIO ()++ -- append to the file, with the same methods as in write6+ read6 :: Path Abs File -> TypedFile5 a b -> ErrIO a++ exist6 :: Path Abs File -> TypedFile5 a b -> ErrIO Bool+ -- ^ check whether file exist+ exist6 fp tp = do+ let fn2 = setExtension (tpext5 tp) fp :: Path Abs File+ doesFileExist' fn2++ modificationTime6 :: Path Abs File -> TypedFile5 a b -> ErrIO EpochTime+ modificationTime6 fp tp = do+ let fn2 = setExtension (tpext5 tp) fp :: Path Abs File+ t :: EpochTime <- getFileModificationTime fn2+ return t++ isTyped :: Path Abs File -> TypedFile5 a b -> Bool+ -- ^ check if a given file is of the right type (extenions, not mime type)+ isTyped fp tp = getExtension fp == typedExtension tp++ typedExtension :: TypedFile5 a b -> Extension+ -- ^ get the extension back+ typedExtension tp = tpext5 tp++ makeTyped :: Extension -> TypedFile5 a b+ -- make a typed file type, needs type specification!+ makeTyped ext = TypedFile5 {tpext5 = ext}++instance TypedFiles5 Text b where+ -- file contains a list of lines (text)+ write5 fp fn tp ct = do+ dirx <- Path.IO.ensureDir (unPath fp)+ let fn2 = fn <.> tpext5 tp -- :: Path ar File+ writeFile2 (fp </> fn2) ct++ -- writeFile2 (fp </> (fn <.> (tpext tp) )) . unlines'+ append5 fp fn tp ct = do+ dirx <- Path.IO.ensureDir (unPath fp)+ let fn2 = fn <.> tpext5 tp -- :: Path ar File+ appendFile2 (fp </> fn2) ct+ read5 fp fn tp = do+ let fn2 = fn <.> tpext5 tp+ readFile2 $ fp </> fn2++ append6 fn tp ct = do+ let fn2 = setExtension (tpext5 tp) fn+ appendFile2 fn2 ct+ write6 fn tp ct = do+ let fn2 = setExtension (tpext5 tp) fn+ hand <- openFile2handle fn2 WriteMode++ write2handle hand ct++ closeFile2 hand++ exist6 fn tp = do+ let fn2 = setExtension (tpext5 tp) fn+ doesFileExist' fn2++ read6 fn tp = do+ let fn2 = setExtension (tpext5 tp) fn+ readFile2 fn2++instance TypedFiles5 [Text] b where+ -- file contains a list of lines (text)+ -- mkTypedFile5 = TypedFile5 { tpext5 = Extension "txt"}+ write5 fp fn tp ct = do+ dirx <- Path.IO.ensureDir (unPath fp)+ let fn2 = fn <.> tpext5 tp -- :: Path ar File+ writeFile2 (fp </> fn2) (unlines' ct)++ append5 fp fn tp ct = do+ dirx <- Path.IO.ensureDir (unPath fp)+ let fn2 = fn <.> tpext5 tp -- :: Path ar File+ appendFile2 (fp </> fn2) (unlines' ct)+ read5 fp fn tp = do+ let fn2 = fn <.> tpext5 tp+ fmap lines' . readFile2 $ fp </> fn2++ append6 fn tp ct = do+ let fn2 = setExtension (tpext5 tp) fn+ appendFile2 fn2 (unlines' ct)+ write6 fn tp ct = do+ let fn2 = setExtension (tpext5 tp) fn+ hand <- openFile2handle fn2 WriteMode++ write2handle hand (unlines' ct)++ closeFile2 hand++ exist6 fn tp = do+ let fn2 = setExtension (tpext5 tp) fn+ doesFileExist' fn2++ read6 fn tp = do+ let fn2 = setExtension (tpext5 tp) fn+ fmap lines' . readFile2 $ fn2++data GZip++-- | files with full triples stored as zip+instance TypedFiles5 LazyByteString GZip where+ append6 fp tp jsonld = do+ when rdfGraphDebug $ putIOwords ["triples append6", showT fp]+ let fn2 = setExtension (tpext5 tp) fp++ appendFile2 fn2 (GZip.compress jsonld)++ openHandle6 fp tp = do+ when rdfGraphDebug $ putIOwords ["openHandle6 jsonld"]+ let ext = unExtension (tpext5 tp)+ let tmpext = Extension (ext <.> "tmp")+ let fn2 = setExtension tmpext fp+ when rdfGraphDebug $ putIOwords ["openHandle6 jsonld", showT fn2]++ createDirIfMissing' (getParentDir fn2) -- add everywhere?+ hand <- openFile2handle fn2 WriteMode+ -- should create or truncate the file, but not when the dir not exist+ --https://hackage.haskell.org/package/base-4.10.0.0/docs/System-IO.html#g:5+ when rdfGraphDebug $ putIOwords ["openHandle6 jsonld", showT fn2]+ return hand++ closeHandle6 fp tp hand = do+ -- when rdfGraphDebug $+ when rdfGraphDebug $ putIOwords ["closeHandle6 jsonld"]+ let ext = unExtension (tpext5 tp)+ let tmpext = Extension (ext <.> "tmp")+ closeFile2 hand+ let fn2 = setExtension tmpext fp+ let fn1 = setExtension (tpext5 tp) fp+ renameOneFile fn2 fn1+ when rdfGraphDebug $ putIOwords ["closeHandle6 jsonld", showT fn2]+ return ()++ writeHandle6 hand tp jsonld = do+ r <- write2handle hand (GZip.compress jsonld)+ return r++ read6 fp tp = error "read for jsonld is not easy and not required"++-- | the a is the base type+-- which is written on file, b is the type for input and output+class FileHandles a => TypedFiles7 a b where+ wrap7 :: a -> b+ unwrap7 :: b -> a++class FileHandles a => TypedFiles7a a b where+ -- | the 7 have two arguments for path and file+ read7 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> ErrIO b++ write7 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> b -> ErrIO ()++ -- | the 8 versions have a single argument for path and file+ read8 :: Path Abs File -> TypedFile5 a b -> ErrIO b++ write8 :: Path Abs File -> TypedFile5 a b -> b -> ErrIO ()+ -- ^ the createDir if missingis implied in the write++instance (TypedFiles7 Text b) => TypedFiles7a Text b where+ -- an instance for all what has text or bytestring as underlying rep+ write7 fp fn tp ct = do+ write8 (fp </> fn) tp ct++ read7 fp fn tp = do+ read8 (fp </> fn) tp++ write8 fp tp ct = do+ let fn2 = fp <.> tpext5 tp -- :: Path ar File+ let parent = getParentDir fn2+ createDirIfMissing' parent++ writeFile2 fn2 (unwrap7 ct :: Text)++ read8 fp tp = do+ let fp2 = fp <.> tpext5 tp+ ares :: Text <- readFile2 fp2+ return . wrap7 $ ares++instance (TypedFiles7 L.ByteString b) => TypedFiles7a L.ByteString b where+ -- an instance for all what has text or bytestring as underlying rep+ write7 fp fn tp ct = do+ write8 (fp </> fn) tp ct++ read7 fp fn tp = do+ read8 (fp </> fn) tp++ write8 fp tp ct = do+ let fn2 = fp <.> tpext5 tp -- :: Path ar File+ let parent = getParentDir fn2+ createDirIfMissing' parent+ writeFile2 fn2 (unwrap7 ct :: L.ByteString)++ read8 fp tp = do+ let fp2 = fp <.> tpext5 tp+ ares :: L.ByteString <- readFile2 fp2+ return . wrap7 $ ares
+ tests/Testing.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+--+-- Module : top tests for layout+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++-- module Testing where -- must have Main (main) or Main where+++--import System.Exit++import Test.Framework++-- import {-@ HTF_TESTS @-} Uniform.FileStrings_test+-- -- import {-@ HTF_TESTS @-} Uniform.ByteString_test+import {-@ HTF_TESTS @-} Uniform.Filenames_test+-- import {-@ HTF_TESTS @-} Uniform.PathShowCase_test+-- import {-@ HTF_TESTS @-} Uniform.FileStatus_test+-- -- import {-@ HTF_TESTS @-} Uniform.Piped_test+-- import {-@ HTF_TESTS @-} Uniform.TypedFile_test++import Uniform.Strings+import Uniform.Error +--import TestingFileIO++test_fileio = assertBool False++main :: IO ()+main = do++ putIOwords ["HTF LayoutTest.hs:\n posTest"]+-- htfMainWithArgs ["--quiet"] htf_importedTests+ htfMain htf_importedTests+ putIOwords ["HTF end LayoutTest.hs:\n posTest"]+ runTest test_fileio+ return ()++file1test = do+ putStrLn "file1test"+ -- push2+ -- runErrorVoid $ do + -- test_hidden1+ return ()
+ tests/Uniform/FileStatus_test.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+--+-- Module : uniform-FileIO+-- Copyright : andrew u frank -+--+-- | the routines to take apart the file status+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE+ MultiParamTypeClasses+ , TypeSynonymInstances+ , FlexibleInstances+ , FlexibleContexts+-- , DeriveFunctor+ , ScopedTypeVariables+-- , UndecidableInstances+ , TypeFamilies+ , OverloadedStrings++ #-}+-- {-# OPTIONS_GHC -fno-warn-missing-methods #-}++{-# OPTIONS -w #-}++module Uniform.FileStatus_test where++----import qualified Data.Text as T+----import Path+----import Path.IO+--import qualified System.Posix as P+--import qualified System.Directory as S+------import Basics+--import Uniform.Error+--import Uniform.Zero+--import Uniform.Strings+--import Uniform.Filenames++import Test.Framework+++++
+ tests/Uniform/FileStrings_test.hs view
@@ -0,0 +1,271 @@+------------------------------------------------------------------------------+--+-- Module : FileIO.Strings+--+-- | the instance for strings (was in 0.1.1)+-- filenames are Path+-- should only export the instances+-- removed -- file content can be lazy bytestring+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+-- {-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS -w #-}++module Uniform.FileStrings_test where++import Uniform.FileStrings+import Uniform.FileIOalgebra+--import Uniform.FilenamesAlgebra+import Uniform.Filenames+import Uniform.FileStatus+-- import Uniform.Strings hiding ((<.>), (</>))++import Test.Framework+import Test.Invariant+import Data.List+--import Path as P+--import Path.IO as P+--+--import Path+--import Path.IO+--+---- what is further required?+--import qualified System.IO as SIO+--import System.Posix (FileMode)+--+--+--import qualified Data.ByteString as BS (readFile, writeFile)+import qualified Data.ByteString.Lazy as L+--import Data.Digest.Pure.MD5 (md5)+----import Data.Hash.MD5 (md5s)+--import Data.Maybe (catMaybes)+--import qualified Data.Text.IO as T (readFile, writeFile, appendFile)+--import qualified Data.Text.IO as TIO (hGetLine, hPutStr)+--+--import qualified System.Directory as D+----import qualified System.Directory as D+--import qualified System.FilePath as OS+---- (addExtension, makeRelative, FilePath, combine, splitPath,+---- takeDirectory, replaceExtension, takeExtension)+--import qualified System.Posix as P+---- for fileAccess+--import Control.Arrow (second)+--import Control.DeepSeq (force, ($!!))+--import Control.Exception (SomeException, catch)+--import Control.Monad.Catch+--import Control.Monad.IO.Class+import Data.Either (isLeft)+--import Data.List (isPrefixOf)++----for testing:+--readFile5 :: Path ar File -> IO Text+--readFile5 = fmap s2t .readFile . toFilePath+++--------------------------test with path++notexisting = makeRelFile "xxxxabcd"++test_catch_error2p = do+ res <- runErr $ do+ f :: Text <- readFile2 notexisting+ return False+ `catchError `+ \(e::Text) -> return True+ assertEqual (Right True) res++test_call_IOp = do+ res <- runErr $ do+ f :: String <- readFile2 notexisting -- not existing fileAccess+ return False -- expect that read fials+ assertEqual ( Left "xxxxabcd: openFile: does not exist (No such file or directory)") res++test_call_IO_Lp = do+ res <- runErr $ do+ f :: L.ByteString <- readFile2 notexisting -- not existing fileAccess+ return False -- expect that read fials+ assertEqual ( Left "xxxxabcd: openBinaryFile: does not exist (No such file or directory)") res++test_call_NotExist = do+ res <- runErr $ do+ f :: Bool <- doesFileExist' notexisting -- not existing fileAccess+ return f+ assertEqual (Right False) res++--test_call_IO_Corrupt= do+-- res <- runErr $ callIO $ do+-- f :: L.ByteString <- L.readFile corruptJPG -- not existing fileAccess+-- putIOwords ["call_IO_Corrupt", showT . L.length $ f] -- just to enforce strictness+-- return False -- expect that read fials+-- assertEqual ( Left "/home/frank/additionalSpace/Photos_2016/sizilien2016/DSC04129.JPG: \+-- \hGetBufSome: hardware fault (Input/output error)") res++procFile = makeAbsFile "/proc/1/task/1/maps"+test_call_procp = do+ res <- runErr $ do+ f :: Text <- readFile2 procFile -- not allowed fileAccess+ return False -- expect that read fials+ assertBool (isLeft res)+-- assertEqual ( Left "/proc/1/task/1/maps: openBinaryFile: permission denied (Permission denied)") res++test_createNewDirFile = do+ let fn = makeAbsFile "/home/frank/test/1.test"+ r <- runErr $ writeFileOrCreate2 fn ("testtext"::Text)+ assertEqual (Right () ) r++dir31 = "dir4test" :: FilePath+abs31 = "/home/frank/Workspace8/uniform/uniform-fileio" :: FilePath +abs3131 = abs31 </> dir31++res3131 = sort + ["/home/frank/Workspace8/uniform/uniform-fileio/dir4test/testghci",+ "/home/frank/Workspace8/uniform/uniform-fileio/dir4test/testfile.txt",+ "/home/frank/Workspace8/uniform/uniform-fileio/dir4test/Setup.lhs",+ "/home/frank/Workspace8/uniform/uniform-fileio/dir4test/testgitignore"]++res3131wh = sort $ "/home/frank/Workspace8/uniform/uniform-fileio/dir4test/.ghci" : + res3131++test_getDirCont1 = do+ res :: ErrOrVal [FilePath] <- runErr $ getDirContentFiles (abs3131) + assertEqual (Right res3131wh) (fmap sort res ) ++test_getDirCont2 = do + res :: ErrOrVal [Path Abs File] <- + runErr $ getDirContentFiles (makeAbsDir abs3131)+ assertEqual (Right (map makeAbsFile res3131wh)) (fmap sort res ) + -- (fmap makeAbsFile res3131) res ++res3132 :: [FilePath]+res3132 = sort $ "dir4test/.ghci" :+ ["dir4test/testghci", "dir4test/testfile.txt",+ "dir4test/Setup.lhs", "dir4test/testgitignore"]++test_getDirCont3 = do+ res :: ErrOrVal [FilePath] <- runErr $ getDirContentFiles (dir31) + assertEqual (Right res3132) (fmap sort res ) + -- gives hidden and ++test_getDirCont4 = do + res :: ErrOrVal [Path Rel File] <- + runErr $ getDirContentFiles (makeRelDir dir31)+ assertEqual (Right (map makeRelFile res3132)) (fmap sort res ) + -- (fmap makeAbsFile res3131) res ++res3134 = sort -- no hidden+ ["dir4test/testghci", "dir4test/testfile.txt",+ "dir4test/f1", "dir4test/Setup.lhs", "dir4test/f2",+ "dir4test/testgitignore"]++res3135 = -- with hidden + "dir4test/.ghci" : res3134+++test_hidden1 = do -- no hidden files+ res :: ErrOrVal [FilePath] <- + runErr $ getDirContNonHidden dir31+ assertEqual (Right ( res3134)) (fmap sort res )++test_hidden2 = do -- with hidden files+ res :: ErrOrVal [FilePath] <- + runErr $ getDirCont dir31+ assertEqual (Right ( res3135)) (fmap sort res )+ -- (fmap makeAbsFile res3131) res ++--test_md5_nonReadablep = do+-- res :: ErrOrVal (Maybe Text) <- runErr $ getMD5 procFile+-- putIOwords ["test_md5_nonReadable res", showT res]+-- assertEqual (Left "getMD5 error for \"/proc/1/task/1/maps\"") res+--+--+--test_before = do+-- let fna = makeAbsFile "/home/frank/test/a.test"+-- let fnb = makeAbsFile "/home/frank/test/b.test"+-- r <- runErr $ isFileAbeforeB fna fnb+-- assertEqual (Right True ) r+++--------------old test with filepath+--+--+--test_catch_error2 = do+-- res <- runErr $ do+-- f :: Text <- readFile2 ("xxxabcd" :: FilePath)+-- return False+-- `catchError `+-- \(e::Text) -> return True+-- assertEqual (Right True) res+--+--test_call_IO = do+-- res <- runErr $ do+-- f :: String <- callIO $ readFile "xxxabcd17" -- not existing fileAccess+-- return False -- expect that read fials+-- assertEqual ( Left "xxxabcd17: openFile: does not exist (No such file or directory)") res+--+--test_call_IO_L = do+-- res <- runErr $ do+-- f :: L.ByteString <- callIO $ L.readFile "xxxabcd17" -- not existing fileAccess+-- return False -- expect that read fials+-- assertEqual ( Left "xxxabcd17: openBinaryFile: does not exist (No such file or directory)") res+--+----test_call_IO_Corrupt= do+---- res <- runErr $ callIO $ do+---- f :: L.ByteString <- L.readFile corruptJPG -- not existing fileAccess+---- putIOwords ["call_IO_Corrupt", showT . L.length $ f] -- just to enforce strictness+---- return False -- expect that read fials+---- assertEqual ( Left "/home/frank/additionalSpace/Photos_2016/sizilien2016/DSC04129.JPG: \+---- \hGetBufSome: hardware fault (Input/output error)") res+--+--test_call_proc = do+-- res <- runErr $ do+-- f <- callIO $ L.readFile "/proc/1/task/1/maps" -- not existing fileAccess+-- return False -- expect that read fials+-- assertEqual ( Left "/proc/1/task/1/maps: openBinaryFile: permission denied (Permission denied)") res+--+--test_md5_nonReadable = do+-- res :: ErrOrVal (Maybe Text) <- runErr $ getMD5 ("/proc/1/task/1/maps" ::FilePath)+-- putIOwords ["test_md5_nonReadable res", showT res]+-- assertEqual (Left "getMD5 error for \"/proc/1/task/1/maps\"") res+--+--corruptJPG = "/home/frank/additionalSpace/Photos_2016/sizilien2016/DSC04129.JPG" ::FilePath+--+----test_fail = assertEqual "Fail intentionally just to insure that tests are run"(""::Text)+---- readable on santafe but not oporto+----test_md5_nonReadable2 :: IO ()+----test_md5_nonReadable2 = do+---- res :: ErrOrVal (Maybe Text) <- runErr $ getMD5 corruptJPG+---- putIOwords ["test_md5_nonReadable corrupt jpg file", showT res]+---- -- does not catch the error?+---- assertEqual (Left "getMD5 error for \"/home/frank/additionalSpace/Photos_2016/sizilien2016/DSC04129.JPG\"") res+------ `catch` \(e::SomeException) -> do+------ putIOwords ["caught with catch in test_md5_nonReadable2 ", showT e]+------ return ()+--+---- not corrupt on santa fe, but on oporto+----test_md5_catch :: IO ()+----test_md5_catch = do+---- res3 :: ErrOrVal ByteString <- runErr $ callIO $ do+---- res1 :: L.ByteString <- L.readFile corruptJPG+---- let res2 = L.toStrict res1+---- return $!! res2+---- assertEqual (Left "/home/frank/additionalSpace/Photos_2016/sizilien2016/DSC04129.JPG: hGetBufSome: hardware fault (Input/output error)") res3+------ `catch` \(e::SomeException) -> do+------ putIOwords ["caught with catch in test_md5_catch ", showT e]+------ return ()+--+--test_symlink :: IO ()+--test_symlink = do+-- let t = makeAbsFile "/bin/X11/X11"+-- isSymlink1 <- D.pathIsSymbolicLink (OS.dropTrailingPathSeparator $ toFilePath t)+-- isSymlink2 <- D.pathIsSymbolicLink "/bin/X11/X11" -- (toFilePath t)+-- isSymlink3 <- D.pathIsSymbolicLink "/bin/X11/X11/" -- (toFilePath t)+-- assertEqual (True, True, False) (isSymlink1, isSymlink2, isSymlink3)+--+--
+ tests/Uniform/Filenames_test.hs view
@@ -0,0 +1,299 @@+--{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+--+-- Module : Filenames+-- Copyright : andrew u frank -+--+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}++-- {-# OPTIONS_GHC -fno-warn-missing-methods #-}++-- | the operations on filenames and extensions+-- uses the Path library+-- is a class except for the make+module Uniform.Filenames_test where++--+--+---- using uniform:++-- import Test.Invariant++import qualified Path -- for Generics+import Test.Framework+import Uniform.Error hiding ((<.>), (</>))+import Uniform.Filenames++--+test_show = assertEqual "Path Rel File afile" (show g1)++test_read = assertEqual g1 (read "Path Rel File afile")++test_read2 = assertEqual g1 (makeRelFile "afile")++--test_readrd = assertEqual g1 (read "afile")+test_readaf = assertEqual g3 (read "Path Abs File /somedir/more/afile.ext")++--test_readrf = assertEqual g1 (read "afile")++testdir1 = makeAbsDir "/home/frank/test"++testfile1 = "file1.x" :: FilePath++testdir2 = "files" :: FilePath++test_addFilename = assertEqual "/home/frank/test/file1.x" (toFilePath $ addFileName testdir1 testfile1)++--test_addFilenameEmpty = assertEqual "" (toFilePath $ addFileName testdir1 (""::FilePath))+-- does fail++test_addDir = assertEqual "/home/frank/test/files/" (toFilePath $ addDir testdir1 testdir2)++test_addDirEmpty = assertEqual "/home/frank/test/" (toFilePath $ addDir testdir1 ("" :: FilePath))++--test_abs1 = assertEqual "" $ makeAbsDir "file://home/frank/additionalSpace/DataBig/LitTest/test"++test_zeroAbsFile = assertEqual "/zero" (toFilePath (zero :: Path Abs File))++test_zeroAbsDir = assertEqual "/" (toFilePath (zero :: Path Abs Dir))++test_zeroRelFile = assertEqual "zero" (toFilePath (zero :: Path Rel File))++test_zeroRelDir = assertEqual "./" (toFilePath (zero :: Path Rel Dir))++testname = "/home/frank/dir1/file.ext" :: FilePath++test_immediateParent = assertEqual "dir1" (getImmediateParentDir testname)++test_nakedFilename = assertEqual "file" (getNakedFileName testname)++testname2 = makeAbsFile testname++test_immediateParent2 = assertEqual "dir1" (getImmediateParentDir testname2)++test_nakedFilename2 = assertEqual "file" (getNakedFileName testname2)++--------+x1f = makeAbsFile f3 :: Path Abs File++x1t = showT x1f++x1s = t2s x1t++x1ss = show x1f++test_sp =+ assertEqual+ "Path Abs File /somedir/more/afile.ext"+ (show x1f)++-- test_sp1 = assertEqual ("/somedir/more/afile.ext"::String) (read x1s)+test_sp2 = assertEqual (x1f :: Path Abs File) (read x1ss)++test_sp3 =+ assertEqual+ (x1f :: Path Abs File)+ (read "Path Abs File /somedir/more/afile.ext")++data Rec11 = Rec11 {date :: Path Abs File} deriving (Show, Read, Eq)++rec1 = Rec11 x1f++rec1s = show rec1++test_r1 = assertEqual "Rec11 {date = Path Abs File /somedir/more/afile.ext}" (rec1s)++-- test_r2 = assertEqual rec1 (readNote "r2 test" rec1s :: Rec11)+-- the path reading in records does not work yet++-- -- test_force = assertBool False++data S2 = S2 String String deriving (Show, Read, Eq)++--instance Read S2 where+-- readsPrec i s = [(S2 a b, r)]+-- where+-- [(b, r)] = readsPrec i s2+-- [(a, s2)] = readsPrec i s++test_p = assertEqual [("DREI", " someMore")] (readsPrec 0 "\"DREI\" someMore")++s2a = S2 "eins" "zwei"++s2as = show s2a -- "S2 \"eins\" \"zwei\""++test_s2aa = assertEqual "S2 \"eins\" \"zwei\"" (s2as)++test_s2a = assertEqual s2a (read "S2 \"eins\" \"zwei\"")++data Xt = Xt+ { p :: Path Abs File,+ q :: Text+ }+ deriving (Show, Read, Eq)++--instance Read (Path Abs File) where+-- readsPrec i r = -- r ist "/somedir/more/afile.ext", q = "f3"}+-- [(makeAbsFile x, rem)] -- ", q = \"f3\"")]+-- where+-- [(x ::String , rem)] = readsPrec i r++-- xt = Xt x1f "f3"+-- xt3 = Xt "/somedir/more/afile.ext" "f3"+-- xts = show xt++-- test_xt1 = do+-- putIOwords ["xt1 - xts is:", s2t xts]+-- putIOwords ["xt1 - show xt is:", showT xt]+-- assertEqual xt (read $ xts)++-- xt2 = Xt {p = "Path Abs File /somedir/more/afile.ext", q = "f3"}++--test_rp = do+-- putIOwords ["rp - f3 :", s2t f3s]+-- assertEqual [(x1f, "")] (readsPrec 0 f3s :: [(Path Abs File, String)] )+--+--test_r2 = assertEqual x1f (readNote "r2" f3s)+--f3s = show x1f+--+----instance Show (Path Abs File) where+---- show = toFilePath+--+--test_xt2 = do -- ok+-- putIOwords ["xt2 - s:", x1s]+-- putIOwords ["xt1 - show p . xt is:", showT . p $ xt]+-- assertEqual x1f (readT $ x1s)+--+--test_rp2 = do -- ok+-- putIOwords ["xt2 - x1s:", x1s]+---- putIOwords ["xt1 - show p . xt is:", showT . p $ xt]+-- assertEqual [(x1f,"")] (readsPrec 0 . t2s $ x1s)+--+--test_rp3 = do+-- putIOwords ["xt2 - x1ss:", s2t x1ss]+---- putIOwords ["xt1 - show p . xt is:", showT . p $ xt]+-- assertEqual [(x1f,"")] (readsPrec 0 $ x1ss)+--+--+--+--xt2r = readT xt2 :: Xt+--readT :: Read a => Text -> a+--readT s = readNote "readNotJust" . t2s $ s+--xt2 = showT xt :: Text+--x1ss = t2s x1s ++ ", some text" :: String+------------------tests++-- rigerous filepath testing is difficult,+-- as many inputs are not leading to leagal path+f1 = "afile" :: FilePath++f0 = "" :: FilePath -- not legal?++f2 = "afile.ext" :: FilePath++f3 = "/somedir/more/afile.ext" :: FilePath++f4 = "afile.gut.ext" :: FilePath++test_emptyExt = assertEqual "" (getExtension f1)++test_emptyExt0 = assertEqual "" (getExtension f0)++test_getExt = assertEqual "ext" (getExtension f2)++test_hasExt = assertBool $ hasExtension "ext" f2++test_hasExt2 = assertBool $ hasExtension "ext" f3++test_addExt = assertEqual (f2) $ addExtension "ext" f1++test_removeExt = assertEqual f1 (removeExtension f2)++test_setExt = assertEqual ("afile.txt") (setExtension "txt" f2)++test_removeExt2 = assertEqual f1 (removeExtension . removeExtension $ f4)++f4p = makeRelFile f4++f1p = makeRelFile f1++test_removeExt2path =+ assertEqual+ f1p+ (removeExtension . removeExtension $ f4p)++--prop_add_has_FP :: FilePath -> FilePath -> Bool+--prop_add_has_FP e f = if (isInfixOf' "." e) then True else prop_add_has e f+--prop_add_add_has_FP :: FilePath ->FilePath ->FilePath -> Bool+--prop_add_add_has_FP = prop_add_add_has+--prop_set_get_FP :: FilePath -> FilePath -> Bool+--prop_set_get_FP = prop_set_get++g1 = makeRelFile "afile" :: Path Rel File++--g0 = "" -- not legal?+g2 = makeRelFile "afile.ext"++g3 = makeAbsFile "/somedir/more/afile.ext"++g4 = makeAbsFile "/somedir/more/afile.txt"++e1 = (Extension "ext")++test_emptyExt_P = assertEqual (Extension "") (getExtension g1)++--test_emptyExt0 = assertEqual "" (getExtension f0)+test_getExt_P = assertEqual e1 (getExtension g2)++test_hasExt_P = assertBool $ hasExtension e1 g2++test_hasExt2_P = assertBool $ hasExtension e1 g2++test_addExt_P = assertEqual (g2) $ addExtension e1 g1++test_removeExt_P = assertEqual g1 (removeExtension g2)++test_setExt_P = assertEqual (g4) (setExtension (Extension "txt") g3)++d1 = makeAbsDir "/somedir/more/dir"++test_nakedDir = assertEqual "dir" (getNakedDir d1)++-- data TestRec = TestRec {f11:: Path Abs Dir} deriving (Show, Eq, Read)+-- inp1 = TestRec { f11 = "/home/frank/"}+-- inp2 = TestRec { f11 = makeAbsDir "/home/frank/"}+-- f11x = "/home/frank/" :: Path Abs Dir++-- --test_read1 = assertEqual inp1 (inp1) -- must fail, reading a string into Path Abs+-- -- -- not permitted (should be detected when assign to inp1+-- test_read12 = assertEqual "" (show inp1)+-- test_read22 = assertEqual "TestRec {f11 = \"/home/frank/\"}" (show inp2)++test_doubleExtension =+ assertEqual+ ("afile.triples.gzip")+ (toFilePath $ addExtension (Extension "triples.gzip") g1)++-- test_doubleExtensionBase = assertEqual ("b2.triples.gzip")+-- (toFilePath . fromJustNote "t1" $+-- Path.addExtension ".triples.gzip" g1)++test_hasExtension =+ assertEqual True $+ hasExtension (Extension "md") (makeRelFile "test.md")++test_getExtension =+ assertEqual (Extension "md") $+ getExtension (makeRelFile "test.md")++test_parentDir = assertEqual ("/somedir/more") (getParentDir f3)++test_immediateparentDir = assertEqual ("more") (getImmediateParentDir f3)
+ tests/Uniform/Piped_test.hs view
@@ -0,0 +1,100 @@+-----------------------------------------------------------------------------+--+-- Module : piped+-- Copyright : andrew u frank -+--+-- | the recursive access to many files not blocking+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE+ MultiParamTypeClasses+-- , TypeSynonymInstances+ , FlexibleInstances+ , FlexibleContexts+ , ScopedTypeVariables+ , UndecidableInstances+ , OverloadedStrings+-- , TypeFamilies+ #-}+-- {-# OPTIONS_GHC -fno-warn-missing-methods #-}++module Uniform.Piped_test where++import qualified Pipes as Pipe+import Pipes ((>->))+import qualified Pipes.Prelude as PipePrelude+----import Control.Monad (forM_)+--+----import System.Directory (doesDirectoryExist, getDirectoryContents)+--import System.Environment (getArgs)+----import System.FilePath ((</>))+----import System.IO (openFile, IOMode (..), hClose)+--+------ using uniform:+--import Uniform.Error+----import Uniform.Zero+import Uniform.Strings hiding ((<.>), (</>))+----+import Uniform.Filenames+----import Uniform.FileIO+import Uniform.FileStrings (openFile2handle, closeFile2, IOMode(..))+--import Uniform.Filenames+--import Data.List (sort)++import Test.Framework+--import Test.Invariant+import Uniform.Piped+import qualified Path.IO as Path.IO (makeAbsolute)++++test_recursive = do+-- let testdir = makeRelDir "testDirFileIO"+-- let resfileN = makeRelFile "testDirResN"+-- let resfile0 = makeRelFile "testDirRes0"+-- testdir2 <- fmap Path $ Path.IO.makeAbsolute (unPath testdir)+-- runErr $ do+-- hand <- openFile2handle resfileN WriteMode+-- Pipe.runEffect $+-- getRecursiveContents testdir2+-- >-> PipePrelude.map toFilePath+-- ---- >-> P.stdoutLn+-- >-> PipePrelude.toHandle hand+-- closeFile2 hand+-- res0 ::Text <- readFile5 resfile0+-- resN :: Text <- readFile5 resfileN+-- assertEqual res0 resN+ assertEqual "" ""++++testDir = makeAbsDir "/home/frank/Workspace8/uniform-fileio/testDirFileIO"+test_getRec = do+ res <- runErr $ pipedDo testDir (showT)+ assertEqual (Right ()) res+ -- check manually++----for testing:+readFile5 :: Path ar File -> IO Text+readFile5 = fmap s2t .readFile . toFilePath++pipedDo :: Path Abs Dir -> (Path Abs File -> Text) -> ErrIO ()+pipedDo path transf = do+ Pipe.runEffect $+ getRecursiveContents path+ >-> PipePrelude.map (t2s . transf)+ >-> PipePrelude.stdoutLn++--pipedDoIO :: Path Abs File -> Path Abs Dir -> (Path Abs File -> ErrIO Text) -> ErrIO ()+---- | write to the first filename the operation applied to the dir tree in the second+---- first path must not be non-readable dir or+--pipedDoIO file path transf = do+-- hand <- openFile2handle file WriteMode+-- Pipe.runEffect $+-- getRecursiveContents path+-- >-> PipePrelude.map (fmap t2s . transf) -- some IO type left?+-- -- >-> P.stdoutLn+-- >-> PipePrelude.toHandle hand+---- >-> (\s -> PipePrelude.toHandle hand (s::String))+-- closeFile2 hand+
+ tests/Uniform/TypedFile_test.hs view
@@ -0,0 +1,74 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+--{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+-- {-# OPTIONS -Wall #-}+-- {-# OPTIONS -fno-warn-missing-signatures #-}+{-# OPTIONS -w #-}++module Uniform.TypedFile_test where++import Test.Framework++--import Uniform.Error+import Uniform.FileIOalgebra (Handle)+import Uniform.Filenames+import Uniform.FileStrings+--import Uniform.FileIO (EpochTime, getFileModificationTime)+import Uniform.FileStatus+import Uniform.Strings +import qualified Data.ByteString.Lazy as L++import Uniform.TypedFile+++textLinesFile = makeTyped (Extension "txt") ::TypedFile5 [Text] ()+dir1 = makeAbsDir "/home/frank/"+file1 = makeRelFile "aaa"+ct = ["eins", "zwei"] :: [Text]+test_write = do+ r <- runErr $ write5 dir1 file1 textLinesFile ct+ assertEqual (Right () ) r++test_read = do+ r <- runErr $ read5 dir1 file1 textLinesFile+ assertEqual (Right ct ) r++-- data CompressedByteString+-- a gzip compressed bytestring -- +gzippedTriples = TypedFile5 {tpext5 = Extension "triples.gzip"} + :: TypedFile5 L.ByteString [Text]++test_gz4txt = do + r <- runErr $ write8 (dir1 </> file2) gzippedTriples ct+ assertEqual (Right ()) r ++file2 = makeRelFile "b2"++test_gz4back = do + r <- runErr $ read8 (dir1 </> file2) gzippedTriples + assertEqual (Right ct) r ++instance TypedFiles7 L.ByteString [Text] where+ unwrap7 = compress . b2bl . t2b . showT+ wrap7 = read . t2s . bb2t . bl2b . decompress + -- - | the a is the base type+ -- -- which is written on file, b is the type for input and output+ -- class FileHandles a => TypedFiles7 a b where+ -- wrap7 :: a -> b+ -- unwrap7 :: b -> a+ +-- issues with extension - should not include leading '.' +-- but path operations require it+test_extension :: IO ()+test_extension = assertEqual (Extension "triples.gzip")+ (tpext5 gzippedTriples) ++test_fileFormed = assertEqual ("b2.txt")+ (toFilePath $ file2 <.> (Extension "txt"))+test_fileFormed2 = assertEqual ("b2.triples.gzip")+ (toFilePath $ file2 <.> (tpext5 gzippedTriples))+
+ uniform-fileio.cabal view
@@ -0,0 +1,103 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: f4d7504acb161ad2dbeebdcd82fbe61db899dc04a7bef35d0699563f9c128713++name: uniform-fileio+version: 0.1.0+synopsis: Uniform file handling operations+description: Uniform operations for handling files and file path names+ independent from the representation. + .+ Additionally, functions to read and write files for specific + typed content (marked by extension).+ .+ Please see the README on GitHub at <https://github.com/andrewufrank/uniform-fileiio/readme>+category: Data Text Uniform+bug-reports: https://github.com/andrewufrank/uniform-fileio/issues+author: Andrew Frank+maintainer: Andrew U. Frank <uniform@gerastree.at>+copyright: 2021 Andrew U. Frank+license: GPL-2.0-only+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++library+ exposed-modules:+ Uniform.FileIO+ Uniform.FileIOalgebra+ Uniform.Filenames+ Uniform.FileStatus+ Uniform.FileStrings+ Uniform.Piped+ Uniform.TypedFile+ other-modules:+ Paths_uniform_fileio+ hs-source-dirs:+ ./.+ build-depends:+ base >=4.7 && <5+ , bytestring+ , deepseq+ , directory+ , exceptions+ , filepath+ , monads-tf+ , path+ , path-io+ , pipes+ , pureMD5+ , safe+ , text+ , uniform-algebras+ , uniform-error+ , uniform-strings+ , uniform-time+ , unix+ , zlib+ default-language: Haskell2010+ autogen-modules: Paths_uniform_fileio++test-suite strings-test+ type: exitcode-stdio-1.0+ main-is: Testing.hs+ other-modules:+ Uniform.Filenames_test+ Uniform.FileStatus_test+ Uniform.FileStrings_test+ Uniform.Piped_test+ Uniform.TypedFile_test+ Paths_uniform_fileio+ hs-source-dirs:+ tests+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HTF+ , base >=4.7 && <5+ , bytestring+ , deepseq+ , directory+ , exceptions+ , filepath+ , monads-tf+ , path+ , path-io+ , pipes+ , pureMD5+ , quickcheck-text+ , safe+ , test-invariant+ , text+ , uniform-algebras+ , uniform-error+ , uniform-fileio+ , uniform-strings+ , uniform-time+ , unix+ , zlib+ default-language: Haskell2010