uniform-fileio 0.1.0 → 0.1.2

raw patch · 12 files changed

+159/−896 lines, 12 filesdep −HTFdep −quickcheck-textdep −test-invariantdep ~uniform-algebrasdep ~uniform-errordep ~uniform-stringsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: HTF, quickcheck-text, test-invariant, uniform-fileio

Dependency ranges changed: uniform-algebras, uniform-error, uniform-strings, uniform-time

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Uniform/FileIO.hs +8/−0
• Uniform/Filenames.hs +18/−10
• Uniform/PathShowCase.hs +102/−0
• Uniform/Piped.hs +16/−0
• tests/Testing.hs +0/−52
• tests/Uniform/FileStatus_test.hs +0/−43
• tests/Uniform/FileStrings_test.hs +0/−271
• tests/Uniform/Filenames_test.hs +0/−299
• tests/Uniform/Piped_test.hs +0/−100
• tests/Uniform/TypedFile_test.hs +0/−74
• uniform-fileio.cabal +9/−47

@@ -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 

@@ -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)

@@ -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 

@@ -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 "

@@ -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 ()

@@ -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 () 

@@ -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-----

@@ -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)------

@@ -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)

@@ -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-

@@ -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))-

@@ -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