uniform-fileio 0.1.5.1 → 0.1.5.2

raw patch · 17 files changed

+736/−499 lines, 17 filesdep ~pathPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: path

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−1
• Uniform/FileIO.hs +4/−1
• Uniform/FileIOalgebra.hs +23/−0
• Uniform/FileStatus.hs +1/−1
• Uniform/FileStrings.hs +72/−33
• Uniform/FilenameAlgebra.hs +128/−0
• Uniform/FilenamePath.hs +221/−0
• Uniform/Filenames.hs +23/−227
• Uniform/PathShowCase.hs +0/−102
• Uniform/TypedFile.hs +73/−38
• tests/Testing.hs +0/−52
• tests/Uniform/Filenames_test.hs +31/−27
• tests/Uniform/Piped_test.hs +4/−1
• tests/Uniform/TypedFile_test.hs +9/−6
• tests/test1.hs +21/−0
• tests/testing.hs +52/−0
• uniform-fileio.cabal +70/−10

@@ -17,4 +17,7 @@ 0.1.3  changed for ExceptionT (stat ErrorT) 0.1.3.1 added renameToBak8 in TypedFiles -0.1.5.1  ghc 9.2.5 changed versino to be in sync with other packages+0.1.5 branch for ghc 9.2.5+0.1.5.1+0.1.5.2 added dir operations for links +0.1.6.0 reduction auf filepath, Path a b removed completely 

@@ -24,6 +24,8 @@         --  , module Uniform.PathShowCase          , Path.IO.getAppUserDataDir          , Path.IO.doesFileExist  --works in IO, not ErrIO+        --  , P.(</>)+        --  , F.(</>)             ) where  import           Uniform.FileIOalgebra -- hiding ((<.>), (</>))@@ -34,7 +36,8 @@ import           Uniform.TypedFile -- import Uniform.PathShowCase() import qualified Path.IO (makeAbsolute, getAppUserDataDir, doesFileExist)-+-- import qualified OsPath.Posix as P ((</>))+-- import qualified System.FilePath as F ((</>)) -- import UniformBase  -- data Aby40 = Aby40 Int (Path Abs Dir)  deriving (Eq, Ord, Show, Read)

@@ -52,6 +52,7 @@   -- | write in a dir a new file with content   --    getDirPermissions  :: fp -> ErrIO D.Permissions   createDirIfMissing' :: fp -> ErrIO ()+  createDirIfMissing :: fp -> IO ()    -- | creates the directory, if missing, recursive for path   -- noop if dir exist@@ -73,6 +74,20 @@   deleteDirRecursive :: fp -> ErrIO ()   -- ^ delete a directory (even non empty), no error if not existing +--   (getHomeDir, createDirLink, getSymlinkTarget, removeDirLink)+  getHomeDir ::   ErrIO fp +  -- ^ get the path to the home dir of the current user ++  createDirLink :: fp -> fp -> ErrIO () +  -- createDirLink to the target (1) as link (2) +  -- fails if the link exists already++  getSymlinkTarget :: fp -> ErrIO FilePath +  -- get the target for the link given ++  removeDirLink :: fp -> ErrIO () +  -- remove the link + class (Show fp) => FileOps fp where   doesFileExist' :: fp -> ErrIO Bool @@ -134,6 +149,10 @@    openFile2handle :: fp -> IOMode -> ErrIO Handle +--   getDataFileName :: FilePath -> ErrIO fp +  -- get the file name for a file names in extra-sources in cabal +  -- cannot put in uniform, because must import the Paths_packagename+ -- | operations on dir to produce file class (Show fd, Show ff) => FileOps2a fd ff where   getDirContentFiles :: fd -> ErrIO [ff]@@ -147,10 +166,14 @@   where   --   writeFile2 :: fp -> fc -> ErrIO ()+  writeFile3 :: fp -> fc -> IO ()   -- write file if dir exist   readFile2 :: fp -> ErrIO fc+  -- write file if dir exist+  readFile3 :: fp -> IO fc   -- read file   appendFile2 :: fp -> fc -> ErrIO ()+  appendFile3 :: fp -> fc -> IO ()    writeFileOrCreate2 :: fp -> fc -> ErrIO () 

@@ -28,7 +28,7 @@ import qualified System.Posix as P import Uniform.Error  -- (ErrIO, callIO, putIOwords, showT)-import Uniform.Filenames (Path, toShortFilePath)+import Uniform.FilenamePath (Path, toShortFilePath) import Uniform.Strings (putIOwords, showT)  unL :: Path df ar -> FilePath

