pathtype 0.5.4.1 → 0.5.4.2
raw patch · 9 files changed
+207/−230 lines, 9 filesdep +processdep ~base
Dependencies added: process
Dependency ranges changed: base
Files
- LICENSE +1/−0
- System/Path/Directory.hs +23/−40
- System/Path/IO.hs +53/−75
- System/Path/Internal.hs +42/−49
- System/Path/Posix.hs +1/−1
- System/Path/Windows.hs +1/−1
- Test.hs +27/−33
- TestTemplate.hs +18/−13
- pathtype.cabal +41/−18
LICENSE view
@@ -1,3 +1,4 @@+Copyright (c) 2015, Henning Thielemann Copyright (c) 2009, Ben Moseley All rights reserved.
System/Path/Directory.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | This module provides type-safe access to directory manipulations. -- -- It is designed to be imported instead of "System.Directory".@@ -64,26 +64,26 @@ where -import Prelude hiding (FilePath)- import System.Path -import Control.Applicative-import Control.Arrow-import Data.List-import Data.Time-import GHC.Exts(IsString(..))-import System.Directory (Permissions) import qualified System.Directory as SD-import System.IO hiding (FilePath)-import System.IO.Error-import Test.QuickCheck-import Text.Printf+import System.Directory (Permissions) --- directory < 1.2 used old-time; to present a consistent API we convert it--- time:Data.Time.UTCTime.-#if !(MIN_VERSION_directory(1,2,0))-import System.Time+import Control.Applicative ((<$>))++import Data.List (partition)++import Prelude hiding (FilePath)+++-- directory < 1.2 used old-time;+-- to present a consistent API we convert it to time:Data.Time.UTCTime.+#if MIN_VERSION_directory(1,2,0)+import Data.Time (UTCTime)+#else+import qualified Data.Time as Time+import qualified System.Time as SysTime+import Data.Time (UTCTime(UTCTime)) #endif ------------------------------------------------------------------------@@ -217,27 +217,10 @@ where convertTime clock = UTCTime day (fromIntegral sec) where- calendar = toUTCTime clock- day = addDays (toInteger (ctYDay calendar)) yearStart- yearStart = fromGregorian (toInteger (ctYear calendar)) 1 1- hour = ctHour calendar- min = hour * 60 + ctMin calendar- sec = min * 60 + ctSec calendar+ calendar = SysTime.toUTCTime clock+ day = Time.addDays (toInteger (SysTime.ctYDay calendar)) yearStart+ yearStart = Time.fromGregorian (toInteger (SysTime.ctYear calendar)) 1 1+ hour = SysTime.ctHour calendar+ minu = hour * 60 + SysTime.ctMin calendar+ sec = minu * 60 + SysTime.ctSec calendar #endif------------------------------------------------------------------------------- QuickCheck--testall = do- putStrLn "Running QuickCheck tests..."- putStrLn "Tests completed."--vectorOf :: Gen a -> Int -> Gen [a]-vectorOf gen n = sequence [ gen | i <- [1..n] ]---- test :: Testable a => a -> IO ()--- test = quickCheck--
System/Path/IO.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} -- | This module provides type-safe access to IO operations. -- -- It is designed to be imported instead of "System.IO".@@ -22,9 +21,9 @@ -- * Covers for System.IO functions withFile, openFile,- System.Path.IO.readFile,- System.Path.IO.writeFile,- System.Path.IO.appendFile,+ readFile,+ writeFile,+ appendFile, withBinaryFile, openBinaryFile, openTempFile,@@ -32,46 +31,46 @@ -- * Re-exports IO,- fixIO,+ SIO.fixIO, Handle,- stdin,- stdout,- stderr,- IOMode(..),- hClose,- hFileSize,- hSetFileSize,- hIsEOF,- isEOF,- BufferMode(..),- hSetBuffering,- hGetBuffering,- hFlush,- hGetPosn,- hSetPosn,- HandlePosn,- hSeek,- SeekMode(..),- hTell,- hIsOpen,- hIsClosed,- hIsReadable,- hIsWritable,- hIsSeekable,- hIsTerminalDevice,- hSetEcho,- hGetEcho,- hShow,- hWaitForInput,- hReady,- hGetChar,- hGetLine,- hLookAhead,- hGetContents,- hPutChar,- hPutStr,- hPutStrLn,- hPrint,+ SIO.stdin,+ SIO.stdout,+ SIO.stderr,+ SIO.IOMode(..),+ SIO.hClose,+ SIO.hFileSize,+ SIO.hSetFileSize,+ SIO.hIsEOF,+ SIO.isEOF,+ SIO.BufferMode(..),+ SIO.hSetBuffering,+ SIO.hGetBuffering,+ SIO.hFlush,+ SIO.hGetPosn,+ SIO.hSetPosn,+ SIO.HandlePosn,+ SIO.hSeek,+ SIO.SeekMode(..),+ SIO.hTell,+ SIO.hIsOpen,+ SIO.hIsClosed,+ SIO.hIsReadable,+ SIO.hIsWritable,+ SIO.hIsSeekable,+ SIO.hIsTerminalDevice,+ SIO.hSetEcho,+ SIO.hGetEcho,+ SIO.hShow,+ SIO.hWaitForInput,+ SIO.hReady,+ SIO.hGetChar,+ SIO.hGetLine,+ SIO.hLookAhead,+ SIO.hGetContents,+ SIO.hPutChar,+ SIO.hPutStr,+ SIO.hPutStrLn,+ SIO.hPrint, interact, putChar, putStr,@@ -82,32 +81,26 @@ getContents, readIO, readLn,- hSetBinaryMode,- hPutBuf,- hGetBuf,- hPutBufNonBlocking,- hGetBufNonBlocking+ SIO.hSetBinaryMode,+ SIO.hPutBuf,+ SIO.hGetBuf,+ SIO.hPutBufNonBlocking,+ SIO.hGetBufNonBlocking ) where -import Prelude hiding (FilePath)- import System.Path -import Control.Applicative-import Control.Arrow-import Data.List-import GHC.Exts(IsString(..))-import System.Directory (Permissions)-import System.IO hiding (FilePath, withFile, openFile, readFile, writeFile, appendFile,- withBinaryFile, openBinaryFile, openTempFile, openBinaryTempFile) import qualified System.IO as SIO-import System.IO.Error-import Test.QuickCheck-import Text.Printf+import System.IO (IOMode, Handle) +import Control.Arrow (first)+import Control.Applicative ((<$>)) +import Prelude hiding (FilePath, readFile, writeFile, appendFile)++ ------------------------------------------------------------------------ -- Covers for System.IO functions @@ -137,18 +130,3 @@ openBinaryTempFile :: AbsRelClass ar => DirPath ar -> RelFile -> IO (AbsFile, Handle) openBinaryTempFile f template = first asAbsFile <$> SIO.openBinaryTempFile (getPathString f) (getPathString template)----------------------------------------------------------------------------- QuickCheck--testall = do- putStrLn "Running QuickCheck tests..."- putStrLn "Tests completed."--vectorOf :: Gen a -> Int -> Gen [a]-vectorOf gen n = sequence [ gen | i <- [1..n] ]---- test :: Testable a => a -> IO ()--- test = quickCheck--
System/Path/Internal.hs view
@@ -114,20 +114,22 @@ where -import Prelude hiding (FilePath)--import Control.Applicative-import Control.Arrow-import Data.List-import GHC.Exts( IsString(..) ) import qualified System.Directory as SD -import System.IO hiding (FilePath)-import System.IO.Error-import Text.Printf+import Control.Arrow ((|||), (***))+import Control.Applicative ((<$>))+import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intercalate)+import Data.String (IsString(fromString))++import Text.Printf (printf) import Test.QuickCheck+ (Gen, Property, property, Arbitrary(arbitrary),+ vectorOf, oneof, frequency,+ NonNegative(NonNegative), quickCheck) +import Prelude hiding (FilePath) + ------------------------------------------------------------------------ -- Types @@ -152,7 +154,7 @@ -- -- ... doesn't presently seem to add much value over non-GADT. -newtype PathComponent = PathComponent { unPathComponent :: String } deriving (Eq,Ord)+newtype PathComponent = PathComponent String deriving (Eq,Ord) instance Show PathComponent where showsPrec _ (PathComponent s) = showString s type AbsFile = Path Abs File@@ -174,7 +176,7 @@ -- -- >> pathMap (map toLower) "/tmp/Reports/SpreadSheets" == "/tmp/reports/spreadsheets" pathMap :: (String -> String) -> Path ar fd -> Path ar fd-pathMap f PathRoot = PathRoot+pathMap _ PathRoot = PathRoot pathMap f (FileDir d pc) = FileDir (pathMap f d) (pcMap f pc) -- Private fn@@ -199,39 +201,39 @@ class Private ar => AbsRelClass ar where absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a -instance AbsRelClass Abs where absRel f g = f-instance AbsRelClass Rel where absRel f g = g+instance AbsRelClass Abs where absRel f _g = f+instance AbsRelClass Rel where absRel _f g = g -- | This class allows selective behaviour for file and -- directory paths and is mostly for internal use. class Private fd => FileDirClass fd where fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a -instance FileDirClass File where fileDir f g = f-instance FileDirClass Dir where fileDir f g = g+instance FileDirClass File where fileDir f _g = f+instance FileDirClass Dir where fileDir _f g = g -- | Currently not exported-pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd)-pathAbsRel = absRel Left Right+_pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd)+_pathAbsRel = absRel Left Right -- | Currently not exported-pathFileDir :: FileDirClass fd => Path ar fd -> Either (FilePath ar) (DirPath ar)-pathFileDir = fileDir Left Right+_pathFileDir :: FileDirClass fd => Path ar fd -> Either (FilePath ar) (DirPath ar)+_pathFileDir = fileDir Left Right ------------------------------------------------------------------------ -- Read & Show instances instance AbsRelClass ar => Show (Path ar fd) where- showsPrec d x@PathRoot = absRel (const $ showString pathSeparators)+ showsPrec _ x@PathRoot = absRel (const $ showString pathSeparators) (const $ showString ".") x -- we need the clause below so that we don't duplicate the pathSeparator after an abs -- root and we don't want to display a "./" prefix on relative paths- showsPrec d x@(FileDir p@PathRoot pc) = absRel (const $ showString pathSeparators)+ showsPrec d (FileDir p@PathRoot pc) = absRel (const $ showString pathSeparators) (const id) p . showsPrec d pc- showsPrec d x@(FileDir p pc) = showsPrec d p . showString pathSeparators .+ showsPrec d (FileDir p pc) = showsPrec d p . showString pathSeparators . showsPrec d pc -- This instance consumes all remaining input. Would it be better to, say,@@ -251,8 +253,8 @@ ------------------------------------------------------------------------ -- Windows / Posix -isPosix :: Bool-isPosix = not isWindows+_isPosix :: Bool+_isPosix = not isWindows isWindows :: Bool isWindows = IS_WINDOWS@@ -269,7 +271,7 @@ ------------------------------------------------------------------------ -- Unchecked Construction Functions--- NB - these construction functions are pure and do no checking!!+-- NB - these construction functions are non-IO and do no checking!! -- | Use a 'String' as a 'Path' whose type is determined -- by its context.@@ -355,19 +357,13 @@ -- at the supplied path, 'Nothing' is returned. mkPathFileOrDir :: AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath ar))) mkPathFileOrDir s = do- isfile <- doesFileExist `onPathString` s- isdir <- doesDirectoryExist `onPathString` s+ isfile <- SD.doesFileExist s+ isdir <- SD.doesDirectoryExist s case (isfile, isdir) of (False, False) -> return Nothing (True, False) -> return $ Just $ Left $ asPath s (False, True ) -> return $ Just $ Right $ asPath s- (True, True ) -> ioError $ userError "mkPathFileOrDir - internal inconsistency - file&dir"- where- -- We duplicate these from System.Path.Directory to avoid a module cycle- doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool- doesFileExist = SD.doesFileExist . getPathString- doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool- doesDirectoryExist = SD.doesDirectoryExist . getPathString+ (True, True ) -> ioError $ userError "mkPathFileOrDir - object type changed while checking" -- | Convert a 'String' into an 'AbsPath' by interpreting it as -- relative to the supplied directory if necessary.@@ -383,21 +379,14 @@ mkAbsPathFromCwd = (return ||| makeAbsoluteFromCwd) . mkPathAbsOrRel --- | Lift a function which can operate on either Abs or Rel Path to one which--- operates on Strings.--- At present this fn is the only reason we have Rank-2 types, it's also not--- doing anything useful at present. We /may/ want to expose it later though--- so leave it for now...-onPathString :: (forall ar . AbsRelClass ar => Path ar fd -> a) -> String -> a-onPathString f = (f ||| f) . mkPathAbsOrRel-- ------------------------------------------------------------------------ -- Internal Functions for PathComponent manipulation mkPathFromComponents :: [PathComponent] -> Path ar fd-mkPathFromComponents [] = PathRoot-mkPathFromComponents pcs | (p:ps) <- reverse pcs = FileDir (foldr (flip FileDir) PathRoot ps) p+mkPathFromComponents pcs =+ case reverse pcs of+ [] -> PathRoot+ p:ps -> FileDir (foldr (flip FileDir) PathRoot ps) p mkPathComponents :: String -> [PathComponent] mkPathComponents xs =@@ -511,8 +500,10 @@ where (p2, ext) = splitExtension p +-- | Path must not be empty splitFileName :: Path ar fd -> (DirPath ar, RelPath fd) splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc])+splitFileName PathRoot = error "splitFileName: empty path" prop_split_combine :: AbsFile -> Property prop_split_combine p = property $ uncurry combine (splitFileName p) == p@@ -564,8 +555,8 @@ -- >> equalFilePath "/tmp/" "/tmp" == True -- >> equalFilePath "/tmp" "tmp" == False equalFilePath :: String -> String -> Bool-equalFilePath s1 s2 | a1 <- isAbsoluteString s1,- a2 <- isAbsoluteString s2 = a1 == a2 && asPath s1 == asPath s2+equalFilePath s1 s2 =+ isAbsoluteString s1 == isAbsoluteString s2 && asPath s1 == asPath s2 -- | Constructs a 'Path' from a list of components. --@@ -802,7 +793,7 @@ fixTrailingDot (r1,r2) | [extSeparator] `isSuffixOf` r1 = (init r1, extSeparator:r2) | otherwise = (r1,r2) swap (x,y) = (y,x)- rbreak p = (reverse *** reverse) . swap . break p . reverse+ rbreak q = (reverse *** reverse) . swap . break q . reverse genericSplitExtension p = (p,"") genericSplitExtensions :: Path ar fd -> (Path ar fd, String)@@ -820,8 +811,10 @@ ------------------------------------------------------------------------ -- QuickCheck -testall = do+_testall :: IO ()+_testall = do putStrLn "Running QuickCheck tests..."+ quickCheck prop_asPath_getPathString quickCheck prop_mkPathFromComponents_pathComponents quickCheck prop_makeAbsoluteFromDir_endSame quickCheck prop_makeAbsoluteFromDir_startSame
System/Path/Posix.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types, OverloadedStrings #-}+{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} {-# LANGUAGE CPP #-} #define MODULE_NAME Posix #define IS_WINDOWS False
System/Path/Windows.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types, OverloadedStrings #-}+{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} {-# LANGUAGE CPP #-} #define MODULE_NAME Windows #define IS_WINDOWS True
Test.hs view
@@ -1,46 +1,40 @@-module Test where+module Main where -import Control.Applicative-import Control.Monad-import Data.List+import Control.Monad (void)+import Control.Applicative ((<$>))+import Data.List (stripPrefix, isInfixOf)+import Data.Maybe (mapMaybe) -import System.Path-import System.Process-import System.Exit-import Text.Printf+import System.Process (rawSystem)+import System.Exit (exitWith)+import Text.Printf (printf) ++srcfiles :: [String]+template, testModule, tok, testPrefix :: String+ srcfiles = ["System/Path/Internal.hs","System/Path/Directory.hs","System/Path/IO.hs"] template = "TestTemplate.hs" testModule = "TestModule.hs" tok = "<TESTS_GO_HERE>" testPrefix = "-- >> " +main :: IO () main = do- sourceLines <- concat <$> mapM (fmap lines . readFile) srcfiles- templateLines <- lines <$> readFile template- let testLines = [drop (length testPrefix) l | l <- sourceLines, testPrefix `isPrefixOf` l]- (templateHead,_:templateTail) = break (tok `isInfixOf`) templateLines- outLines = (\t -> " "++t++",") <$> testLines- numTestLines = zip [1..] testLines-- writeFile testModule $ unlines $ templateHead ++ outLines ++ templateTail-- let args = ["-optP-include", "-optPdist/build/autogen/cabal_macros.h", "-e","TestModule.main",testModule]- ghc = "ghc"- stdinput = ""-- printf "Running %d tests...\n" (length testLines)- x@(_ec, failedTestsStr, err) <- readProcessWithExitCode ghc args stdinput- when (not $ null err) $ putStrLn err >> exitFailure-- let failedTests :: [Int]- failedTests = read failedTestsStr- numFailures = length failedTests+ testLines <-+ mapMaybe (stripPrefix testPrefix) . concatMap lines <$> mapM readFile srcfiles+ (templateHead,_:templateTail) <-+ break (tok `isInfixOf`) . lines <$> readFile template+ let outLines = (\t -> printf " (%s,\n %s) :" (show t) t) <$> testLines - when (not $ null failedTests) $ do- putStrLn "Failures:"- putStrLn $ unlines [s | (n,s) <- numTestLines, n `elem` failedTests]- exitFailure+ writeFile testModule $ unlines $+ ("{- Do not edit! Created from " ++ template ++ " -}") :+ templateHead ++ outLines ++ templateTail - putStrLn "Passed."+ let ghc = "ghc"+ args =+ ["-optP-include", "-optPdist/build/autogen/cabal_macros.h",+ "-e", "TestModule.main", testModule] + void $ printf "Running %d tests...\n" (length testLines)+ exitWith =<< rawSystem ghc args
TestTemplate.hs view
@@ -1,25 +1,30 @@ {-# LANGUAGE OverloadedStrings #-}-module TestModule ()-where+module TestModule (main) where import System.Path-import System.Path.Directory-import System.Random-import Data.Char+import System.Random (newStdGen, random)+import System.Exit (ExitCode, exitFailure)+import Control.Monad (when)+import Data.Char (toLower) +main :: IO () main = do g <- newStdGen let (a,_g') = random g -- TODO - integrate with QuickCheck x = rootDir </> "tmp" </> "someFile" <.> "ext" - let numResults = zip [1..] $ results a x- fails = [n|(n,False) <-numResults]-- putStr $ show fails -- This can then be parsed by the invoking Test module+ let fails = map fst $ filter (not . snd) $ results a x -results a x = [- <TESTS_GO_HERE>- True -- Just so we can have commas at end of all preceding lines- ]+ if null fails+ then do+ putStrLn "Passed."+ else do+ putStrLn "Failed tests:"+ mapM_ putStrLn fails+ exitFailure +results :: Char -> System.Path.FilePath ar -> [(String, Bool)]+results a x =+ <TESTS_GO_HERE>+ []
pathtype.cabal view
@@ -1,5 +1,5 @@ Name: pathtype-Version: 0.5.4.1+Version: 0.5.4.2 Synopsis: Type-safe replacement for System.FilePath etc Description: This package provides type-safe access to filepath manipulations. .@@ -78,29 +78,52 @@ License: BSD3 Category: System License-file: LICENSE-Author: Ben Moseley, Ben Millwood-Maintainer: ben@moseley.name-HomePage: http://code.haskell.org/pathtype+Author: Ben Moseley, Ben Millwood, Henning Thielemann+Maintainer: haskell@henning-thielemann.de, ben@moseley.name+HomePage: http://hub.darcs.net/thielema/pathtype/ Build-Type: Simple-Cabal-Version: >=1.6-Extra-Source-Files: Test.hs, TestTemplate.hs, System/Path/Internal.hs+Cabal-Version: >=1.8+Extra-Source-Files: TestTemplate.hs, System/Path/Internal.hs -source-repository head- type: git- location: https://github.com/benmos/pathtype+Source-Repository head+ Type: darcs+ Location: http://hub.darcs.net/thielema/pathtype/ -flag old-time- description: Build with directory < 1.2 and old-time- default: True+Source-Repository this+ Tag: 0.5.4.2+ Type: darcs+ Location: http://hub.darcs.net/thielema/pathtype/ +Flag old-time+ Description: Build with directory < 1.2 and old-time+ Default: True+ Library- Build-Depends: base >= 4 && < 5, time >= 1.0 && < 2, QuickCheck >= 2.1.0.1 && < 3+ Build-Depends:+ QuickCheck >= 2.1.0.1 && < 3,+ time >= 1.0 && < 2,+ base >= 4 && < 5 - if flag(old-time)+ If flag(old-time) Build-Depends: directory >= 1 && < 1.2, old-time >= 1.0 && < 2- else+ Else Build-Depends: directory >= 1.2 && < 2 - Exposed-modules:- System.Path, System.Path.Directory, System.Path.IO, System.Path.Posix, System.Path.Windows- Extensions: EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types, OverloadedStrings, CPP+ Exposed-Modules:+ System.Path+ System.Path.Directory+ System.Path.IO+ System.Path.Posix+ System.Path.Windows++ GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind++Test-Suite test+ Type: exitcode-stdio-1.0+ Main-Is: Test.hs++ Build-Depends:+ process >=1.1 && <1.3,+ base++ GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind