diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -8,3 +8,9 @@ 0.0.14.6 fix fileExtension confusion 0.0.15.0 fix building issue with time 0.0.15.2 lts 16.0 +0.1.0 put in hackage + removed doubtful pieces +0.1.1 + added pipedDoIOWithFilter +0.1.2 + prepare for 9.2.1 diff --git a/Uniform/FileIO.hs b/Uniform/FileIO.hs --- a/Uniform/FileIO.hs +++ b/Uniform/FileIO.hs @@ -11,7 +11,9 @@ ---------------------------------------------------------------------- {-# OPTIONS_GHC -fno-warn-deprecations #-} +-- {-# LANGUAGE DeriveAnyClass #-} + module Uniform.FileIO ( module Uniform.Filenames , module Uniform.FileStatus @@ -19,6 +21,7 @@ , module Uniform.TypedFile , module Uniform.FileStrings , module Uniform.Piped + -- , module Uniform.PathShowCase , Path.IO.getAppUserDataDir , Path.IO.doesFileExist --works in IO, not ErrIO ) where @@ -29,4 +32,9 @@ import Uniform.FileStrings import Uniform.Piped import Uniform.TypedFile +-- import Uniform.PathShowCase() import qualified Path.IO (makeAbsolute, getAppUserDataDir, doesFileExist) + +-- import UniformBase + +-- data Aby40 = Aby40 Int (Path Abs Dir) deriving (Eq, Ord, Show, Read) diff --git a/Uniform/Filenames.hs b/Uniform/Filenames.hs --- a/Uniform/Filenames.hs +++ b/Uniform/Filenames.hs @@ -18,31 +18,38 @@ module Uniform.Filenames ( module Uniform.Filenames, module Uniform.Error, + -- module Path.Internal, + -- module Uniform.PathShowCase, Abs, Rel, File, Dir, Path, + -- Path.Path(..), toFilePath, ) where -- for Generics -import Path - ( Abs, - Dir, - File, - Path, - Rel, - toFilePath, - ) -import qualified Path +-- import Path +-- ( Abs, +-- Dir, +-- File, +-- Path, +-- Rel, +-- toFilePath, +-- Path +-- ) +import Path hiding ((), addExtension) +import qualified Path +-- import Path.Internal (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) +import Uniform.PathShowCase () takeBaseName' :: FilePath -> FilePath takeBaseName' = S.takeBaseName @@ -229,6 +236,7 @@ getExtension :: fp -> ExtensionType fp removeExtension :: fp -> fp addExtension :: ExtensionType fp -> fp -> fp + setFileExtension :: ExtensionType fp -> fp -> fp -- must not have an extension before (<.>) :: fp -> ExtensionType fp -> fp -- eror when not legal? @@ -253,7 +261,7 @@ getExtension = removeChar '.' . snd . S.splitExtension addExtension e fp = fp S.<.> e removeExtension = fst . S.splitExtension - setExtension e = addExtension e . removeExtension + setFileExtension e = addExtension e . removeExtension -- hasExtension e = (e ==) . getExtension diff --git a/Uniform/PathShowCase.hs b/Uniform/PathShowCase.hs new file mode 100644 --- /dev/null +++ b/Uniform/PathShowCase.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} +--{-# LANGUAGE GeneralizedNewtypeDeriving #-} +--{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} + +module Uniform.PathShowCase + ( module Uniform.PathShowCase + , module Path ) + + where + +import Uniform.Strings +-- import Uniform.Error + +import Path +-- import Data.Typeable +-- import Data.Data + + + +readsPrecForPath :: ([Char] -> Maybe a) + -> [Char] -> String -> [Char] -> [(a, [Char])] +readsPrecForPath parseAD prefix1 msg a0 = + if (prefix1 `isPrefixOf'` a1 ) + then [ (res2, rem2)] + else error ("not a prefix for " ++ msg ++ " input " ++ show a1) + + where + a1 = dropWhile isSpace a0 + a2 = stripPrefix' prefix1 a1 + a3 = fromJustNote "readPrec not prefix" a2 + (a4,rem2) = span terminate a3 -- what else could be terminating? + res1 = parseAD a4 -- there seem not to be a parser for filepath + res2 = fromJustNote (unwords["not a path ", msg, "input", show a0]) res1 + terminate :: Char -> Bool + terminate c = c `notElem` [',','}'] + -- add here character to stop reading !! + +instance Read (Path Abs Dir) where + readsPrec _ = readsPrecForPath parseAbsDir prefixAbsDir "Abs Dir" + +instance Read (Path Abs File) where + readsPrec _ = readsPrecForPath parseAbsFile prefixAbsFile "Abs File" + +instance Read (Path Rel File) where + readsPrec _ = readsPrecForPath parseRelFile prefixRelFile "Rel File" +instance Read (Path Rel Dir) where + readsPrec _ = readsPrecForPath parseRelDir prefixRelDir "Rel Dir" + + +instance {-# OVERLAPPING #-} Show (Path Abs Dir) where + show a = concat' [prefixAbsDir, toFilePath a] +instance {-# OVERLAPPING #-} Show (Path Abs File) where + show a = concat' [prefixAbsFile, toFilePath a] +instance {-# OVERLAPPING #-} Show (Path Rel File) where + -- show a = concat' [prefixRelFile, "\"", toFilePath a, "\""] + show a = concat' [prefixRelFile, toFilePath a] +instance {-# OVERLAPPING #-} Show (Path Rel Dir) where + show a = concat' [prefixRelDir, toFilePath a] + +-- class ShowPrefix p where +-- getPrefix :: p -> String +-- instance ShowPrefix (Path a b) + +-- instance ShowPrefix (Path Abs Dir) where +-- getPrefix a = prefixAbsDir +-- instance ShowPrefix (Path Abs File) where +-- getPrefix a = prefixAbsFile +-- instance ShowPrefix (Path Rel File) where +-- getPrefix a = prefixRelFile +-- instance ShowPrefix (Path Rel Dir) where +-- getPrefix a = prefixRelDir + +-- -- getPrefix (Path Abs File ) +-- -- show (undefined::Abs) = "Abs" + +-- instance (ShowPrefix (Path a b)) => Show (Path a b) where +-- show a = concat' [getPrefix a, toFilePath a] + +instance NiceStrings (Path a b) where + showNice = s2t . toFilePath + +instance PrettyStrings (Path a b) where + showPretty = showNice + +toFilePathT :: Path b t -> Text +toFilePathT = s2t . toFilePath + +prefixAbsDir, prefixAbsFile, prefixRelDir, prefixRelFile :: String +prefixAbsFile = "Path Abs File " +prefixAbsDir = "Path Abs Dir " +prefixRelFile = "Path Rel File " +prefixRelDir = "Path Rel Dir " diff --git a/Uniform/Piped.hs b/Uniform/Piped.hs --- a/Uniform/Piped.hs +++ b/Uniform/Piped.hs @@ -14,6 +14,7 @@ ( getRecursiveContents, -- , pipeMap, pipeStdoutLn pipedDoIO, + pipedDoIOwithFilter ) where @@ -83,10 +84,25 @@ -- recursively apply a function to each pipedDoIO :: Path Abs File -> Path Abs Dir -> (Path Abs File -> Text) -> ErrIO () pipedDoIO file path transf = do + -- pipedDoIOwithFilter file path ?? transf hand <- openFile2handle file WriteMode Pipe.runEffect $ getRecursiveContents path >-> PipePrelude.map (t2s . transf) -- some IO type left? + >-> PipePrelude.toHandle hand + closeFile2 hand + return () + +-- a convenient function to go through a directory and +-- recursively apply a function to each file or directory +-- filters for extension md +pipedDoIOwithFilter :: Path Abs File -> Path Abs Dir -> Extension -> (Path Abs File -> ErrIO String) -> ErrIO () +pipedDoIOwithFilter file path ext opex = do + hand <- openFile2handle file WriteMode + Pipe.runEffect $ + getRecursiveContents path + >-> PipePrelude.filter (hasExtension ext) + >-> PipePrelude.mapM opex >-> PipePrelude.toHandle hand closeFile2 hand return () diff --git a/tests/Testing.hs b/tests/Testing.hs deleted file mode 100644 --- a/tests/Testing.hs +++ /dev/null @@ -1,52 +0,0 @@ ------------------------------------------------------------------------------ --- --- 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 () diff --git a/tests/Uniform/FileStatus_test.hs b/tests/Uniform/FileStatus_test.hs deleted file mode 100644 --- a/tests/Uniform/FileStatus_test.hs +++ /dev/null @@ -1,43 +0,0 @@ ------------------------------------------------------------------------------ --- --- 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 - - - - - diff --git a/tests/Uniform/FileStrings_test.hs b/tests/Uniform/FileStrings_test.hs deleted file mode 100644 --- a/tests/Uniform/FileStrings_test.hs +++ /dev/null @@ -1,271 +0,0 @@ ------------------------------------------------------------------------------- --- --- 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) --- --- diff --git a/tests/Uniform/Filenames_test.hs b/tests/Uniform/Filenames_test.hs deleted file mode 100644 --- a/tests/Uniform/Filenames_test.hs +++ /dev/null @@ -1,299 +0,0 @@ ---{-# 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) diff --git a/tests/Uniform/Piped_test.hs b/tests/Uniform/Piped_test.hs deleted file mode 100644 --- a/tests/Uniform/Piped_test.hs +++ /dev/null @@ -1,100 +0,0 @@ ------------------------------------------------------------------------------ --- --- 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 - diff --git a/tests/Uniform/TypedFile_test.hs b/tests/Uniform/TypedFile_test.hs deleted file mode 100644 --- a/tests/Uniform/TypedFile_test.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# 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)) - diff --git a/uniform-fileio.cabal b/uniform-fileio.cabal --- a/uniform-fileio.cabal +++ b/uniform-fileio.cabal @@ -1,13 +1,13 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.2. +-- This file has been generated from package.yaml by hpack version 0.34.6. -- -- see: https://github.com/sol/hpack -- --- hash: f4d7504acb161ad2dbeebdcd82fbe61db899dc04a7bef35d0699563f9c128713 +-- hash: 33312bf82225b563d57ce6bee1f6a88efc12f69f6fab28e8b5b87bc560b3efdb name: uniform-fileio -version: 0.1.0 +version: 0.1.2 synopsis: Uniform file handling operations description: Uniform operations for handling files and file path names independent from the representation. @@ -34,12 +34,13 @@ Uniform.Filenames Uniform.FileStatus Uniform.FileStrings + Uniform.PathShowCase Uniform.Piped Uniform.TypedFile other-modules: Paths_uniform_fileio hs-source-dirs: - ./. + ./ build-depends: base >=4.7 && <5 , bytestring @@ -54,50 +55,11 @@ , pureMD5 , safe , text - , uniform-algebras - , uniform-error - , uniform-strings - , uniform-time + , uniform-algebras >=0.1.2 + , uniform-error >=0.1.0 + , uniform-strings >=0.1.2 + , uniform-time >=0.1.0 , 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