@@ -1,18 +1,21 @@ --------------------------------------------------------------------- -- Module      :  FileIO.Strings---+-- read discussion:+-- https://hasufell.github.io/posts/2024-05-07-ultimate-string-guide.html ---------------------------------------------------------------------- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-methods #-}+-- {-# LANGUAGE TypeFamilies #-}+-- {-# OPTIONS_GHC -fno-warn-missing-methods #-}  module Uniform.FileStrings   ( module Uniform.Filenames,+    module Uniform.FilenamePath,+    module Uniform.FilenameAlgebra,     module Uniform.FileIOalgebra,     SIO.IOMode (..),     closeFile2,@@ -42,17 +45,21 @@ import qualified Data.Text.IO as TIO (hGetLine, hPutStr) import qualified Path import qualified Path.IO as PathIO-import qualified System.Directory as D+-- import qualified System.Directory as D import qualified System.FilePath as OS import qualified System.IO as SIO import System.Posix (FileMode) import qualified System.Posix as Posix+import Uniform.FilenameAlgebra+import Uniform.FilenamePath+      import Uniform.FileIOalgebra import Uniform.FileStatus import Uniform.Filenames-import Uniform.Filenames as FN (toFilePath)+import Uniform.FilenamePath as FN   import Uniform.Strings -- (Text) import Uniform.Error+import qualified System.Directory as D   closeFile2 :: SIO.Handle -> ErrIO ()@@ -96,6 +103,7 @@ instance DirOps FilePath where   doesDirExist' = callIO . D.doesDirectoryExist   createDirIfMissing' = callIO . D.createDirectoryIfMissing True+  createDirIfMissing =  D.createDirectoryIfMissing True    createDir' = callIO . D.createDirectory   renameDir' old new = do@@ -129,6 +137,11 @@          putIOwords ["deleted", showT f] +  getHomeDir   =  callIO $ D.getHomeDirectory  +  createDirLink target link  = callIO $ D.createFileLink  target link  +  getSymlinkTarget link = callIO $ D.getSymbolicLinkTarget link  +  removeDirLink link = callIO $ D.removeDirectoryLink link+ instance FileOps FilePath where   doesFileExist' = callIO . D.doesFileExist @@ -181,11 +194,11 @@          throwErrorWords ["getMD5 error for", showT fn] -  getDirCont fn = getDirContAll True fn+--   getDirCont fn = getDirContAll True fn -  getDirContNonHidden fp = do-    r <- getDirContAll False fp-    return r+--   getDirContNonHidden fp = do+--     r <- getDirContAll False fp+--     return r    deleteFile f = do     callIO . D.removeFile $ f@@ -208,27 +221,27 @@   openFile2handle fp mode =     callIO $ SIO.openFile fp mode -getDirContAll hiddenFlag fn = do-  -- the hiddenFlag must be true to include them-  testDir <- doesDirExist' fn-  readExec <- getFileAccess fn (True, False, True)-  if testDir && readExec-    then do-      r <- callIO . D.listDirectory $ fn-      let r2 = filter (\file' -> file' /= "." && file' /= "..") r-      let r3 =-            if hiddenFlag-              then r2-              else filter (not . isPrefixOf ".") r2-      let r4 = map (fn </>) r3-      return r4-    else-      throwErrorWords-        [ "getDirCont not exist or not readable",-          showT fn,-          showT testDir,-          showT readExec-        ]+-- getDirContAll hiddenFlag fn = do+--   -- the hiddenFlag must be true to include them+--   testDir <- doesDirExist' fn+--   readExec <- getFileAccess fn (True, False, True)+--   if testDir && readExec+--     then do+--       r <- callIO . D.listDirectory $ fn+--       let r2 = filter (\file' -> file' /= "." && file' /= "..") r+--       let r3 =+--             if hiddenFlag+--               then r2+--               else filter (not . isPrefixOf ".") r2+--       let r4 = map (fn </>) r3+--       return r4+--     else+--       throwErrorWords+--         [ "getDirCont not exist or not readable",+--           showT fn,+--           showT testDir,+--           showT readExec+--         ]  instance FileSystemOps (Path ar df) where   getPermissions' = PathIO.getPermissions . unPath@@ -260,6 +273,11 @@    deleteDirRecursive f = deleteDirRecursive (unL f) +  getHomeDir   =  callIO $ PathIO.getHomeDir +  createDirLink target link  = callIO $ PathIO.createDirLink  target link  +  getSymlinkTarget link = callIO $ PathIO.getSymlinkTarget link  +  removeDirLink link = callIO $ PathIO.removeDirLink link+ instance DirOps (Path Rel Dir) where   doesDirExist' = PathIO.doesDirExist @@ -286,6 +304,12 @@    deleteDirRecursive f = deleteDirRecursive (unL f) +-- just copied from above+--   getHomeDir   =  callIO $ PathIO.getHomeDir -- result is absolute+  createDirLink target link  = callIO $ PathIO.createDirLink  target link  +  getSymlinkTarget link = callIO $ PathIO.getSymlinkTarget link  +  removeDirLink link = callIO $ PathIO.removeDirLink link+ instance (Show (Path ar File)) => FileOps (Path ar File) where   doesFileExist' = PathIO.doesFileExist . unPath @@ -316,6 +340,8 @@             return False       ) +    + unL = FN.toFilePath  readFileT :: Path ar File -> ErrIO Text@@ -328,15 +354,19 @@  instance (Show (Path ar File)) => FileOps2 (Path ar File) String where   readFile2 fp = callIO $ readFile (unL fp)+  readFile3 fp =   readFile (unL fp)    -- a strict read (does cloes?)   writeFile2 fp st = callIO $ writeFile (unL fp) st+  writeFile3 fp st =   writeFile (unL fp) st   appendFile2 fp st = callIO $ appendFile (unL fp) st  instance (Show (Path ar File)) => FileOps2 (Path ar File) Text where   readFile2 fp = readFile2 (unL fp)+  readFile3 fp =   readFile3 (unL fp)    writeFile2 fp st = writeFile2 (unL fp) st+  writeFile3 fp st =   writeFile3 (unL fp) st   appendFile2 fp st = appendFile2 (unL fp) st    writeFileOrCreate2 filepath st = do@@ -352,17 +382,26 @@ instance FileOps2 FilePath Text where   readFile2 fp = callIO $ T.readFile fp   writeFile2 fp st = callIO $ T.writeFile fp st+  readFile3 fp =  T.readFile fp+  writeFile3 fp st =   T.writeFile fp st   appendFile2 fp st = callIO $ T.appendFile fp st+  appendFile3 fp st =  T.appendFile fp st  instance FileOps2 FilePath L.ByteString where   readFile2 fp = callIO $ L.readFile fp   writeFile2 fp st = callIO $ L.writeFile fp st   appendFile2 fp st = callIO $ L.appendFile fp st+  readFile3 fp =  L.readFile fp+  writeFile3 fp st =   L.writeFile fp st+  appendFile3 fp st =   L.appendFile fp st  instance (Show (Path ar File)) => FileOps2 (Path ar File) L.ByteString where   readFile2 fp = callIO $ L.readFile . unL $ fp   writeFile2 fp st = callIO $ L.writeFile (unL fp) st   appendFile2 fp st = callIO $ L.appendFile (unL fp) st+  readFile3 fp =   L.readFile . unL $ fp+  writeFile3 fp st =   L.writeFile (unL fp) st+  appendFile3 fp st =   L.appendFile (unL fp) st  instance FileOps2a FilePath FilePath where   getDirContentFiles dir =

