diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -14,3 +14,4 @@ added pipedDoIOWithFilter 0.1.2 prepare for 9.2.1 +0.1.3 changed for ExceptionT (stat ErrorT) diff --git a/Uniform/FileStrings.hs b/Uniform/FileStrings.hs --- a/Uniform/FileStrings.hs +++ b/Uniform/FileStrings.hs @@ -104,13 +104,11 @@ testTarget <- doesDirExist' new if testTarget then - throwErrorT - [showT new] + throwErrorT . showT $ new else if not testSource then - throwErrorT - [showT old] + throwErrorT . showT $ old else do callIO $ putStrLn "renamed" r <- callIO $ D.renameDirectory old new @@ -148,14 +146,12 @@ else if not t then - throwErrorT - ["copyFile source not exist", showT old] + throwErrorWords ["copyFile source not exist", showT old] else if t2 then - throwErrorT - ["copyFile target exist", showT new] - else throwErrorT ["copyOneFile", "other error"] + throwErrorWords ["copyFile target exist", showT new] + else throwErrorWords ["copyOneFile", "other error"] copyOneFileOver old new = do -- may overwrite existing target t <- doesFileExist' old @@ -167,7 +163,7 @@ createDirIfMissing' dir callIO $ D.copyFile old new else -- not t - not existing source - throwErrorT ["copyFileOver source not exist", showT old] + throwErrorWords ["copyFileOver source not exist", showT old] getMD5 fn = do @@ -179,11 +175,11 @@ 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 + else throwErrorWords ["getMD5 error file not readable", showT fn] + `catchE` \e -> do putIOwords ["getMD5 in FileStrings.hs", showT fn, showT e] - throwErrorT ["getMD5 error for", showT fn] + throwErrorWords ["getMD5 error for", showT fn] getDirCont fn = getDirContAll True fn @@ -227,7 +223,7 @@ let r4 = map (fn ) r3 return r4 else - throwErrorT + throwErrorWords [ "getDirCont not exist or not readable", showT fn, showT testDir, @@ -315,8 +311,8 @@ callIO ( do Posix.fileAccess (unL fp) r w e - `catchError` \e -> do - putIOwords ["getFileAccess error", showT fp, s2t $ show e] + `catch` \e -> do + putIOwords ["getFileAccess error", showT fp, s2t $ show (e::SomeException)] return False ) diff --git a/Uniform/Filenames.hs b/Uniform/Filenames.hs --- a/Uniform/Filenames.hs +++ b/Uniform/Filenames.hs @@ -236,12 +236,14 @@ getExtension :: fp -> ExtensionType fp removeExtension :: fp -> fp addExtension :: ExtensionType fp -> fp -> fp - setFileExtension :: ExtensionType fp -> fp -> fp +-- setFileExtension :: ExtensionType fp -> fp -> fp +-- to avoid name clash with Path -- must not have an extension before (<.>) :: fp -> ExtensionType fp -> fp -- eror when not legal? (<.>) f e = addExtension e f setExtension :: ExtensionType fp -> fp -> fp + setExtension ext = addExtension ext . removeExtension hasExtension :: ExtensionType fp -> fp -> Bool hasExtension e = (e ==) . getExtension @@ -261,7 +263,8 @@ getExtension = removeChar '.' . snd . S.splitExtension addExtension e fp = fp S.<.> e removeExtension = fst . S.splitExtension - setFileExtension e = addExtension e . removeExtension +-- setExtension e = addExtension e . removeExtension + -- hasExtension e = (e ==) . getExtension diff --git a/Uniform/Piped.hs b/Uniform/Piped.hs --- a/Uniform/Piped.hs +++ b/Uniform/Piped.hs @@ -37,7 +37,7 @@ 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) () + Pipe.Proxy Pipe.X () () (Path Abs File) ErrIO () getRecursiveContents fp = do -- putIOwords ["recurseDir start", showT fp] perm <- Pipe.lift $ getPermissions' fp diff --git a/tests/Testing.hs b/tests/Testing.hs new file mode 100644 --- /dev/null +++ b/tests/Testing.hs @@ -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 () diff --git a/tests/Uniform/FileStatus_test.hs b/tests/Uniform/FileStatus_test.hs new file mode 100644 --- /dev/null +++ b/tests/Uniform/FileStatus_test.hs @@ -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 + + + + + diff --git a/tests/Uniform/FileStrings_test.hs b/tests/Uniform/FileStrings_test.hs new file mode 100644 --- /dev/null +++ b/tests/Uniform/FileStrings_test.hs @@ -0,0 +1,273 @@ +------------------------------------------------------------------------------ +-- +-- 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.Strings +import Uniform.Error +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 new file mode 100644 --- /dev/null +++ b/tests/Uniform/Filenames_test.hs @@ -0,0 +1,301 @@ +{-# 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 Uniform.Strings + +-- 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/PathShowCase_test.hs b/tests/Uniform/PathShowCase_test.hs new file mode 100644 --- /dev/null +++ b/tests/Uniform/PathShowCase_test.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- +-- Module : Uniform.Example_test +-- +----------------------------------------------------------------------------- +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +-- {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} + +-- | import examples to test with {\-@ HTF_TESTS @-\} +module Uniform.PathShowCase_test where + +import Control.Exception +import Path ( + parseAbsDir, + parseAbsFile, + parseRelDir, + parseRelFile, + ) +import qualified Path as P +import Test.Framework +import Uniform.Filenames +import Uniform.PathShowCase +import Uniform.Strings hiding ((<.>), (), (<|>)) + +-- import Uniform.Test.TestHarness +-- cannot be used (cycle fileio - convenience) + +data T1 = T1 + { a11 :: Text + , p11 :: Path Rel File + , n11 :: Int + } + deriving (Show, Read, Eq) + +t1 = T1 "some text" s11 37 +st1 = showT t1 +rt1 = read . t2s $ st1 :: T1 + +t2 = T1 "anoher long, atest text" r6 2009 +rt2 = read . show $ t2 :: T1 + +test_sc1 = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 50) t1 rt1 +test_sc2 = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 51) t2 rt2 + +data T2 = T2 + { a12 :: Text + , p12 :: Path Rel File + } + deriving (Show, Read, Eq) + +t22 = T2 "some interesting text" s11 +test_sc3 = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 58) t22 (read . show $ t22) + +s11 = makeRelFile "testFile.txt" :: Path Rel File + +-- r11 = "Path Rel File \"testFile.txt\"" +-- test_show1 = assertEqual r11 (showT s11) + +-- test_read = assertEqual s1 (readNoteT "243" . showT $ s1 ) + +-- test_toP = assertEqual (p3a) (s2t . P.toFilePath $ s3) +n1 = "testFile.txt" :: FilePath +p3 = P.parseRelFile n1 :: Maybe (P.Path Rel File) + +-- s3 = path2internal s2 :: P.Path Rel File +-- p3a = s2t . P.toFilePath . fromJustNote "sdsw" $ p3 + +test_makeRelDir = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 73) d4 f4 +f4 = makeRelDir "Workspace" +d4 = makeRelDir "Workspace/" :: Path Rel Dir +s4 = showT d4 +test_RelDir = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 77) d4 (readNoteT "RD" s4) + +test_addDir = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 79) r6 (addDir f4 n6) +n6 = makeRelFile n1 +r6 = makeRelFile "Workspace/testFile.txt" + +--------------- +pathShowTest :: IO () +pathShowTest = do + putIOwords ["the path as string", showT p1] + putIOwords ["the mayb pars ed path", showT p2] + putIOwords ["the mayb pars ed path 2", showT p2] + putIOwords ["the mayb pars ed path 2a", showT p2a] + putIOwords ["just px, typed Path Abs Dir", showT p2x] + putIOwords ["show r1 ", s2t r1] + putIOwords ["prefix stripped", s2t r3] + putIOwords ["parsed r3", showT r4] + +-- putIOwords ["read r2", showT r2] + +r1 = show p2x :: String +r2 = read r1 :: Path Abs Dir +r3 = + fromJustNote "prefix strip" + . stripPrefix' "Path Abs Dir " + $ r1 :: + String +r4 = parseAbsDir r3 :: Maybe (Path Abs Dir) + +p1 = "/home/frank/testDir" +p1a = "/home/frank/testDir/" +p2 = parseAbsDir p1 :: Maybe (Path Abs Dir) +p2a = parseAbsDir p1a :: Maybe (Path Abs Dir) +p2x = fromJustNote "p2xbad" p2 :: Path Abs Dir + +-- p3 = show px :: String -- same as p1 + +f11 = "/home/frank/test.txt" +f21 = parseAbsFile f11 :: Maybe (Path Abs File) +f2a = fromJustNote "f2" f21 +f31 = show f2a :: String +f41 = read f31 :: Path Abs File + +g1 = "frank/test.txt" +g2 = parseRelFile g1 :: Maybe (Path Rel File) +g2a = fromJustNote "g2" g2 +g3 = show g2a :: String +g4 = read g3 :: Path Rel File + +test_g = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 121) g2 (Just g4) +h1 = "frank/test" +h2 = parseRelDir h1 :: Maybe (Path Rel Dir) +h2a = fromJustNote "h2" h2 +h3 = show h2a :: String +h4 = read h3 :: Path Rel Dir + +test_h = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 128) h2a h4 +k1 = "/home/frank/test" +k2 = parseAbsDir k1 :: Maybe (Path Abs Dir) +k2a = fromJustNote "k2" k2 +k3 = show k2a :: String +k4 = read k3 :: Path Abs Dir + +test_k = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 135) k2a k4 + +l1 = "/home/frank/test/a.txt" +l2 = parseAbsFile l1 :: Maybe (Path Abs File) +l2a = fromJustNote "l2" l2 +l3 = show l2a :: String +l4 = read l3 :: Path Abs File + +test_l = assertEqual_ (makeLoc "/home/frank/Workspace11/uBase/uniform-fileio/tests/Uniform/PathShowCase_test.hs" 143) l2 (Just l4) diff --git a/tests/Uniform/Piped_test.hs b/tests/Uniform/Piped_test.hs new file mode 100644 --- /dev/null +++ b/tests/Uniform/Piped_test.hs @@ -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 + diff --git a/tests/Uniform/TypedFile_test.hs b/tests/Uniform/TypedFile_test.hs new file mode 100644 --- /dev/null +++ b/tests/Uniform/TypedFile_test.hs @@ -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)) + 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.6. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack -- --- hash: 33312bf82225b563d57ce6bee1f6a88efc12f69f6fab28e8b5b87bc560b3efdb +-- hash: 21c3552a28c18c58a0b0d8885de87f2b10bff2082df7d3c4b2f56a258b8114fb name: uniform-fileio -version: 0.1.2 +version: 0.1.3 synopsis: Uniform file handling operations description: Uniform operations for handling files and file path names independent from the representation. @@ -15,6 +15,8 @@ Additionally, functions to read and write files for specific typed content (marked by extension). . + added stack build lts 19.16 for ghc 9.0.2 + . Please see the README on GitHub at category: Data Text Uniform bug-reports: https://github.com/andrewufrank/uniform-fileio/issues @@ -56,10 +58,52 @@ , safe , text , uniform-algebras >=0.1.2 - , uniform-error >=0.1.0 + , uniform-error >=0.1.2 , uniform-strings >=0.1.2 , uniform-time >=0.1.0 , unix , zlib default-language: Haskell2010 autogen-modules: Paths_uniform_fileio + +test-suite fileio-test + type: exitcode-stdio-1.0 + main-is: Testing.hs + other-modules: + Uniform.Filenames_test + Uniform.FileStatus_test + Uniform.FileStrings_test + Uniform.PathShowCase_test + Uniform.Piped_test + Uniform.TypedFile_test + Paths_uniform_fileio + autogen-modules: + 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 >=0.1.2 + , uniform-error >=0.1.2 + , uniform-fileio + , uniform-strings >=0.1.2 + , uniform-time >=0.1.0 + , unix + , zlib + default-language: Haskell2010