uniform-fileio 0.1.2 → 0.1.3
raw patch · 12 files changed
+1065/−23 lines, 12 filesdep +HTFdep +quickcheck-textdep +test-invariantdep ~uniform-error
Dependencies added: HTF, quickcheck-text, test-invariant, uniform-fileio
Dependency ranges changed: uniform-error
Files
- ChangeLog.md +1/−0
- Uniform/FileStrings.hs +12/−16
- Uniform/Filenames.hs +5/−2
- Uniform/Piped.hs +1/−1
- tests/Testing.hs +52/−0
- tests/Uniform/FileStatus_test.hs +43/−0
- tests/Uniform/FileStrings_test.hs +273/−0
- tests/Uniform/Filenames_test.hs +301/−0
- tests/Uniform/PathShowCase_test.hs +155/−0
- tests/Uniform/Piped_test.hs +100/−0
- tests/Uniform/TypedFile_test.hs +74/−0
- uniform-fileio.cabal +48/−4
ChangeLog.md view
@@ -14,3 +14,4 @@ added pipedDoIOWithFilter 0.1.2 prepare for 9.2.1 +0.1.3 changed for ExceptionT (stat ErrorT)
Uniform/FileStrings.hs view
@@ -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 )
Uniform/Filenames.hs view
@@ -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
Uniform/Piped.hs view
@@ -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
+ 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,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)+--+--
+ tests/Uniform/Filenames_test.hs view
@@ -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)
+ tests/Uniform/PathShowCase_test.hs view
@@ -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)
+ 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
@@ -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 <https://github.com/andrewufrank/uniform-fileiio/readme> 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