@@ -0,0 +1,128 @@+-------------------------------------------------------------------+--+-- Module      :  FilenameAlgebra+-- Copyright   :  andrew u frank -+-- read: +--  https://hasufell.github.io/posts/2022-06-29-fixing-haskell-filepaths.html+----------------------------------------------------------------------+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}++-- | the operations on filenames and extensions+-- no instances - all in Filenames or FilenamePath ++module Uniform.FilenameAlgebra+  ( module Uniform.FilenameAlgebra,+    +  )+where+ +import Uniform.Strings ++-- newtype Extension = Extension FilePath deriving (Show, Read, Eq, Ord)++-- unExtension :: Extension -> FilePath+-- unExtension (Extension e) = e++-- makeExtension :: FilePath -> Extension+-- makeExtension = Extension++-- -- extension does not include a leading "."+-- -- would need a makeExtension in IO to catch errors here+-- makeExtensionT :: Text -> Extension+-- makeExtensionT = Extension . t2s++class Filenames fp fr where+  getFileName :: fp -> fr++class Filenames1 fp where+  -- instantiate only for filepath TODO do for path+  getImmediateParentDir :: fp -> FilePath+  -- ^ gets the name of the dir immediately above++  getParentDir :: fp -> FilePath+  -- ^ the parent dir of file+    -- add a getParentdir with Path result+  getNakedFileName :: fp -> FilePath+  -- ^ filename without extension++  getNakedDir :: fp -> FilePath+  -- ^ get the last dir+++-- class Filenames2 f1 f2 fr where +--     (</>) :: f1 -> f2 -> fr+--     addFileName     :: f1 -> f2 -> fr+--     addFileName = (</>)+--     addDir     :: f1 -> f2 -> fr++--     addDir = (</>)++class Filenames3 fp file where+  type FileResultT fp file++  -- add a filepath to a absolute dir and givev an absolte file+  --+  (</>), addFileName :: fp -> file -> FileResultT fp file+  -- fails, if file is empty  +    -- does not add anything if file is empty+  (</>) = addFileName+  +-- class Filenames3 fp file where+--     -- addFileName     :: fp -> file -> file+--     -- addFileName = (</>)++--   type FileResultT fp file++-- -- removed the </> infix, too much confusions +-- --   -- add a filepath to a absolute dir and givev an absolte file+-- --   --+--     addFileName :: fp -> file -> FileResultT fp file+-- --   -- fails, if file is empty  +-- --     -- does not add anything if file is empty+-- --   (</>) = addFileName+-- --   addFileName = (</>)++++class Filenames4 fp file where+  type FileResultT4 fp file++  -- add a filepath to a absolute dir and givev an absolte dir+  --+  addDir :: fp -> file -> FileResultT4 fp file+--   addDir = (</>)+--   (</>) = addDir ++class Filenames5 dir fil res where+  stripPrefix :: dir -> fil -> Maybe res+  -- ^ strip the++++class (Eq (ExtensionType fp)) => Extensions fp where+  -- extension do not include a leading '.'+  type ExtensionType fp+  getExtension :: fp -> ExtensionType fp+  removeExtension :: fp -> fp+  addExtension :: ExtensionType fp -> fp -> fp+--   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++  prop_add_has :: ExtensionType fp -> fp -> Bool+  prop_add_has e f = hasExtension e (addExtension e f)+  prop_add_add_has :: ExtensionType fp -> ExtensionType fp -> fp -> Bool+  prop_add_add_has e1 e2 f =+    hasExtension+      e1+      (setExtension e1 . setExtension e2 $ f)+  prop_set_get :: ExtensionType fp -> fp -> Bool+  prop_set_get e f = ((e ==) . getExtension) (setExtension e f)

@@ -0,0 +1,221 @@+-------------------------------------------------------------------+--+-- Module      :  FilenamePath+-- Copyright   :  andrew u frank -+--+----------------------------------------------------------------------+-- {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+-- {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE TypeSynonymInstances #-}+-- {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+-- {-# OPTIONS_GHC -Wno-deprecations #-}++-- | the operations on filenames and extensions+--  uses the Path library,  +module Uniform.FilenamePath+  ( module Uniform.FilenamePath,+    module Uniform.Error,+    -- -- module Path.Internal,+    -- -- module Uniform.PathShowCase,+    Abs,+    Rel,+    File,+    Dir,+    Path.Path,+    toFilePath,+  )+where+++import Path (File, Dir, Abs, Rel, Path, toFilePath)+import qualified Path ((</>), stripProperPrefix, filename, setFileExtension)+import qualified Path as Path (parseRelFile, parseRelDir, parseAbsFile, parseAbsDir)+import qualified Path as P+-- -- import  Path.Internal (Path(..))+import qualified Path.IO as PathIO++import Uniform.Error(ErrIO, callIO)+-- import Uniform.Zero(Zeros(..))+import Uniform.Strings+-- (Text, fromJustNote, t2s)+-- import Uniform.PathShowCase ()+import Uniform.FilenameAlgebra+import Uniform.Filenames+-- import qualified System.Directory as S+import qualified System.FilePath as S ++homeDir :: Path Abs Dir+homeDir = makeAbsDir "/home/frank/" :: Path Abs Dir++homeDir2 :: ErrIO (Path Abs Dir)+homeDir2 = callIO PathIO.getHomeDir :: ErrIO (Path Abs Dir)++-- replace homeDir with homeDir2 - is user independent but requires IO+currentDir :: ErrIO (Path Abs Dir)+currentDir = callIO PathIO.getCurrentDir++setCurrentDir :: Path Abs Dir -> ErrIO ()+setCurrentDir path = PathIO.setCurrentDir (unPath path)++stripProperPrefix' :: Path b Dir -> Path b t -> ErrIO (Path Rel t)+stripProperPrefix' dir fn = Path.stripProperPrefix (unPath dir) (unPath fn)++stripProperPrefixMaybe :: Path b Dir -> Path b t -> Maybe (Path Rel t)+stripProperPrefixMaybe dir fn = Path.stripProperPrefix (unPath dir) (unPath fn)++unPath :: a -> a  -- todo remove+unPath = id+    ++makeRelFile :: FilePath -> Path Rel File+makeRelDir :: FilePath -> Path Rel Dir+makeAbsFile :: FilePath -> Path Abs File+makeAbsDir :: FilePath -> Path Abs Dir+makeRelFile fn = fromJustNote ("makeRelFile " ++ fn ++ "|") $ Path.parseRelFile fn++makeRelDir fn = fromJustNote ("makeRelDir " ++ fn ++ "|") $ Path.parseRelDir fn++makeAbsFile fn = fromJustNote ("makeAbsFile " ++ fn ++ "|") $ Path.parseAbsFile fn++makeAbsDir fn = fromJustNote ("makeAbsDir " ++ fn ++ "|") $ Path.parseAbsDir fn++makeRelFileT :: Text -> Path Rel File+makeRelDirT :: Text -> Path Rel Dir+makeAbsFileT :: Text -> Path Abs File+makeAbsDirT :: Text -> Path Abs Dir+makeRelFileT = makeRelFile . t2s++makeRelDirT = makeRelDir . t2s++makeAbsFileT = makeAbsFile . t2s++makeAbsDirT = makeAbsDir . t2s++toShortFilePath :: Path df ar -> FilePath+---- ^ get the filepath, but without the trailing separator+--    , necessary for systemcalls+toShortFilePath = S.dropTrailingPathSeparator . toFilePath++instance Zeros (Path Abs Dir) where+  zero = makeAbsDir "/"++instance Zeros (Path Abs File) where+  zero = makeAbsFile "/zero" ++instance Zeros (Path Rel Dir) where+  zero = makeRelDir "./"++instance Zeros (Path Rel File) where+  zero = makeRelFile "zero"++instance Filenames5 (Path b Dir) (Path b t) (Path Rel t) where+  stripPrefix d f = Path.stripProperPrefix (unPath d) (unPath f)++instance Filenames (Path ar File) (Path Rel File) where+  getFileName = Path.filename . unPath++-- instance Filenames2 (Path b Dir) (Path Rel t ) (Path b t)  where+--     (</>) = (P.</>)+++-- instance Filenames3 (Path Rel Dir) FilePath where+--   type FileResultT (Path Rel Dir) FilePath = (Path Rel File)+--   addFileName p d =+--     if null' d+--       then error ("addFileName with empty file" ++ d)+--       else (Path.</>) (unPath p) (unPath d2)+--     where+--       d2 = makeRelFile d :: Path Rel File++-- instance Filenames3 (Path Abs Dir) FilePath where+--   type FileResultT (Path Abs Dir) FilePath = (Path Abs File)+--   addFileName p d =+--     if null' d+--       then error ("addFileName with empty file" ++ d)+--       else (Path.</>) (unPath p) (unPath d2)+--     where+--       d2 = makeRelFile d :: Path Rel File+      +instance Filenames3 (Path b Dir) (Path Rel File) where+  type FileResultT (Path b Dir) (Path Rel File) = (Path b File)+  addFileName p d = (Path.</>) (unPath p) (unPath d)+++-- instance Filenames4 (Path Rel Dir) FilePath where+--   type FileResultT4 (Path Rel Dir) FilePath = (Path Rel Dir)+--   addDir p d =+--     if null' d+--       then p+--       else (Path.</>) p   d2+--     where+--       d2 = makeRelDir d :: Path Rel Dir++instance Filenames4 (Path b Dir) (Path Rel Dir) where+  type FileResultT4 (Path b Dir) (Path Rel Dir) = (Path b Dir)+  addDir p d = (Path.</>) (unPath p) (unPath d)++++instance Filenames1 (Path ar File) where+  getNakedFileName = getNakedFileName . toFilePath+  getImmediateParentDir = getImmediateParentDir . toFilePath+  getParentDir = getParentDir . toFilePath+  getNakedDir = error "getNakedDir for Filenamse1 Path ar File) not existing"++instance Filenames1 (Path ar Dir) where+  getNakedFileName = error "getNakedFileName not from Dir"+  getImmediateParentDir = getImmediateParentDir . toFilePath+  getParentDir = getParentDir . toFilePath+  getNakedDir = getNakedDir . toFilePath++-- class (Eq (ExtensionType fp)) => Extensions fp where+--   -- extension do not include a leading '.'+--   type ExtensionType fp+--   getExtension :: fp -> ExtensionType fp+--   removeExtension :: fp -> fp+--   addExtension :: ExtensionType fp -> fp -> fp+-- --   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++--   prop_add_has :: ExtensionType fp -> fp -> Bool+--   prop_add_has e f = hasExtension e (addExtension e f)+--   prop_add_add_has :: ExtensionType fp -> ExtensionType fp -> fp -> Bool+--   prop_add_add_has e1 e2 f =+--     hasExtension+--       e1+--       (setExtension e1 . setExtension e2 $ f)+--   prop_set_get :: ExtensionType fp -> fp -> Bool+--   prop_set_get e f = ((e ==) . getExtension) (setExtension e f)+++instance Extensions (Path ar File) where+  type ExtensionType (Path ar File) = Extension++  getExtension f = Extension e+    where+      -- definition of extension in path is with leading '.'+      -- multiple extensions are gradually built and removed+      -- split gives only the last+      -- add allows only one to add+      -- empty extensions throw error++      e = getExtension . toFilePath $ f++  setExtension e f =+    fromJustNote "setExtension" $ Path.setFileExtension (unExtension e) f++  addExtension = setExtension+  removeExtension = setExtension (Extension "")++instance NiceStrings (Path a b) where+  showNice = s2t . toFilePath

@@ -4,121 +4,40 @@ -- Copyright   :  andrew u frank - -- -----------------------------------------------------------------------{-# LANGUAGE FlexibleContexts #-}+-- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}-{-# OPTIONS_GHC -Wno-deprecations #-} +-- {-# LANGUAGE TypeSynonymInstances #-}+-- {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+-- {-# OPTIONS_GHC -Wno-deprecations #-}+ -- | the operations on filenames and extensions --  uses the Path library, but wraps it in Path (to construct a read) -- is a class except for the make+-- todo : there is too much slack in overloading FilePath and Path +-- remove unPath +-- check with the Path module from Shake! 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,---     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 ()-+-- import Uniform.PathShowCase ()+import Uniform.FilenameAlgebra+import qualified System.FilePath as S takeBaseName' :: FilePath -> FilePath takeBaseName' = S.takeBaseName -homeDir :: Path Abs Dir-homeDir = makeAbsDir "/home/frank/" :: Path Abs Dir -homeDir2 :: ErrIO (Path Abs Dir)-homeDir2 = callIO PathIO.getHomeDir :: ErrIO (Path Abs Dir) --- replace homeDir with homeDir2 - is user independent but requires IO-currentDir :: ErrIO (Path Abs Dir)-currentDir = callIO PathIO.getCurrentDir--setCurrentDir :: Path Abs Dir -> ErrIO ()-setCurrentDir path = PathIO.setCurrentDir (unPath path)--stripProperPrefix' :: Path b Dir -> Path b t -> ErrIO (Path Rel t)-stripProperPrefix' dir fn = Path.stripProperPrefix (unPath dir) (unPath fn)--stripProperPrefixMaybe :: Path b Dir -> Path b t -> Maybe (Path Rel t)-stripProperPrefixMaybe dir fn = Path.stripProperPrefix (unPath dir) (unPath fn)--unPath :: a -> a-unPath = id--    --makeRelFile :: FilePath -> Path Rel File-makeRelDir :: FilePath -> Path Rel Dir-makeAbsFile :: FilePath -> Path Abs File-makeAbsDir :: FilePath -> Path Abs Dir-makeRelFile fn = fromJustNote ("makeRelFile " ++ fn) $ Path.parseRelFile fn--makeRelDir fn = fromJustNote ("makeRelDir " ++ fn) $ Path.parseRelDir fn--makeAbsFile fn = fromJustNote ("makeAbsFile " ++ fn) $ Path.parseAbsFile fn--makeAbsDir fn = fromJustNote ("makeAbsDir " ++ fn) $ Path.parseAbsDir fn--makeRelFileT :: Text -> Path Rel File-makeRelDirT :: Text -> Path Rel Dir-makeAbsFileT :: Text -> Path Abs File-makeAbsDirT :: Text -> Path Abs Dir-makeRelFileT = makeRelFile . t2s--makeRelDirT = makeRelDir . t2s--makeAbsFileT = makeAbsFile . t2s--makeAbsDirT = makeAbsDir . t2s--toShortFilePath :: Path df ar -> FilePath----- ^ get the filepath, but without the trailing separator---    , necessary for systemcalls-toShortFilePath = S.dropTrailingPathSeparator . toFilePath--instance Zeros (Path Abs Dir) where-  zero = makeAbsDir "/"--instance Zeros (Path Abs File) where-  zero = makeAbsFile "/zero"--instance Zeros (Path Rel Dir) where-  zero = makeRelDir "./"--instance Zeros (Path Rel File) where-  zero = makeRelFile "zero"- newtype Extension = Extension FilePath deriving (Show, Read, Eq, Ord)  unExtension :: Extension -> FilePath@@ -132,130 +51,26 @@ makeExtensionT :: Text -> Extension makeExtensionT = Extension . t2s -class Filenames fp fr where-  getFileName :: fp -> fr -class Filenames3 fp file where-  type FileResultT fp file--  -- add a filepath to a absolute dir and givev an absolte file-  ---  (</>), addFileName :: fp -> file -> FileResultT fp file-  -- fails, if file is empty  does not add anything if file is empty-  (</>) = addFileName--class Filenames5 dir fil res where-  stripPrefix :: dir -> fil -> Maybe res-  -- ^ strip the--instance Filenames5 (Path b Dir) (Path b t) (Path Rel t) where-  stripPrefix d f = Path.stripProperPrefix (unPath d) (unPath f)--class Filenames4 fp file where-  type FileResultT4 fp file--  -- add a filepath to a absolute dir and givev an absolte dir-  ---  addDir :: fp -> file -> FileResultT4 fp file--class Filenames1 fp where-  -- instantiate only for filepath TODO do for path-  getImmediateParentDir :: fp -> FilePath-  -- ^ gets the name of the dir immediately above--  getParentDir :: fp -> FilePath-  -- ^ the parent dir of file--  getNakedFileName :: fp -> FilePath-  -- ^ filename without extension--  getNakedDir :: fp -> FilePath-  -- ^ get the last dir- instance Filenames FilePath FilePath where   getFileName = snd . S.splitFileName -instance Filenames3 FilePath FilePath where-  type FileResultT FilePath FilePath = FilePath-  addFileName = S.combine--instance Filenames (Path ar File) (Path Rel File) where-  getFileName = Path.filename . unPath--instance Filenames3 (Path b Dir) FilePath where-  type FileResultT (Path b Dir) FilePath = (Path b File)-  addFileName p d =-    if null' d-      then error ("addFileName with empty file" ++ d)-      else (Path.</>) (unPath p) (unPath d2)-    where-      d2 = makeRelFile d :: Path Rel File--instance Filenames4 FilePath FilePath where-  type FileResultT4 FilePath FilePath = FilePath-  addDir p d = if null' d then p else p </> d--instance Filenames4 (Path b Dir) FilePath where-  type FileResultT4 (Path b Dir) FilePath = (Path b Dir)-  addDir p d =-    if null' d-      then p-      else p </> d2-    where-      d2 = makeRelDir d :: Path Rel Dir--instance Filenames4 (Path b Dir) (Path Rel t) where-  type FileResultT4 (Path b Dir) (Path Rel t) = (Path b t)-  addDir p d = (Path.</>) (unPath p) (unPath d)--instance Filenames3 (Path b Dir) (Path Rel t) where-  type FileResultT (Path b Dir) (Path Rel t) = (Path b t)-  addFileName p d = (Path.</>) (unPath p) (unPath d)--instance Filenames1 (Path ar File) where-  getNakedFileName = getNakedFileName . toFilePath-  getImmediateParentDir = getImmediateParentDir . toFilePath-  getParentDir = getParentDir . toFilePath-  getNakedDir = error "getNakedDir for Filenamse1 Path ar File) not existing"--instance Filenames1 (Path ar Dir) where-  getNakedFileName = error "getNakedFileName not from Dir"-  getImmediateParentDir = getImmediateParentDir . toFilePath-  getParentDir = getParentDir . toFilePath-  getNakedDir = getNakedDir . toFilePath- instance Filenames1 FilePath where   getNakedFileName = removeExtension . getFileName   getImmediateParentDir = (!! 1) . reverse . S.splitDirectories   getParentDir = S.takeDirectory-  getNakedDir = (!! 0) . reverse . S.splitDirectories+  getNakedDir =  (!! 0) . reverse . S.splitDirectories+-- instance Filenames2 FilePath FilePath FilePath where+--     (</>) = S.combine -class (Eq (ExtensionType fp)) => Extensions fp where-  -- extension do not include a leading '.'-  type ExtensionType fp-  getExtension :: fp -> ExtensionType fp-  removeExtension :: fp -> fp-  addExtension :: ExtensionType fp -> fp -> fp---   setFileExtension :: ExtensionType fp -> fp -> fp --- to avoid name clash with Path+-- instance Filenames3 FilePath FilePath where+--   type FileResultT FilePath FilePath = FilePath+--   addFileName = S.combine -  -- 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+-- instance Filenames4 FilePath FilePath where+--   type FileResultT4 FilePath FilePath = FilePath+--   addDir p d = if null' d then p else p </> d -  prop_add_has :: ExtensionType fp -> fp -> Bool-  prop_add_has e f = hasExtension e (addExtension e f)-  prop_add_add_has :: ExtensionType fp -> ExtensionType fp -> fp -> Bool-  prop_add_add_has e1 e2 f =-    hasExtension-      e1-      (setExtension e1 . setExtension e2 $ f)-  prop_set_get :: ExtensionType fp -> fp -> Bool-  prop_set_get e f = ((e ==) . getExtension) (setExtension e f)  instance Extensions FilePath where   type ExtensionType FilePath = FilePath@@ -267,22 +82,3 @@     --    hasExtension e = (e ==) . getExtension--instance Extensions (Path ar File) where-  type ExtensionType (Path ar File) = Extension--  getExtension f = Extension e-    where-      -- definition of extension in path is with leading '.'-      -- multiple extensions are gradually built and removed-      -- split gives only the last-      -- add allows only one to add-      -- empty extensions throw error--      e = getExtension . toFilePath $ f--  setExtension e f =-    fromJustNote "setExtension" $ Path.setFileExtension (unExtension e) f--  addExtension = setExtension-  removeExtension = setExtension (Extension "")

@@ -1,102 +0,0 @@-{-# 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 "

@@ -12,6 +12,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE InstanceSigs #-}  module Uniform.TypedFile   ( module Uniform.TypedFile,@@ -27,7 +28,8 @@ import Uniform.FileIOalgebra (Handle) import Uniform.FileStatus (EpochTime) import Uniform.FileStrings-import Uniform.Filenames as FN (Path)+import Uniform.FilenameAlgebra+import Uniform.FilenamePath   import Uniform.Strings  import Uniform.Error @@ -53,12 +55,12 @@   writeHandle6 f = errorT ["TypedFiles - no implementation for writeHandle6", showT f]   closeHandle6 f = errorT ["TypedFiles - no implementation for closeHandle6", showT f] -  write5 :: FN.Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()-  -- write a file, directory is created if not exist-  -- file, if exist, is replaced-  write5 fp fn tp ct = do-    dirx <- Path.IO.ensureDir (unPath fp)-    write6 (fp </> fn) tp ct+--   write5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()+--   -- write a file, directory is created if not exist+--   -- file, if exist, is replaced+--   write5 fp fn tp ct = do+--     dirx <- Path.IO.ensureDir (unPath fp)+--     write6 (fp </> fn) tp ct    append5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> a -> ErrIO ()   read5 :: Path Abs Dir -> Path Rel File -> TypedFile5 a b -> ErrIO a@@ -124,19 +126,21 @@  instance TypedFiles5 Text b where   -- file contains a list of lines (text)-  write5 fp fn tp ct = do-    dirx <- Path.IO.ensureDir (unPath fp)-    let fn2 = fn <.> tpext5 tp -- :: Path ar File-    writeFile2 (fp </> fn2) ct+--   write5 :: Path Abs Dir -> Path Rel File -> TypedFile5 Text b -> Text -> ErrIO ()+--   write5 :: Path Abs Dir -> Path Rel File -> TypedFile5 Text b -> Text -> ErrIO ()+--   write5 fp fn tp ct = do+--     dirx <- Path.IO.ensureDir (unPath fp)+--     let fn2 = fn <.> tpext5 tp :: Path Rel File+--     writeFile2 (fp </> fn2) ct -  --      writeFile2 (fp </> (fn <.> (tpext tp) )) . unlines'-  append5 fp fn tp ct = do-    dirx <- Path.IO.ensureDir (unPath fp)-    let fn2 = fn <.> tpext5 tp -- :: Path ar File-    appendFile2 (fp </> fn2) ct-  read5 fp fn tp = do-    let fn2 = fn <.> tpext5 tp-    readFile2 $ fp </> fn2+--   --      writeFile2 (fp </> (fn <.> (tpext tp) )) . unlines'+--   append5 fp fn tp ct = do+--     dirx <- Path.IO.ensureDir (unPath fp)+--     let fn2 = fn <.> tpext5 tp -- :: Path ar File+--     appendFile2 (fp </> fn2) ct+--   read5 fp fn tp = do+--     let fn2 = fn <.> tpext5 tp+--     readFile2 $ fp </> fn2    append6 fn tp ct = do     let fn2 = setExtension (tpext5 tp) fn@@ -160,18 +164,18 @@ instance TypedFiles5 [Text] b where   -- file contains a list of lines (text)   --    mkTypedFile5  = TypedFile5 { tpext5 = Extension "txt"}-  write5 fp fn tp ct = do-    dirx <- Path.IO.ensureDir (unPath fp)-    let fn2 = fn <.> tpext5 tp -- :: Path ar File-    writeFile2 (fp </> fn2) (unlines' ct)+--   write5 fp fn tp ct = do+--     dirx <- Path.IO.ensureDir (unPath fp)+--     let fn2 = fn <.> tpext5 tp -- :: Path ar File+--     writeFile2 (fp </> fn2) (unlines' ct) -  append5 fp fn tp ct = do-    dirx <- Path.IO.ensureDir (unPath fp)-    let fn2 = fn <.> tpext5 tp -- :: Path ar File-    appendFile2 (fp </> fn2) (unlines' ct)-  read5 fp fn tp = do-    let fn2 = fn <.> tpext5 tp-    fmap lines' . readFile2 $ fp </> fn2+--   append5 fp fn tp ct = do+--     dirx <- Path.IO.ensureDir (unPath fp)+--     let fn2 = fn <.> tpext5 tp -- :: Path ar File+--     appendFile2 (fp </> fn2) (unlines' ct)+--   read5 fp fn tp = do+--     let fn2 = fn <.> tpext5 tp+--     fmap lines' . readFile2 $ fp </> fn2    append6 fn tp ct = do     let fn2 = setExtension (tpext5 tp) fn@@ -250,18 +254,24 @@   read8 :: Path Abs File -> TypedFile5 a b -> ErrIO b    write8 :: Path Abs File -> TypedFile5 a b -> b -> ErrIO ()+--   write9 :: (TypedFiles7a Text b) => Path Abs File ->   b -> ErrIO () +-- would be useful, but gives AllowAmbiguousTypes error +  read9 :: Path Abs File -> TypedFile5 a b -> IO b +  write9 :: Path Abs File -> TypedFile5 a b -> b -> IO ()++   renameToBak8 :: Path Abs File -> TypedFile5 a b -> ErrIO ()   -- ^ the createDir if missingis implied in the write  instance (TypedFiles7 Text b) => TypedFiles7a Text b where   -- an instance for all what has text or bytestring  as underlying rep-  write7 fp fn tp ct = do-    write8 (fp </> fn) tp ct+--   write7 fp fn tp ct = do+--     write8 (fp </> fn) tp ct -  read7 fp fn tp = do-    read8 (fp </> fn) tp+--   read7 fp fn tp = do+--     read8 (fp </> fn) tp    write8 fp tp ct = do     let fn2 = fp <.> tpext5 tp -- :: Path ar File@@ -275,6 +285,19 @@     ares :: Text <- readFile2 fp2     return . wrap7 $ ares +  write9 fp tp ct = do+    let fn2 = fp <.> tpext5 tp -- :: Path ar File+    let parent = getParentDir fn2+    createDirIfMissing parent++    writeFile3 fn2 (unwrap7 ct :: Text)++  read9 fp tp = do+    let fp2 = fp <.> tpext5 tp+    ares :: Text <- readFile3 fp2+    return . wrap7 $ ares++   renameToBak8 fp tp = do      let fp2 = fp <.> tpext5 tp      let fpBak = fp <.> (Extension "bak")@@ -283,11 +306,11 @@  instance (TypedFiles7 L.ByteString b) => TypedFiles7a L.ByteString b where   -- an instance for all what has text or bytestring  as underlying rep-  write7 fp fn tp ct = do-    write8 (fp </> fn) tp ct+--   write7 fp fn tp ct = do+--     write8 (fp </> fn) tp ct -  read7 fp fn tp = do-    read8 (fp </> fn) tp+--   read7 fp fn tp = do+--     read8 (fp </> fn) tp    write8 fp tp ct = do     let fn2 = fp <.> tpext5 tp -- :: Path ar File@@ -300,6 +323,18 @@     ares :: L.ByteString <- readFile2 fp2     return . wrap7 $ ares +  write9 fp tp ct = do+    let fn2 = fp <.> tpext5 tp -- :: Path ar File+    let parent = getParentDir fn2+    createDirIfMissing parent++    writeFile3 fn2 (unwrap7 ct :: L.ByteString)++  read9 fp tp = do+    let fp2 = fp <.> tpext5 tp+    ares :: L.ByteString <- readFile3 fp2+    return . wrap7 $ ares+       renameToBak8 fp tp = do      let fp2 = fp <.> tpext5 tp      let fpBak = fp <.> (Extension "bak")

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

@@ -32,33 +32,37 @@ import Test.Framework -- import Uniform.Error hiding ((<.>), (</>)) import Uniform.Filenames+import Uniform.FilenameAlgebra+import Uniform.FilenamePath+import Uniform.FileStrings  ---test_show = assertEqual "Path Rel File afile" (show g1)+-- test_show = assertEqual "Path Rel File afile" (show g1) -test_read = assertEqual g1 (read "Path Rel File afile")+-- test_read = assertEqual g1 (read "Path Rel File afile") -test_read2 = assertEqual g1 (makeRelFile "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_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+testfile1P = makeRelFile "file1.x" :: Path Rel File  testdir2 = "files" :: FilePath -test_addFilename = assertEqual "/home/frank/test/file1.x" (toFilePath $ addFileName testdir1 testfile1)+test_addFilename = assertEqual "/home/frank/test/file1.x" (toFilePath $ addFileName testdir1 testfile1P)  --test_addFilenameEmpty = assertEqual "" (toFilePath $ addFileName testdir1 (""::FilePath))--- does fail+-- -- does fail -test_addDir = assertEqual "/home/frank/test/files/" (toFilePath $ addDir testdir1 testdir2)+-- test_addDir = assertEqual "/home/frank/test/files/" (toFilePath $ addDir testdir1 testdir2) -test_addDirEmpty = assertEqual "/home/frank/test/" (toFilePath $ addDir testdir1 ("" :: FilePath))+-- test_addDirEmpty = assertEqual "/home/frank/test/" (toFilePath $ addDir testdir1 ("" :: FilePath))  --test_abs1 = assertEqual "" $ makeAbsDir  "file://home/frank/additionalSpace/DataBig/LitTest/test" @@ -91,27 +95,27 @@  x1ss = show x1f -test_sp =-  assertEqual-    "Path Abs File /somedir/more/afile.ext"-    (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_sp2 = assertEqual (x1f :: Path Abs File) (read x1ss) -test_sp3 =-  assertEqual-    (x1f :: Path Abs File)-    (read "Path Abs File /somedir/more/afile.ext")+-- 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)+-- data Rec11 = Rec11 {date :: Path Abs File} deriving (Show, Read, Eq) -rec1 = Rec11 x1f+-- rec1 = Rec11 x1f -rec1s = show rec1+-- rec1s = show rec1 -test_r1 = assertEqual "Rec11 {date = Path Abs File /somedir/more/afile.ext}" (rec1s)+-- 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@@ -136,11 +140,11 @@  test_s2a = assertEqual s2a (read "S2 \"eins\" \"zwei\"") -data Xt = Xt-  { p :: Path Abs File-  , q :: Text-  }-  deriving (Show, Read, Eq)+-- 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"}

@@ -33,9 +33,12 @@ ------ using uniform: import Uniform.Error ----import Uniform.Zero-import Uniform.Strings hiding ((<.>), (</>))+import Uniform.Strings -- hiding ((<.>), (</>)) ----+ import Uniform.Filenames+import Uniform.FilenameAlgebra+import Uniform.FilenamePath ----import Uniform.FileIO import Uniform.FileStrings (openFile2handle, closeFile2, IOMode(..)) --import Uniform.Filenames

@@ -1,10 +1,10 @@ {-# OPTIONS_GHC -F -pgmF htfpp #-}---{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TypeSynonymInstances  #-}+-- {-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE ScopedTypeVariables   #-}+-- {-# LANGUAGE OverloadedStrings     #-}+-- {-# LANGUAGE TypeSynonymInstances  #-} -- {-# OPTIONS -Wall #-} -- {-# OPTIONS -fno-warn-missing-signatures #-} {-# OPTIONS -w #-}@@ -15,7 +15,10 @@  import           Uniform.Error import           Uniform.FileIOalgebra (Handle)-import           Uniform.Filenames++import Uniform.Filenames+import Uniform.FilenameAlgebra+import Uniform.FilenamePath import           Uniform.FileStrings --import           Uniform.FileIO (EpochTime, getFileModificationTime) import           Uniform.FileStatus

@@ -0,0 +1,21 @@+- +module test1    where      -- must have Main (main) or Main where+ +import           Uniform.Strings+import Uniform.Error +--import TestingFileIO+++main :: IO ()+main = do++    putIOwords ["HTF LayoutTest.hs:\n posTest"]+    test1     +    return ()++test1 = do+    putStrLn "file1test"+    -- push2+    -- runErrorVoid $ do +    -- test_hidden1+    return () 

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

@@ -1,13 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.39.3. -- -- see: https://github.com/sol/hpack------ hash: 97d81afaf124fc69557e1bb823e85f2a639758c8c76252216ad730d201599cc8  name:           uniform-fileio-version:        0.1.5.1+version:        0.1.5.2 synopsis:       Uniform file handling operations description:    Uniform operations for handling files and file path names                 independent from the representation. @@ -15,6 +13,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@@ -31,16 +31,24 @@   exposed-modules:       Uniform.FileIO       Uniform.FileIOalgebra+      Uniform.FilenameAlgebra+      Uniform.FilenamePath       Uniform.Filenames       Uniform.FileStatus       Uniform.FileStrings-      Uniform.PathShowCase       Uniform.Piped       Uniform.TypedFile   other-modules:       Paths_uniform_fileio   hs-source-dirs:       ./+  default-extensions:+      OverloadedStrings+      MultiParamTypeClasses+      ScopedTypeVariables+      DeriveGeneric+      DeriveAnyClass+  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-deprecations -fno-warn-unused-do-bind -fno-warn-unused-imports -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-type-defaults -fno-warn-unused-matches -fno-warn-warnings-deprecations -fno-warn-missing-methods -fno-warn-missing-home-modules -fno-warn-duplicate-exports   build-depends:       base >=4.7 && <5     , bytestring@@ -49,7 +57,7 @@     , exceptions     , filepath     , monads-tf-    , path+    , path >=0.9.2     , path-io     , pipes     , pureMD5@@ -64,9 +72,9 @@   default-language: Haskell2010   autogen-modules: Paths_uniform_fileio -test-suite fileio-test+test-suite htftest   type: exitcode-stdio-1.0-  main-is: Testing.hs+  main-is: testing.hs   other-modules:       Uniform.Filenames_test       Uniform.FileStatus_test@@ -78,7 +86,13 @@       Paths_uniform_fileio   hs-source-dirs:       tests-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-extensions:+      OverloadedStrings+      MultiParamTypeClasses+      ScopedTypeVariables+      DeriveGeneric+      DeriveAnyClass+  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-deprecations -fno-warn-unused-do-bind -fno-warn-unused-imports -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-type-defaults -fno-warn-unused-matches -fno-warn-warnings-deprecations -fno-warn-missing-methods -fno-warn-missing-home-modules -fno-warn-duplicate-exports -threaded -rtsopts -with-rtsopts=-N   build-depends:       HTF     , base >=4.7 && <5@@ -88,7 +102,7 @@     , exceptions     , filepath     , monads-tf-    , path+    , path >=0.9.2     , path-io     , pipes     , pureMD5@@ -99,6 +113,52 @@     , uniform-algebras >=0.1.5     , uniform-error >=0.1.5     , uniform-fileio+    , uniform-strings >=0.1.5+    , uniform-time >=0.1.5+    , unix+    , zlib+  default-language: Haskell2010++test-suite testtest+  type: exitcode-stdio-1.0+  main-is: test1.hs+  other-modules:+      Uniform.Filenames_test+      Uniform.FileStatus_test+      Uniform.FileStrings_test+      Uniform.Piped_test+      Uniform.TypedFile_test+      Paths_uniform_fileio+  autogen-modules:+      Paths_uniform_fileio+  hs-source-dirs:+      tests+  default-extensions:+      OverloadedStrings+      MultiParamTypeClasses+      ScopedTypeVariables+      DeriveGeneric+      DeriveAnyClass+  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-deprecations -fno-warn-unused-do-bind -fno-warn-unused-imports -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-type-defaults -fno-warn-unused-matches -fno-warn-warnings-deprecations -fno-warn-missing-methods -fno-warn-missing-home-modules -fno-warn-duplicate-exports -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HTF+    , base >=4.7 && <5+    , bytestring+    , deepseq+    , directory+    , exceptions+    , filepath+    , monads-tf+    , path >=0.9.2+    , path-io+    , pipes+    , pureMD5+    , quickcheck-text+    , safe+    , test-invariant+    , text+    , uniform-algebras >=0.1.5+    , uniform-error >=0.1.5     , uniform-strings >=0.1.5     , uniform-time >=0.1.5     , unix